I m using BDS 2006 and would like to know if u can change the color of Group-box and radio group captions with XPmanifest present in the Project(because it is Always blue in color).
可以将文章内容翻译成中文,广告屏蔽插件可能会导致该功能失效(如失效,请关闭广告屏蔽插件后再试):
问题:
回答1:
The only way to this is overriding the Paint method of the TGroupBox
.
Check this sample which uses a Interposer class
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;