我正在使用 BDS 2006,想知道您是否可以使用项目中存在的 XPmanifest 更改组框和无线电组标题的颜色(因为它始终为蓝色)。
问问题
10196 次
1 回答
8
唯一的方法是覆盖TGroupBox
.
检查这个使用 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;
于 2011-10-12T13:10:39.737 回答