Question

In Delphi XE2 I have successfully created overrides for the VCL Styles for a custom component class I have created. What I have found though is that the styles do not appear to apply during runtime creation of the controls.

To be specific I have extended TPanel and am filling a TScrollBox with dynamically created Panels, setting each to a specific color. I also use the API to suspend redraws on the ScrollBox during the creation process.

When the loading is complete, I am left with TPanels set to clWindow (visually) but when I drag and drop the TPanel to another location/control the colors I set in code "kick in". So something is not letting/allowing those colors to apply... or the Panels simply are not refreshing.

So I'm not quite sure if there is a "refresh" I need to call with VCL Style overrides on dynamic component creation, or if the suspension of redraws on TScrollBox are causing interference with the color not updating on the Panel when created.. since it is a child of the suspended ScrollBox.

I'm wondering if there is just a simple & known "gotcha" I am overlooking with what I am trying to do.

I've stripped down the project to bare essentials and it still has the issue.

This is a simple extension of TPanel adding a label.

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.

This is the simple project that should show the issue. Button 1 loads five instances of the TInfluencePanel into ScrollBox1. They appear with the default windows color and no style instead of the color in code. Button2 moves the controls to ScrollBox2 where they appear with the coded colors. This has all the suspended redraws taken out, etc.

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.
Was it helpful?

Solution

Your Style hook has not effect in the paint process because The TPanel doesn't use a style hook to draw the control. you must override the paint method in your component like so.

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.

Also in the runtime creation set the ParentBackground property to 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

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top