delphi 如何正确地重写TRiodeButton并向TRiodeButton类添加属性？

1l5u6lss 于 2022-11-04 发布在其他

关注(0)|答案(2)|浏览(160)

在 Delphi 11.1 Alexandria的Windows 10中的一个32位VCL应用程序中，我有5个TRadioButton控件直接位于TRelativePanel上。我希望将其中3个作为独立组使用，而不使用容器控件（如TPanel）用于这3个TRadioButton控件，这意味着当我单击这3个TRadioButton控件中的一个时，剩余的2个TRadioButton控件将不会被取消选中。
为此，我重写了TRadioButton类中受保护的SetChecked方法：

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;

您可以看到，我更改了TurnSiblingsOff过程以仅考虑TMyRadioButton控件，因此不要取消选中其余的2个TRadioButton控件。
然后，我重新声明了3个要独立的TRadioButton控件为TMyRadioButton：

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

但是，在Objectinspector中，这3个控件仍然声明为TRadioButton！：

为什么？
然后在第二步中，我计划添加一个属性GroupIndex，这样只有具有相同GroupIndex的控件才会被取消选中。

delphi

来源：https://stackoverflow.com/questions/73054891/how-to-correctly-override-tradiobutton-and-add-a-property-to-the-tradiobutton-cl

2条答案

按热度按时间

rks48beu1#

这是GroupRadioButton.pas中新组件TGroupRadioButton的最新版本（请注意新属性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.

这是一个包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.

现在我已经创建了这个演示应用程序：
下面是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.

以下是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.

这是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

下面是一个简短的演示视频：

赞(0）回复(0）举报 2022-11-04

unguejic2#

这个（最终的）答案完全基于Andreas Rejbrand的想法，即只使用一个插入器类（没有新的组件）：
以下是DPR来源：

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.

以下是PAS来源：

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.

这是DFM的来源：

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

下面是一个简短的演示视频：

赞(0）回复(0）举报 2022-11-04

我来回答

delphi 如何正确地重写TRiodeButton并向TRiodeButton类添加属性？

2条答案

相关问题

热门标签

最新问答