我该如何在自己的组件中实现主题支持？

Question

我正在尝试创建一个自己的组件，该组件的主题与应用程序的其他部分相同（主题是在 项目>选项>应用程序>外观 中设置的）。

该控件派生自 TWinControl （在下面的红色框中）。 我如何将应用程序主题应用于我的组件？我将在其中使用许多标准控件，例如按钮，编辑等。

我尝试在谷歌上找到一些东西，但也许是我的英语问题没有问出正确的问题 :)

- Pshemas

---

窗口控件需要实现并注册StyleHook以响应基于主题的消息和绘图。在自定义绘制控件UI时，使用TStyleManager和TStyleEngine与主题系统交互。 - Remy Lebeau

你能给我一些关于如何做这个的示例吗？ - Pshemas

很遗憾，我无法提供帮助，因为我从未尝试在自己的组件中实现样式支持。您需要找到另一个资源来记录该过程。或者阅读VCL的源代码，标准控件使用了几个样式钩子。 - Remy Lebeau

如果您需要一个例子，可以查看Delphi附带的VCL/FMX源代码。 - fpiette

Answer 1

您的组件没有指定特殊的皮肤数据，因此您需要从VCL中选择其他类似组件的部分，看起来与您的相似。然后，您需要查看该组件的源代码，并使用特定更改实现相同的绘图。 您没有提供组件的详细说明，所以一切都取决于我们的想象力。假设：您想要像TPanel一样具有自定义选项卡在红色矩形中间的东西。 我们将选择TCustomControl作为父级（而不是TWinControl），因为我们已经实现了自定义绘制和主题支持的画布。我们将重写UpdateStyleElements以响应主题更改，并在Paint中进行绘图（TCustomPanel也会这样做，我们采用其绘图功能的部分）。

unit Component1;

interface

uses
  System.SysUtils, System.Classes, vcl.Controls, vcl.Styles, WinApi.Windows,
  vcl.Themes, Vcl.Graphics, Vcl.ExtCtrls;

type
  TComponent1 = class(TCustomControl)
  private
  protected
    procedure Paint; override;
    procedure UpdateStyleElements; override;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TComponent1]);
end;

{ TComponent1 }

procedure TComponent1.Paint;
const
  Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
  VerticalAlignments: array[TVerticalAlignment] of Longint = (DT_TOP, DT_BOTTOM, DT_VCENTER);
var
  Rect: TRect;
  LColor: TColor;
  LStyle: TCustomStyleServices;
  LDetails: TThemedElementDetails;
  TopColor, BottomColor: TColor;
  BaseColor, BaseTopColor, BaseBottomColor: TColor;
  Flags: Longint;

  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := BaseTopColor;
    if Bevel = bvLowered then
      TopColor := BaseBottomColor;
    BottomColor := BaseBottomColor;
    if Bevel = bvLowered then
      BottomColor := BaseTopColor;
  end;

begin
  //get rect, where we will drawing
  Rect := GetClientRect;

  //initilize colors
  BaseColor := Color;
  BaseTopColor := clBtnHighlight;
  BaseBottomColor := clBtnShadow;

  //get style
  LStyle := StyleServices(Self);
  if LStyle.Enabled and (seClient in StyleElements) then
  begin
    //get detail(background) of our style, which we will use
    LDetails := LStyle.GetElementDetails(tpPanelBackground);
    //check, if in this style our color is changed - we take it
    if LStyle.GetElementColor(LDetails, ecFillColor, LColor) and (LColor <> clNone) then
      BaseColor := LColor;

    //get detail(border) of our style, which we will use
    LDetails := LStyle.GetElementDetails(tpPanelBevel);
    //check, if in this style our color is changed - we take it
    if LStyle.GetElementColor(LDetails, ecEdgeHighLightColor, LColor) and (LColor <> clNone) then
      BaseTopColor := LColor;
    if LStyle.GetElementColor(LDetails, ecEdgeShadowColor, LColor) and (LColor <> clNone) then
      BaseBottomColor := LColor;
  end;

  //draw top border
  if BevelOuter <> bvNone then
  begin
    AdjustColors(BevelOuter);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;

  //if style does not draw borders - do it by ourselves
  if not (LStyle.Enabled and (csParentBackground in ControlStyle)) then
    Frame3D(Canvas, Rect, BaseColor, BaseColor, BorderWidth)
  else
    InflateRect(Rect, -Integer(BorderWidth), -Integer(BorderWidth));

  if BevelInner <> bvNone then
  begin
    AdjustColors(BevelInner);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;

  with Canvas do
  begin
    if not LStyle.Enabled or not ParentBackground or not (seClient in StyleElements) or
       (not LStyle.IsSystemStyle and (Parent <> nil) and (Parent is TCustomPanel) and
       TCustomPanel(Parent).DoubleBuffered {and not CheckParentBackground(Parent)})
    then
    begin
      //set curect brush color
      Brush.Color := BaseColor;
      //and fill all client rect with it
      FillRect(Rect);
    end;

    //drawing red rectangle
    Brush.Style := bsClear;
    Pen.Color := clRed;
    InflateRect(Rect, -30, -30);
    Rectangle(Rect);

    if LStyle.Enabled then begin
      //draw
      //make tab smaller
      InflateRect(Rect, -10, -10);
      //move tab to bottom of recrangle
      OffsetRect(Rect, 0, 10 - 1);
      //get slyled tab
      LDetails := LStyle.GetElementDetails(ttTabItemSelected);
      //draw tab
      LStyle.DrawElement(Handle, LDetails, rect);

      //draw some text on tab
      Brush.Style := bsClear;
      Font := Self.Font;
      Flags := DT_EXPANDTABS or DT_SINGLELINE or
        VerticalAlignments[taVerticalCenter] or Alignments[taCenter];
      Flags := DrawTextBiDiModeFlags(Flags);
      if LStyle.Enabled and (seFont in StyleElements) then
      begin
        LDetails := LStyle.GetElementDetails(tpPanelBackground);
        if not LStyle.GetElementColor(LDetails, ecTextColor, LColor) or (LColor = clNone) then
          LColor := Font.Color;
        LStyle.DrawText(Handle, LDetails, 'CustomCaption', Rect, TTextFormatFlags(Flags), LColor)
      end
      else
        DrawText(Handle, Caption, -1, Rect, Flags);
    end;
  end;
end;

procedure TComponent1.UpdateStyleElements;
begin
  inherited;
end;
end.

在模块“Vcl.Themes”中，您可以找到另一种标准样式。

源代码很简单，但您可以从这个起点开始。

附言：如果您的组件具有更高级的绘图功能-您可以像其他高级组件一样使用样式钩子。查看“类构造函数”和“类析构函数”。

- Softacom