delphi - 动态创建组件时如何强制VCL样式覆盖？

Question

在 Delphi XE2 中，我已成功为我创建的自定义组件类的 VCL 样式创建了覆盖。但我发现这些样式似乎在控件的运行时创建期间不适用。

具体来说，我扩展了 TPanel，并用动态创建的面板填充 TScrollBox，将每个面板设置为特定的颜色。我还使用 API 在创建过程中暂停 ScrollBox 上的重绘。

加载完成后，我将 TPanel 设置为 clWindow (视觉上)，但是当我将 TPanel 拖放到另一个位置/控制我在代码中设置的颜色时“启动”。所以有些东西不允许/允许应用这些颜色......或者面板根本不令人耳目一新。

所以我不太确定是否需要在动态组件创建时使用 VCL 样式覆盖来调用“刷新”，或者 TScrollBox 上重绘的暂停是否会导致面板上颜色不更新的干扰创建..因为它是挂起的 ScrollBox 的子项。

我想知道我正在尝试做的事情是否有一个简单且已知的“陷阱”。

我已经将项目精简为最基本的部分，但问题仍然存在。

这是 TPanel 添加标签的简单扩展。

unit InfluencePanel;

interface

uses
  System.SysUtils, System.Classes, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.Graphics;

type
  TInfluencePanel = class(TPanel)
  private
    { Private declarations }
    oCaptionLabel : TLabel;
    FLabelCaption : String;
    procedure SetLabelCaption(sCaption : String);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    property LabelCaption : string read FLabelCaption write SetLabelCaption;
  published
    { Published declarations }
  end;

procedure Register;

implementation

constructor TInfluencePanel.Create(AOwner: TComponent);
begin
  inherited;
  oCaptionLabel := TLabel.Create(Self); 
  with oCaptionLabel do
  begin
    Caption := 'Caption';
    Top := 0;  
    Left := 0;
    Align := alTop;
    WordWrap := True;
    Parent := Self;
  end;
end;

procedure TInfluencePanel.SetLabelCaption(sCaption: string);
begin
  FLabelCaption := sCaption;
  if oCaptionLabel <> nil then oCaptionLabel.Caption := FLabelCaption;
end;

procedure Register;
begin
  RegisterComponents('Influence Elements', [TInfluencePanel]);
end;

end.

这是应该显示问题的简单项目。按钮 1 将 TInfluencePanel 的五个实例加载到 ScrollBox1 中。它们以默认的窗口颜色显示，没有样式，而不是代码中的颜色。 Button2 将控件移动到 ScrollBox2，在那里它们以编码颜色显示。这已删除所有暂停的重画等。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Themes, InfluencePanel;

type
  TInfluencePanelStyleHookColor = class(TEditStyleHook)
  private
    procedure UpdateColors;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AControl: TWinControl); override;
  end;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    ScrollBox2: TScrollBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Vcl.Styles;

type
 TWinControlH= class(TWinControl);

constructor TInfluencePanelStyleHookColor.Create(AControl: TWinControl);
begin
  inherited;
  UpdateColors;
end;

procedure TInfluencePanelStyleHookColor.UpdateColors;
var
  LStyle: TCustomStyleServices;
begin
 if Control.Enabled then
 begin
  Brush.Color := TWinControlH(Control).Color;
  FontColor   := TWinControlH(Control).Font.Color;
 end
 else
 begin
  LStyle := StyleServices;
  Brush.Color := LStyle.GetStyleColor(scEditDisabled);
  FontColor := LStyle.GetStyleFontColor(sfEditBoxTextDisabled);
 end;
end;

procedure TInfluencePanelStyleHookColor.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
      begin
        UpdateColors;
        SetTextColor(Message.WParam, ColorToRGB(FontColor));
        SetBkColor(Message.WParam, ColorToRGB(Brush.Color));
        Message.Result := LRESULT(Brush.Handle);
        Handled := True;
      end;
    CM_ENABLEDCHANGED:
      begin
        UpdateColors;
        Handled := False;
      end
  else
    inherited WndProc(Message);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  iPanel, iLastPosition : Integer;
  oPanel : TInfluencePanel;
begin
  iLastPosition := 0;
  for iPanel := 1 to 5 do
  begin
    oPanel := TInfluencePanel.Create(ScrollBox1);
    with oPanel do
    begin
      Align := alLeft;
      Left := iLastPosition;
      Width := 90;
      Parent := ScrollBox1;
      Color := RGB(200,100,iPanel*10);
      LabelCaption := 'My Panel ' + IntToStr(iPanel);
      Margins.Right := 5;
      AlignWithMargins := True;
    end;
    iLastPosition := iLastPosition + 90;
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  iPanel : Integer;
begin
  for iPanel := ScrollBox1.ControlCount - 1 downto 0 do
  begin
    if ScrollBox1.Controls[iPanel].ClassType = TInfluencePanel then
      TInfluencePanel(ScrollBox1.Controls[iPanel]).Parent := ScrollBox2;
  end;

end;

initialization

 TStyleManager.Engine.RegisterStyleHook(TInfluencePanel,TInfluencePanelStyleHookColor);

end.

Answer 1

您的样式 Hook 在绘制过程中不起作用，因为 TPanel 不使用样式 Hook 来绘制控件。您必须像这样重写组件中的绘制方法。

unit InfluencePanel;

interface

uses
  System.SysUtils, System.Classes, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.Graphics;

type
  TInfluencePanel = class(TPanel)
  private
    { Private declarations }
    oCaptionLabel : TLabel;
    FLabelCaption : String;
    procedure SetLabelCaption(sCaption : String);
  protected
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    property LabelCaption : string read FLabelCaption write SetLabelCaption;
  published
    { Published declarations }
  end;

procedure Register;

implementation

uses
  Winapi.Windows,
  System.Types,
  Vcl.Themes;

constructor TInfluencePanel.Create(AOwner: TComponent);
begin
  inherited;
  oCaptionLabel := TLabel.Create(Self);
  with oCaptionLabel do
  begin
    Caption := 'Caption';
    Top := 0;
    Left := 0;
    Align := alTop;
    WordWrap := True;
    Parent := Self;
  end;
end;

procedure TInfluencePanel.SetLabelCaption(sCaption: string);
begin
  FLabelCaption := sCaption;
  if oCaptionLabel <> nil then oCaptionLabel.Caption := FLabelCaption;
end;

procedure TInfluencePanel.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        : TColor;
  BottomColor     : TColor;
  LBaseColor      : TColor;
  LBaseTopColor   : TColor;
  LBaseBottomColor: TColor;
  Flags: Longint;

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

begin
  Rect := GetClientRect;

  LBaseColor := Color;//use the color property value to get the background color.
  LBaseTopColor := clBtnHighlight;
  LBaseBottomColor := clBtnShadow;
  LStyle := StyleServices;
  if LStyle.Enabled then
  begin
    LDetails := LStyle.GetElementDetails(tpPanelBevel);
    if LStyle.GetElementColor(LDetails, ecEdgeHighLightColor, LColor) and (LColor <> clNone) then
      LBaseTopColor := LColor;
    if LStyle.GetElementColor(LDetails, ecEdgeShadowColor, LColor) and (LColor <> clNone) then
      LBaseBottomColor := LColor;
  end;

  if BevelOuter <> bvNone then
  begin
    AdjustColors(BevelOuter);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
  if not (LStyle.Enabled and (csParentBackground in ControlStyle)) then
    Frame3D(Canvas, Rect, LBaseColor, LBaseColor, 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 then
    begin
      Brush.Color := LBaseColor;
      FillRect(Rect);
    end;

    if ShowCaption and (Caption <> '') then
    begin
      Brush.Style := bsClear;
      Font := Self.Font;
      Flags := DT_EXPANDTABS or DT_SINGLELINE or
        VerticalAlignments[VerticalAlignment] or Alignments[Alignment];
      Flags := DrawTextBiDiModeFlags(Flags);
      if LStyle.Enabled then
      begin
        LDetails := LStyle.GetElementDetails(tpPanelBackground);
        if not LStyle.GetElementColor(LDetails, ecTextColor, LColor) or (LColor = clNone) then
          LColor := Font.Color;
        LStyle.DrawText(Handle, LDetails, Caption, Rect, TTextFormatFlags(Flags), LColor)
      end
      else
        DrawText(Handle, Caption, -1, Rect, Flags);
    end;
  end;
end;

procedure Register;
begin
  RegisterComponents('Influence Elements', [TInfluencePanel]);
end;

end.

此外，在运行时创建中将 ParentBackground 属性设置为 False

  for iPanel := 1 to 5 do
  begin
    oPanel := TInfluencePanel.Create(ScrollBox1);
    with oPanel do
    begin
      Align := alLeft;
      Left := iLastPosition;
      Width := 90;
      Parent := ScrollBox1;
      ParentBackground:=False;// <----
      Color := RGB(200,100,iPanel*20);
      LabelCaption := 'My Panel ' + IntToStr(iPanel);
      Margins.Right := 5;
      AlignWithMargins := True;
    end;
    iLastPosition := iLastPosition + 90;
  end;