How to correctly override TRadioButton and add a property to the TRadioButton class?

Question

In a 32-bit VCL Application in Windows 10 in Delphi 11.1 Alexandria, I have 5 TRadioButton controls directly on a TRelativePanel. I want to use 3 of them as an INDEPENDENT Group without using a container control such as TPanel for these 3 TRadioButton controls, meaning that when I click on one of these 3 TRadioButton controls, the remaining 2 TRadioButton controls will not be unchecked.

For this purpose, I have overridden the protected SetChecked method in the TRadioButton class:

type
  TMyRadioButton = class(Vcl.StdCtrls.TRadioButton)
  private
    FChecked: Boolean;
  protected
    procedure SetChecked(Value: Boolean); override;
  end;

implementation

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
    begin
      SendMessage(Handle, BM_SETCHECK, WPARAM(Checked), 0);
      if not (csLoading in ComponentState) and IsCustomStyleActive and Visible then
        SendMessage(Handle, WM_SETREDRAW, 1, 0);
    end;
    if Value then
    begin
      TurnSiblingsOff;
      inherited Changed;
      if not ClicksDisabled then
        Click;
    end;
  end;
end;

You can see that I changed the TurnSiblingsOff procedure to consider only TMyRadioButton controls, so not to uncheck the remaining 2 TRadioButton controls.

Then I redeclared the 3 TRadioButton controls I want to become independent as TMyRadioButton:

rbSortNone: TMyRadioButton;
rbSortPath: TMyRadioButton;
rbSortModified: TMyRadioButton;

However, In Objectinspector these 3 controls are still declared as TRadioButton!:

Why?

Then in a second step, I am planning to add a property GroupIndex, so that only controls with the same GroupIndex would be unchecked. How can I do this?

You changed the PAS, but not the DFM. But changing the DFM will not work for you. If you want to use your custom component at design time, you need to install it in the IDE by putting it in a package and installing it. Or just use an interposer class, if you only need your code at runtime (and not in the IDE). — Andreas Rejbrand, Jul 20 '22 at 16:12
This was meant to be an interposer class. But when I click on a `TMyRadioButton` control, also the `TRadioButton` controls get unchecked. (Which should not be because I have changed the `TurnSiblingsOff ` procedure). — user1580348, Jul 20 '22 at 16:21
It isn't! If it says `TRadioButton` in the DFM, then a `TRadioButton` is what you get. If you try `ShowMessage(rbSortNone.ClassName);` you will get `TRadioButton`. An interposer class has the same name as the original class. — Andreas Rejbrand, Jul 20 '22 at 16:27
OK, then I will try to create a `TGroupedRadioButton` component and install it in a package. — user1580348, Jul 20 '22 at 16:30

user1580348 · Accepted Answer · 2022-07-22T10:03:32.697

This is the latest version of my new component TGroupRadioButton in GroupRadioButton.pas (Note the new property GroupIndex):

unit GroupRadioButton;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls;

type
  TGroupRadioButton = class(Vcl.StdCtrls.TRadioButton)
  private
    { Private declarations }
    FChecked: Boolean;
    FGroupIndex: Integer;
    procedure SetGroupIndex(const Value: Integer);
  protected
    { Protected declarations }
    procedure SetChecked(Value: Boolean); override;
    function GetChecked: Boolean; override;
    procedure CreateWnd; override;
  public
    { Public declarations }
  published
    { Published declarations }
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex;
  end;

procedure Register;

implementation

uses
  Winapi.Windows, Vcl.ActnList, Winapi.Messages;

{ TGroupRadioButton }

function TGroupRadioButton.GetChecked: Boolean;
begin
  Result := FChecked;
end;

procedure TGroupRadioButton.SetChecked(Value: Boolean);

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

begin
  if FChecked <> Value then
  begin
    FChecked := Value;
    TabStop := Value;
    if HandleAllocated then
    begin
      SendMessage(Handle, BM_SETCHECK, WPARAM(Checked), 0);
      if not (csLoading in ComponentState) and IsCustomStyleActive and Visible then
        SendMessage(Handle, WM_SETREDRAW, 1, 0);
    end;
    if Value then
    begin
      TurnSiblingsOff;
      inherited Changed;
      if not ClicksDisabled then
        Click;
    end;
  end;
end;

procedure TGroupRadioButton.CreateWnd;
begin
  inherited CreateWnd;
  SendMessage(Handle, BM_SETCHECK, WPARAM(FChecked), 0);
end;

procedure TGroupRadioButton.SetGroupIndex(const Value: Integer);
begin
  FGroupIndex := Value;
end;

procedure Register;
begin
  RegisterComponents('PASoft', [TGroupRadioButton]);
end;

end.

And this is the package PackageGroupRadioButton.dpk:

package PackageGroupRadioButton;

{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS ON}
{$RANGECHECKS ON}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$IMPLICITBUILD ON}

requires
  rtl,
  vclimg,
  vcl,
  soaprtl;

contains
  GroupRadioButton in 'GroupRadioButton.pas';

end.

So now I have created this demo app:

Here is the DPR:

program Demo;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Here is the PAS:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GroupRadioButton, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    GroupRadioButton1: TGroupRadioButton;
    GroupRadioButton2: TGroupRadioButton;
    GroupRadioButton3: TGroupRadioButton;
    GroupRadioButton4: TGroupRadioButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.

And here is the DFM:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 255
  ClientWidth = 392
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -15
  Font.Name = 'Segoe UI'
  Font.Style = []
  Position = poScreenCenter
  PixelsPerInch = 120
  TextHeight = 20
  object GroupRadioButton1: TGroupRadioButton
    Left = 61
    Top = 140
    Width = 277
    Height = 21
    Margins.Left = 4
    Margins.Top = 4
    Margins.Right = 4
    Margins.Bottom = 4
    Caption = 'GroupRadioButton1 (GroupIndex=1)'
    TabOrder = 2
    GroupIndex = 1
  end
  object GroupRadioButton2: TGroupRadioButton
    Left = 61
    Top = 180
    Width = 277
    Height = 21
    Margins.Left = 4
    Margins.Top = 4
    Margins.Right = 4
    Margins.Bottom = 4
    Caption = 'GroupRadioButton2 (GroupIndex=1)'
    TabOrder = 3
    GroupIndex = 1
  end
  object GroupRadioButton3: TGroupRadioButton
    Left = 61
    Top = 30
    Width = 277
    Height = 21
    Margins.Left = 4
    Margins.Top = 4
    Margins.Right = 4
    Margins.Bottom = 4
    Caption = 'GroupRadioButton3 (GroupIndex=0)'
    Checked = True
    TabOrder = 0
    TabStop = True
    GroupIndex = 0
  end
  object GroupRadioButton4: TGroupRadioButton
    Left = 61
    Top = 70
    Width = 277
    Height = 21
    Margins.Left = 4
    Margins.Top = 4
    Margins.Right = 4
    Margins.Bottom = 4
    Caption = 'GroupRadioButton4 (GroupIndex=0)'
    TabOrder = 1
    GroupIndex = 0
  end
end

Here is a short demonstration video:

You should not do all this stuff in **Get**Checked; that causes a lot of confusion. Only modify **Set**Checked. — Andreas Rejbrand, Jul 21 '22 at 11:57
I took the original **Set**Checked and changed the line (in an interposer class!) to `if (Sibling <> Self) and (Sibling is TRadioButton) and (Sibling.Tag = Self.Tag) then` and now I can put ten `TRadioButton` controls on my form, some with `Tag = 1` and some with `Tag = 2`, and they work as two independent groups. Unfortunately, since SO isn't a forum, I'm don't have anywhere to publish this code. — Andreas Rejbrand, Jul 21 '22 at 12:01
@AndreasRejbrand This seems to be a great idea - unfortunately, it does not work in my implementation: I created this interposer class type in a new VCL Application: https://www.screencast.com/t/4LJSmtxsu with this implementation: https://www.screencast.com/t/In1uidgqkwLo — user1580348, Jul 21 '22 at 15:32
Here is the example at run-time: https://www.screencast.com/t/DfBYnj8e No RadioButton can be checked! — user1580348, Jul 21 '22 at 15:39
Here's an example: https://i.stack.imgur.com/ikLSD.gif Code: https://privat.rejbrand.se/rbgr.pas — Andreas Rejbrand, Jul 21 '22 at 15:39
The example looks nice - how is your implementation different from mine? Couldn't you write an answer here? — user1580348, Jul 21 '22 at 15:41
Ah - I forgot the `TRadioButton.GetChecked` implementation. But when using the tags 0 and 1 it still doesn't work. — user1580348, Jul 21 '22 at 16:00
It works on all my machines. Are you sure you tested this code *in a brand, new VCL app*, with ordinary `TRadioButton` controls (not your new control)? The DFM must contain only `TRadioButton`. — Andreas Rejbrand, Jul 21 '22 at 16:11
Yes, only `TRadioButton` in a brand new VCL Application. Now they act as one whole group although they use different tags (each two). Something must be different in your DFM. Could you also post the DFM to find out what's different? I am really curious. — user1580348, Jul 21 '22 at 16:15
Your project with your DFM and your PAS works perfectly here. But although I use your same interposer class in my own project, it does not work with my own project: The RadioButtons work as one whole group although they have 2 different tag values! I'm getting nuts. — user1580348, Jul 21 '22 at 16:46
Well, clearly there is something interfering in your own project, and it is impossible for me to debug that remotely! — Andreas Rejbrand, Jul 21 '22 at 16:47
I found it: I've placed the interposer class type declaration in my project PAS AFTER the Form declaration! After having placed the interposer declaration BEFORE the Form declaration it works now. Sorry for my stupidity! But there must be another SUBTLE difference: At run-time, when trying to check the FIRST RadioButton (which is unchecked by design-time), it doesn't get checked! All other unchecked RadioButtons can get checked after program start, except the first one). — user1580348, Jul 21 '22 at 17:19

user1580348 · Answer 2 · 2022-07-22T06:28:17.273

This (ultimate) answer is based completely on Andreas Rejbrand's idea to use an interposer class only (without new components):

Here is the DPR source:

program TRadioButtonGroupingWithTag;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Here is the PAS source:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Actions, Vcl.ActnList;

type
  TRadioButton = class(Vcl.StdCtrls.TRadioButton)
  private
    { Private declarations }
    FChecked: Boolean;
  protected
    { Protected declarations }
    procedure SetChecked(Value: Boolean); override;
    function GetChecked: Boolean; override;
    procedure CreateWnd; override;
  public
    { Public declarations }
  published
    { Published declarations }
  end;

type
  TForm1 = class(TForm)
    RadioButton1_Tag0: TRadioButton;
    RadioButton2_Tag0: TRadioButton;
    RadioButton3_Tag1: TRadioButton;
    RadioButton4_Tag1: TRadioButton;
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TRadioButton }

function TRadioButton.GetChecked: Boolean;
begin
  Result := FChecked;
end;

procedure TRadioButton.SetChecked(Value: Boolean);

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

begin
  if FChecked <> Value then
  begin
    FChecked := Value;
    TabStop := Value;
    if HandleAllocated then
    begin
      SendMessage(Handle, BM_SETCHECK, WPARAM(Checked), 0);
      if not (csLoading in ComponentState) and IsCustomStyleActive and Visible then
        SendMessage(Handle, WM_SETREDRAW, 1, 0);
    end;
    if Value then
    begin
      TurnSiblingsOff;
      inherited Changed;
      if not ClicksDisabled then
        Click;
    end;
  end;
end;

procedure TRadioButton.CreateWnd;
begin
  inherited CreateWnd;
  SendMessage(Handle, BM_SETCHECK, WPARAM(FChecked), 0);
end;

end.

And here is the DFM source:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 177
  ClientWidth = 568
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -15
  Font.Name = 'Segoe UI'
  Font.Style = []
  Position = poScreenCenter
  PixelsPerInch = 120
  TextHeight = 20
  object RadioButton1_Tag0: TRadioButton
    Tag = 1
    Left = 80
    Top = 50
    Width = 171
    Height = 21
    Margins.Left = 4
    Margins.Top = 4
    Margins.Right = 4
    Margins.Bottom = 4
    Caption = 'RadioButton1_Tag0'
    Checked = True
    TabOrder = 0
    TabStop = True
  end
  object RadioButton2_Tag0: TRadioButton
    Tag = 1
    Left = 80
    Top = 90
    Width = 161
    Height = 21
    Margins.Left = 4
    Margins.Top = 4
    Margins.Right = 4
    Margins.Bottom = 4
    Caption = 'RadioButton2_Tag0'
    TabOrder = 1
  end
  object RadioButton3_Tag1: TRadioButton
    Tag = 2
    Left = 320
    Top = 50
    Width = 191
    Height = 21
    Margins.Left = 4
    Margins.Top = 4
    Margins.Right = 4
    Margins.Bottom = 4
    Caption = 'RadioButton3_Tag1'
    TabOrder = 2
  end
  object RadioButton4_Tag1: TRadioButton
    Tag = 2
    Left = 320
    Top = 90
    Width = 211
    Height = 21
    Margins.Left = 4
    Margins.Top = 4
    Margins.Right = 4
    Margins.Bottom = 4
    Caption = 'RadioButton4_Tag1'
    TabOrder = 3
  end
end

Here is a short demonstration video:

You can see the problem in your DFM. Compare the properties of the first radio button against the others. Can you see the difference? — Andreas Rejbrand, Jul 21 '22 at 19:35
In addition, regarding the "ultimate idea": I'd say that is to add the `and (Sibling.Tag = Self.Tag)` requirement or something with the same effect. This can be done as an interposer if you only need it in one place, but if you need it in several places, making a real new component (installed in the IDE) is better. And, of course, it is better to introduce a new property `GroupIndex: Integer` instead of using `Tag`. — Andreas Rejbrand, Jul 21 '22 at 19:41
"Compare the properties of the first radio button against the others." The main difference is that the first RadioButton is checked at design time. But it does not appear checked after the program start. So there must be something that makes it APPEAR unchecked. I say "APPEAR" because that's the cause it SEEMS it cannot be checked after the program start: Because it is already checked but its checked state is not (yet?) visible. What does it block to show its Checked state? — user1580348, Jul 21 '22 at 21:11
The problem is that our child class introduces the `FChecked` field. Thus, our child class has *two* fields named `FChecked`: the original one (Vcl.StdCtrls.TRadioButton, line 1213 my version) and the new one you declare. Of course this can lead to confusion, and I'd say this is unfeasible, were it not for the surprising fact that the VCL only uses its field in three places, and two of those are in `GetChecked` and `SetChecked` which by a happy coincident are `virtual` and can be overridden. We override these and use our `FChecked` instead of the original one. — Andreas Rejbrand, Jul 21 '22 at 21:24
The problem is the third occurrence of the original `FChecked`, in `procedure TRadioButton.CreateWnd;`. You need to override this one as well and do a `SendMessage(Handle, BM_SETCHECK, WPARAM(FChecked), 0);` with your own `FChecked`. — Andreas Rejbrand, Jul 21 '22 at 21:25
I will try this first thing in the morning. Also creating the component with `GroupIndex`. — user1580348, Jul 21 '22 at 21:42
Done: 1. Added `TRadioButton.CreateWnd` in the interposer class 2. Created new working version of `TGroupRadioButton` component. — user1580348, Jul 22 '22 at 08:52

How to correctly override TRadioButton and add a property to the TRadioButton class?

2 Answers2