ＭｙＲａｄｉｏＢｕｔｔｏｎ

　ラジオボタンも、カラーボタンと同じ様に、色を付けて、分かりやすく出来る様にしてみました。

　　上図右側が、マウスカーソルがボタンの上に入った場合ですが、標準のボタンだと、テーマを適用している場合、僅かにブルーになりますが、MyRadioButtonは、ラジオボタンの文字領域の色が、明るくなります。
その事で、マウスカーソルが、Buttonの動作領域に入ったことと、ボタンがイネーブル状態であることが分かります。
MouseEnter割り込みで、色の明るさを変更しています、これは、ColorButtonと同じ事を実行しています。
テーマサービスを検出するルーチンを組み込んでいるため、ColorButtonと同じように、コンパイル時、警告が出ますが問題ありません。
　色の設定をしない場合は、標準のRadioButtonと同じです。
文字の色、バックの色は、ColorButtonと同じで、TCanvasを追加し、そこへ描画することで、実現しています。

unit MyRadioButton;


interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, CommCtrl;

type
  TMyRadioButton = class(TButton)
  private
    FCanvas: TCanvas;
    IsFocused: Boolean;
    FMouseInControl: Boolean;
    FFocusedFrame: Boolean;
    FChecked: Boolean;
    FAlignment: TLeftRight;

    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure SetFocusedFrame(Varue: Boolean);
    procedure SetAlignment(Value: TLeftRight);
    procedure MouseInFillRect(PRect: Trect; PColor: Tcolor);
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  protected
    procedure SetChecked(Value: Boolean); override;
    function GetChecked: Boolean; override;　
    procedure CreateWnd; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CNMeasureItem(var Message: TWMMeasureItem ); message CN_MEASUREITEM;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure DrawButton(DrawItemStruct: TDrawItemStruct);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read FCanvas;
  published
    property Alignment: TLeftRight read FAlignment write SetAlignment default taLeftJustify;
    property Checked: Boolean read GetChecked write SetChecked default False;
    property Color;
    property ParentColor;
    property FocusedFrame: Boolean read FFocusedFrame write SetFocusedFrame default True;
　　end;

procedure Register;

//////////////////////////////////////////////////////////////////////////////
implementation

uses SysUtils, Themes, Actnlist;

procedure Register;
begin
  RegisterComponents('MyVCL', [TMyRadioButton]);
end;


constructor TMyRadioButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TCanvas.Create;
  FFocusedFrame := True;
end;

destructor TMyRadioButton.Destroy;
begin
  inherited Destroy;
  FCanvas.Free;
end;

procedure TMyRadioButton.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> IsFocused then
  begin
    IsFocused := ADefault;
    Refresh;
  end;
end;

procedure TMyRadioButton.SetAlignment(Value: TLeftRight);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;

// テーマ有効時フォーカス点々枠表示非表示設定
procedure TMyRadioButton.SetFocusedFrame(Varue: Boolean);
begin
  if Varue <> FFocusedFrame then
  begin
    FFocusedFrame := Varue;
    Refresh;
  end;
end;

procedure TMyRadioButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TMyRadioButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth := Width;
    itemHeight := Height;
  end;
end;

procedure TMyRadioButton.CNDrawItem(var Message: TWMDrawItem);
var
  SaveIndex: Integer;
begin
  with Message.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    FCanvas.Lock;
    try
      FCanvas.Handle := hDC;
      FCanvas.Font := Font;
      FCanvas.Brush := Brush;
      DrawButton(Message.DrawItemStruct^);
    finally
      FCanvas.Handle := 0;
      FCanvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;
  end;
  Message.Result := 1;
end;

procedure TMyRadioButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TMyRadioButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;


procedure TMyRadioButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;

procedure TMyRadioButton.MouseInFillRect(PRect: Trect; PColor: Tcolor);
begin
  FCanvas.Brush.Color := PColor;
  FCanvas.Pen.Color := PColor;
  if ThemeServices.ThemesEnabled then // テーマなら
  begin
    FCanvas.MoveTo(PRect.Left + 1, PRect.Top - 1);
    FCanvas.LineTo(PRect.Right - 1, PRect.Top - 1);
    FCanvas.MoveTo(PRect.Left + 1, PRect.Bottom);
    FCanvas.LineTo(PRect.Right - 1, PRect.Bottom);
    FCanvas.FillRect(PRect);
  end
  else
  begin
    PRect.Top := PRect.Top - 1;
    FCanvas.FillRect(PRect);
    FCanvas.MoveTo(PRect.Left, PRect.Bottom);
    FCanvas.LineTo(PRect.Right, PRect.Bottom);
  end;
end;

procedure TMyRadioButton.DrawButton(DrawItemStruct: TDrawItemStruct);
const
  BoxSize = 13; // CHECKBOX SIZE;
var
  Flags: Longint;
  IsDown, IsDefault, IsDisabled: Boolean;
  ORGRect, CRect, TextRect, SRect: TRect;
  defCTop: integer;
  defPTop, defPRight, defPBottom: integer;
  BriteColor : integer;
  Button : TThemedButton;
  Details: TThemedElementDetails;

begin
  FCanvas.Handle := DrawItemStruct.hDC;

  ORGRect := ClientRect;
  if (ORGRect.Right - ORGRect.Left) mod 2 = 0 then ORGRect.Right := ORGRect.Right - 1;
  if (ORGRect.Bottom - ORGRect.Top) mod 2 = 0 then ORGRect.Bottom := ORGRect.Bottom - 1;

  SRect := ORGRect;
  SRect.Top := ORGRect.Top + 1;
  SRect.Bottom := ORGRect.Bottom - 1;

  defCTop := (ORGRect.Bottom - ORGRect.Top - BoxSize) div 2 + ORGRect.Top;
  defPTop := (ORGRect.Bottom - ORGRect.Top - abs(FCanvas.Font.Height)) div 2 + ORGRect.Top;
  defPBottom := defPTop + abs(FCanvas.Font.Height);

  if FAlignment = taLeftJustify then
  begin
    CRect := Rect(3, defCTop, BoxSize + 3, defCTop + BoxSize);
    defPRight := ORGRect.Left + BoxSize + 5 + FCanvas.TextWidth(Caption);
    TextRect := Rect(ORGRect.Left + BoxSize + 5, defPTop, defPRight, defPBottom);
    DrawItemStruct.rcItem.Right := DrawItemStruct.rcItem.Left + 16;
    DrawItemStruct.rcItem.Left := DrawItemStruct.rcItem.Left + 1;
  end
  else
  begin
    CRect := Rect(ORGRect.Right - BoxSize - 3, defCTop, ORGRect.Right - 3, defCTop + BoxSize);
    defPRight := ORGRect.Left + 2 + FCanvas.TextWidth(Caption);
    TextRect := Rect(ORGRect.Left + 2, defPTop, defPRight, defPBottom);
    DrawItemStruct.rcItem.Left := DrawItemStruct.rcItem.Right - 16;
  end;

  with DrawItemStruct do
  begin
    FCanvas.Handle := hdc;
    FCanvas.Font := Self.Font;
    IsDown := itemState and ODS_SELECTED <> 0;
    IsDefault := itemState and ODS_FOCUS <> 0;
    IsDisabled := itemState and ODS_DISABLED <> 0;
  end;

  BriteColor := Color;
  if Color <> clbtnface then
  begin
    if BriteColor and $00FF0000 >= $00DF0000 then BriteColor := BriteColor or $00FF0000;
    if BriteColor and $0000FF00 >= $0000DF00 then BriteColor := BriteColor or $0000FF00;
    if BriteColor and $000000FF >= $000000DF then BriteColor := BriteColor or $000000FF;
    if BriteColor and $FFFF0000 < $00DF0000 then BriteColor := BriteColor + $00200000;
    if BriteColor and $FF00FF00 < $0000DF00 then BriteColor := BriteColor + $00002000;
    if BriteColor and $FF0000FF < $000000DF then BriteColor := BriteColor + $00000020;
  end
  else BriteColor := ClWhite;

//
  if ThemeServices.ThemesEnabled then // テーマなら
  begin
    PerformEraseBackGround(Self,Canvas.Handle);
    if FChecked then
    begin
      if not Enabled then
        Button := tbRadioButtonCheckedDisabled
      else
        if isDown then
          Button := tbRadioButtonCheckedPressed
        else
          if FMouseInControl then
            Button := tbRadioButtonCheckedHot
          else
            Button := tbRadioButtonCheckedNormal;
    end
    else
    begin
      if not Enabled then
        Button := tbRadioButtonUnCheckedDisabled
      else
        if isDown then
          Button := tbRadioButtonUnCheckedPressed
        else
          if FMouseInControl then
            Button := tbRadioButtonUnCheckedHot
          else
            Button := tbRadioButtonUnCheckedNormal;
    end;
    Details := ThemeServices.GetElementDetails(Button);
//    ThemeServices.DrawParentBackground(Handle, DrawItemStruct.hdc, @Details, True);

    if FMouseInControl then
      MouseInFillRect(SRect, BriteColor)
    else
      MouseInFillRect(SRect, Color);

    ThemeServices.DrawElement(DrawItemStruct.hdc, Details, DrawItemStruct.rcItem);
  end
  else
  begin
    Flags := DFCS_BUTTONRADIO;
    if IsDown then Flags := Flags or DFCS_PUSHED;
    if IsDisabled then Flags := Flags or DFCS_INACTIVE;
    if FChecked then Flags := Flags or DFCS_CHECKED;

    if FMouseInControl then
      MouseInFillRect(SRect, BriteColor)
    else
      MouseInFillRect(SRect, Color);

    DrawFrameControl(FCanvas.Handle, CRect, DFC_BUTTON, Flags);
  end;
//  Caption set
  if IsDisabled then
    DrawState( FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
               TextRect.Left, TextRect.Top, 0, 0, DST_TEXT or DSS_DISABLED)
  else
    DrawText(FCanvas.Handle, PChar(Caption), -1, TextRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
//  Focuse Frame Draw
  if IsFocused and IsDefault and FFocusedFrame then
  begin
    InflateRect(ORGRect, 0, 0);
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Font.Color := clBlack;
    FCanvas.Brush.Color := clBtnFace;
    DrawFocusRect(FCanvas.Handle, ORGRect);
  end;
end;

function TMyRadioButton.GetChecked: Boolean;
begin
  Result := FChecked;
  Refresh;
end;

procedure TMyRadioButton.SetChecked(Value: Boolean);

  procedure TurnSiblingsOff;
  var
  I: Integer;
  Sibling: TControl;
  begin
  if Parent <> nil then
    with Parent do
      for I := 0 to ControlCount - 1 do
      begin
        Sibling := Controls[I];
        if (Sibling <> Self) and (Sibling is TMyRadioButton) then
          with TMyRadioButton(Sibling) do
          begin
            if Assigned(Action) and
                     (Action is TCustomAction) and
                     TCustomAction(Action).AutoCheck then
              TCustomAction(Action).Checked := False;
            SetChecked(False);
          end;
      end;
  end;

begin
  if FChecked <> Value then
  begin
    FChecked := Value;
    TabStop := Value;
    if HandleAllocated then
      SendMessage(Handle, BM_SETCHECK, Integer(Checked), 0);
    if Value then
    begin
      TurnSiblingsOff;
      inherited Changed;
      if not ClicksDisabled then Click;
    end;
  end;
end;

procedure TMyRadioButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if not FMouseinControl and not (csDesigning in ComponentState) then
  begin
    FMouseInControl := True;
    if Enabled then Repaint;
  end;
end;

procedure TMyRadioButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if FMouseinControl then
  begin
    FMouseInControl := False;
    if Enabled then Repaint;
  end;
end;

procedure TMyRadioButton.CreateWnd;
begin
  inherited CreateWnd;
  SendMessage(Handle, BM_SETCHECK, Integer(FChecked), 0);
end;

procedure TMyRadioButton.CNCommand(var Message: TWMCommand);
begin
  case Message.NotifyCode of
    BN_CLICKED: SetChecked(True);
    BN_DOUBLECLICKED: DblClick;
  end;
end;

end.

　ラジオボタンのサンプルプログラムも圧縮ファイルに入っているので試してみてください。
単色で殺風景な画面が少しは、カラフルになるでしょう。　　　　

    　MyRadioButtonD.zip

　　　　　　コンポーネント一覧へ戻る