unit ColoredRadioButton;
//By SMP3.
interface
uses
WinApi.Windows,
WinApi.Messages,
System.Classes,
Vcl.Graphics,
Vcl.StdCtrls,
Vcl.Styles,
Vcl.Themes;
type
TRadioButton = class(Vcl.StdCtrls.TRadioButton)
private
FMouseDown: Boolean;
protected
procedure WndProc(var Message: TMessage); override;
procedure PaintRadioButton(Canvas: TCanvas);
end;
implementation
{ TRadioButton }
function RectVCenter(var R: TRect; Bounds: TRect): TRect;
begin
OffsetRect(R, -R.Left, -R.Top);
OffsetRect(R, 0, (Bounds.Height - R.Height) div 2);
OffsetRect(R, Bounds.Left, Bounds.Top);
Result := R;
end;
procedure TRadioButton.PaintRadioButton(Canvas: TCanvas);
var
LDetails: TThemedElementDetails;
DC: HDC;
LRect: TRect;
Detail: TThemedButton;
TxtRect, BoxRect: TRect;
Size: TSize;
procedure DrawCheckBoxText(DC: HDC; Text: String; LDetails: TThemedElementDetails; R: TRect);
var
TextFormat: Cardinal;
begin
TextFormat := DT_VCENTER or DT_HIDEPREFIX;
if WordWrap then
TextFormat := TextFormat or DT_WORDBREAK
else
TextFormat := TextFormat or DT_SINGLELINE;
if Alignment = taLeftJustify then
TextFormat := TextFormat or DT_RIGHT
else if Alignment = taRightJustify then
TextFormat := TextFormat or DT_LEFT
else
TextFormat := TextFormat or DT_CENTER;
if Font.Color < 0 then
Font.Color := clBlack;
SetTextColor(DC, Font.Color);
DrawText(DC, Text, -1, R, TextFormat);
end;
begin
DC := Canvas.Handle;
LRect := ClientRect;
Canvas.Brush.Color := Color;
Canvas.FillRect(LRect);
if Enabled then
Detail := tbRadioButtonUncheckedNormal
else
Detail := tbRadioButtonUncheckedDisabled;
if FMouseDown then
Detail := tbRadioButtonUncheckedPressed
else if MouseInClient then
Detail := tbRadioButtonUncheckedHot;
if Checked then
Detail := TThemedButton(Integer(Detail) + 4);
Size.cx := GetSystemMetrics(SM_CXMENUCHECK);
Size.cy := GetSystemMetrics(SM_CYMENUCHECK);
LDetails := StyleServices.GetElementDetails(Detail);
BoxRect := Rect(0, 0, Size.cx, Size.cy);
RectVCenter(BoxRect, LRect);
if BiDiMode = bdRightToLeft then
begin
BoxRect.Left := LRect.Right - BoxRect.Width - 2;
BoxRect.Right := LRect.Right;
TxtRect := Rect(LRect.Left + 1, LRect.Top, BoxRect.Left, LRect.Bottom);
end
else
begin
OffsetRect(BoxRect, 1, 0);
TxtRect := Rect(BoxRect.Right + 2, LRect.Top, LRect.Right, LRect.Bottom);
end;
StyleServices.DrawElement(DC, LDetails, BoxRect);
if Focused then
Canvas.DrawFocusRect(LRect);
DrawCheckBoxText(DC, Caption, LDetails, TxtRect);
end;
procedure TRadioButton.WndProc(var Message: TMessage);
var
ps: TPaintStruct;
Canvas: TCanvas;
begin
case Message.Msg of
WM_LBUTTONUP, WM_CREATE:
begin
FMouseDown := False;
end;
WM_LBUTTONDOWN:
begin
FMouseDown := True;
end;
WM_PAINT:
begin
BeginPaint(Handle, ps);
Canvas := TCanvas.Create;
Canvas.Handle := ps.HDC;
PaintRadioButton(Canvas);
Canvas.Free;
EndPaint(Handle, ps);
Exit;
end;
end;
inherited;
end;
end.
