Delphi分组框标题颜色更改

Question

我正在使用BDS 2006，想知道是否可以在项目中使用XP主题来改变群组框和单选按钮组标题的颜色（因为它们总是蓝色）。

- Shirish11

Answer 1

唯一的方法是覆盖 TGroupBox 的 Paint 方法。

请查看此示例，它使用了一个 Interposer 类。

type
  TGroupBox = class(StdCtrls.TGroupBox) //declare this before of your form definition
  public
    procedure Paint; override;
  end;

uses
 Themes;

{ TGroupBox }

procedure TGroupBox.Paint;
var
  H: Integer;
  R: TRect;
  Flags: Longint;
  CaptionRect,
  OuterRect: TRect;
  Size: TSize;
  Box: TThemedButton;
  Details: TThemedElementDetails;
begin
  with Canvas do
  begin
    Font := Self.Font;

    if ThemeControl(Self) then
    begin
      if Text <> '' then
      begin
        GetTextExtentPoint32(Handle, PChar(Text), Length(Text), Size);
        CaptionRect := Rect(0, 0, Size.cx, Size.cy);
        if not UseRightToLeftAlignment then
          OffsetRect(CaptionRect, 8, 0)
        else
          OffsetRect(CaptionRect, Width - 8 - CaptionRect.Right, 0);
      end
      else
        CaptionRect := Rect(0, 0, 0, 0);

      OuterRect := ClientRect;
      OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
      with CaptionRect do
        ExcludeClipRect(Handle, Left, Top, Right, Bottom);
      if Enabled then
        Box := tbGroupBoxNormal
      else
        Box := tbGroupBoxDisabled;
      Details := ThemeServices.GetElementDetails(Box);
      //Draw the themed frame
      ThemeServices.DrawElement(Handle, Details, OuterRect);    
      SelectClipRgn(Handle, 0);
      if Text <> '' then
      begin
         H := TextHeight('0');
         if not UseRightToLeftAlignment then
           R := Rect(8, 0, 0, H)
         else
           R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
         Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
         //Now using the Windows.DrawText 
         DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
         Brush.Color := Color;//background color of the caption
         Font.Color := clRed;//the color of the caption.
         DrawText(Handle, PChar(Text), Length(Text), R, Flags);
      end;
    end
    else
    inherited;   //if the control is not themed then use the original paint method.
  end;
end;

- RRUZ

---

我找不到ThemeControl函数，我猜它就是这个： function ThemeControl(AControl: TControl): Boolean; - Shirish11

@ruzz 我无法在 Themes 单元中找到声明（我正在使用 BDS 2006）。 - Shirish11

如果在 Delphi 2006 中不存在该函数，则应将 if ThemeControl(Self) then 改为 if ThemeServices.ThemesEnabled then。 - RRUZ

这是我得到的，但我希望文本的背景与我的表单背景相同（在这种情况下是一张图片）。 - Shirish11

你必须使用与窗体颜色相同的值设置TGroupBox的color属性。如果这样不起作用，你可以在这一行中设置背景颜色：Brush.Color := Color;（请阅读代码中的注释）。 - RRUZ

让我们在聊天室中继续这个讨论。 - Shirish11