Question

Delphi XE6

我尝试使用VCL中的代码创建FMX TRadioGroup。关于控件的一切似乎都运行良好，除了以下问题

1。）如果我点击另一个控件，特别是另一个TTestRadioGroup控件，似乎焦点在控件上丢失并且RadioButton（当前索引）没有显示点击。

2。）在FMX控件中，我想在调整大小时重新排列我的按钮，但是，如果重写它，似乎resize方法不起作用。

感谢名单

unit TestComponents;

interface

uses {$IFDEF MSWINDOWS}Windows, {$ENDIF}
 System.Classes, FMX.Edit, System.UITypes, System.Character, FMX.DateTimeCtrls,
 System.SysUtils, FMX.Types, System.DateUtils, System.SysConst, FMX.Controls,
 FMX.Pickers, FMX.Platform, FMX.Text, math, FMX.Consts, FMX.Forms, FMX.StdCtrls;

type

 TTestRadioGroup = class;

 TTestGroupButton = class(TRadioButton)
  private
  protected
  public
    constructor InternalCreate(RadioGroup: TTestRadioGroup);
    destructor Destroy; override;
  end;

  TTestRadioGroup = class(TGroupBox)
   private
    FButtons: TList;
    FItems: TStrings;
    FItemIndex: Integer;
    FColumns: Integer;
    FUpdating: Boolean;
    FButtonLeftMargin: Integer; //radio buttons left margin
    FButtonTopMargin: Integer;  //radio buttons starting Y postition
    FButtonSpacing: Integer;    //space between radio buttons
    FButtonWidth: Integer; //width of the radio buttons
    FColumnSpacing: Integer;    //space between radio button columns
    function GetButtons(Index: Integer): TRadioButton;
    procedure SetButtonLeftMargin(Value: Integer);
    procedure SetButtonTopMargin(Value: Integer);
    procedure SetButtonSpacing(Value: Integer);
    procedure SetButtonWidth(Value: Integer);
    procedure SetColumnSpacing(Value: Integer);
    procedure SetColumns(Value: Integer);
    procedure SetItemIndex(Value: Integer);
    procedure SetItems(Value: TStrings);
    procedure ItemsChange(Sender: TObject);
    procedure SetButtonCount(Value: Integer);
    procedure ButtonClick(Sender: TObject);
    procedure UpdateButtons; //updates buttons list from Items list
    procedure ArrangeButtons; //rearranges buttons on Groupbox based on new properties
   protected
   public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Resize; override;
    property Buttons[Index: Integer]: TRadioButton read GetButtons;
   published
    property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
    property Items: TStrings read FItems write SetItems;
    property Columns: Integer read FColumns write SetColumns default 1;
    property ButtonLeftMargin: Integer read FButtonLeftMargin write SetButtonLeftMargin default 10;
    property ButtonTopMargin: Integer read FButtonTopMargin write SetButtonTopMargin default 50;
    property ButtonSpacing: Integer read FButtonSpacing write SetButtonSpacing default 20;
    property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 50;
    property ColumnSpacing: Integer read FColumnSpacing write SetColumnSpacing default 100;
  end;


procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Test', [TTestRadioGroup, TTestGroupButton]);
end;


{ TTestGroupButton }

constructor TTestGroupButton.InternalCreate(RadioGroup: TTestRadioGroup);
begin
  inherited Create(RadioGroup);
  RadioGroup.FButtons.Add(Self);
  Visible := False;
  Enabled := RadioGroup.Enabled;
  OnClick := RadioGroup.ButtonClick;
  Parent := RadioGroup;
  Stored:= False;
end;

destructor TTestGroupButton.Destroy;
begin
  TTestRadioGroup(Owner).FButtons.Remove(Self);
  inherited Destroy;
end;

{ TTestRadioGroup }

constructor TTestRadioGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FButtons := TList.Create;
  FItems := TStringList.Create;
  TStringList(FItems).OnChange := ItemsChange;
  FItemIndex := -1;
  FColumns := 1;
  FButtonLeftMargin:= 10;
  FButtonTopMargin:= 50;
  FButtonSpacing:= 20;
  fButtonWidth:= 50;
  FColumnSpacing:= 20;
end;

destructor TTestRadioGroup.Destroy;
begin
  SetButtonCount(0);
  TStringList(FItems).OnChange := nil;
  FItems.Free;
  FButtons.Free;
  inherited Destroy;
end;

procedure TTestRadioGroup.ArrangeButtons;
const
 MAXBTNSPERCOL = 100;
var
 I, X,Y: Integer ;
 BtnCount, BtnsPerCol: Integer;
begin
  if (FButtons.Count <> 0) then
  begin
    try
     BtnCount:= 0; //initialize local button count
     BtnsPerCol:= 0; //initialize local buttons per column
     if  FColumns > 1 then
      BtnsPerCol:= FButtons.Count DIV fColumns //get # of btn per col
     else
      BtnsPerCol:= MAXBTNSPERCOL;
      X:= FButtonLeftMargin; //set the intial X position
      Y:= FButtonTopMargin; //set the initial Y position

      for I := 0 to FButtons.Count - 1 do
      begin
       if BtnCount <= BtnsPerCol then
       begin
       TTestGroupButton(FButtons[I]).Position.X:= X;
       TTestGroupButton(FButtons[I]).Position.Y:= Y;
       Y:= Y + FButtonSpacing;
       end //if btnCount
       else
       begin
        Y:= FButtonTopMargin;
        X:= X + FButtonWidth + FColumnSpacing;
        TTestGroupButton(FButtons[I]).Position.X:= X;
        TTestGroupButton(FButtons[I]).Position.Y:= Y;
       end; //else
       if BtnCount = BtnsPerCol then
       begin
        Y:= FButtonTopMargin;
        X:= X + FButtonWidth + FColumnSpacing;
        TTestGroupButton(FButtons[I]).Position.X:= X;
        TTestGroupButton(FButtons[I]).Position.Y:= Y;
        BtnCount:= 0;
        Y:= Y + FButtonSpacing;
       end;
       TTestGroupButton(FButtons[I]).Visible := True;
       inc(BtnCount);
     end;

    finally
    end;
  end;
end;

procedure TTestRadioGroup.UpdateButtons;
var
  I: Integer;
begin
  SetButtonCount(FItems.Count);
  for I := 0 to FButtons.Count - 1 do
   begin
    TRadioButton(FButtons[I]).Width := FButtonWidth;
    TRadioButton(FButtons[I]).Text := FItems[I];
    TRadioButton(FButtons[I]).StyleLookup:= 'radiobuttonstyle';
   end;
  if FItemIndex >= 0 then
  begin
    FUpdating := True;
    TRadioButton(FButtons[FItemIndex]).isChecked := True;
    FUpdating := False;
  end;
  ArrangeButtons;
  Repaint;
end;

procedure TRunitRadioGroup.Resize;
begin
 inherited;
 ArrangeButtons;
// Repaint;
end;

procedure TTestRadioGroup.ButtonClick(Sender: TObject);
begin
  if not FUpdating then
  begin
    FItemIndex := FButtons.IndexOf(Sender);
    Change;
    Click;
  end;
end;


procedure TTestRadioGroup.ItemsChange(Sender: TObject);
begin
    if FItemIndex >= FItems.Count then
      FItemIndex := FItems.Count - 1;
    UpdateButtons;
end;

procedure TTestRadioGroup.SetColumns(Value: Integer);
begin
  if Value < 1 then Value := 1;
  if Value > 16 then Value := 16;
  if FColumns <> Value then
  begin
    FColumns := Value;
    ArrangeButtons;
    Repaint;
  end;
end;

procedure TTestRadioGroup.SetItemIndex(Value: Integer);
begin
 if Value < -1 then Value := -1;
 if Value >= FButtons.Count then Value := FButtons.Count - 1;
 if FItemIndex <> Value then
    begin
      if FItemIndex >= 0 then
        TRadioButton(FButtons[FItemIndex]).isChecked := False;
      FItemIndex := Value;
      if FItemIndex >= 0 then
        TRadioButton(FButtons[FItemIndex]).isChecked := True;
    end;
end;

procedure TTestRadioGroup.SetItems(Value: TStrings);
begin
  FItems.Assign(Value);
end;

procedure TTestRadioGroup.SetButtonCount(Value: Integer);
begin
  while FButtons.Count < Value do
    TTestGroupButton.InternalCreate(Self);
  while FButtons.Count > Value do
    TTestGroupButton(FButtons.Last).Free;
end;

procedure TTestRadioGroup.SetButtonLeftMargin(Value: Integer);
begin
 if FButtonLeftMargin <> Value then
  FButtonLeftMargin:= Value;
  ArrangeButtons;
end;

procedure TTestRadioGroup.SetButtonTopMargin(Value: Integer);
begin
 if FButtonTopMargin <> Value then
  FButtonTopMargin:= Value;
  ArrangeButtons;
end;

procedure TTestRadioGroup.SetButtonSpacing(Value: Integer);
begin
 if FButtonSpacing <> Value then
  FButtonSpacing:= Value;
  ArrangeButtons;
end;

procedure TTestRadioGroup.SetButtonWidth(Value: Integer);
var I: Integer;
begin
 if FButtonWidth <> Value then
 begin
  FButtonWidth:= Value;
  for I := 0 to FButtons.Count - 1 do
    TRadioButton(FButtons[I]).Width := FButtonWidth;
  ArrangeButtons;
 end;
end;

procedure TTestRadioGroup.SetColumnSpacing(Value: Integer);
begin
 if FColumnSpacing <> Value then
  FColumnSpacing:= Value;
  ArrangeButtons;
end;

function TTestRadioGroup.GetButtons(Index: Integer): TRadioButton;
begin
  Result := TRadioButton(FButtons[Index]);
end;

end.

Answer 1

我认为你失去焦点的原因是因为单击按钮OnClick事件调用了组ButtonClick事件，而这个事件又调用了无线电组点击事件，我相信这会给组按钮重点。

Answer 2

事实证明，导致问题的是分组：

protected
     procedure SetName(const NewName: TComponentName); override;


procedure TTestRadioGroup.SetName(const NewName: TComponentName);
var rg: TRadioButton;
begin
  inherited;
  for rg in FButtons do
    rg.GroupName := Newname;
end;

procedure TTestRadioGroup.SetButtonCount(Value: Integer);
var rg: TTestGroupButton;
begin
  while FButtons.Count < Value do begin
    rg := TTestGroupButton.InternalCreate(Self);
    rg.GroupName := self.Name;
  end;
  while FButtons.Count > Value do
    TTestGroupButton(FButtons.Last).Free;
end;

从VCL代码创建FMX TRadioGroup？

2 个答案: