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

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?

CodePudding user response：

This is the latest version of my new component TGroupRadioButton in GroupRadioButton.pas:

unit GroupRadioButton;

interface

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

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

procedure Register;

implementation

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

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) 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;

function TGroupRadioButton.GetChecked: 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) 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
  Result := FChecked;
  TurnSiblingsOff;
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:

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)
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    GroupRadioButton1: TGroupRadioButton;
    GroupRadioButton2: TGroupRadioButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.

Now, checking GroupRadioButton1 UNCHECKS GroupRadioButton2 (if it is checked):

However, checking GroupRadioButton2 DOES NOT UNCHECK GroupRadioButton1 (if it is checked):

CodePudding user response：

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;
  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;

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

However, there must be another SUBTLE difference, as there is one thing that does not work as intended: At run-time, when trying to check the FIRST RadioButton (RadioButton1_Tag0, 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).

This short video documents this misbehavior: