Question

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

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

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

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

我想知道是否只有一个简单的＆amp;已知的“陷阱”我忽略了我想要做的事情。

我已经将项目拆除为基本要素，但仍然存在问题。

这是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

您的样式挂钩在绘制过程中没有效果，因为TPanel不使用样式挂钩来绘制控件。你必须像这样覆盖组件中的paint方法。

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;

enter image description here

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

1 个答案: