Search code examples
delphifiremonkeyvcl

Creating a FMX TRadioGroup from VCL Code?

Delphi XE6

Im trying to create a FMX TRadioGroup using code from the VCL. Everything about the control seems to work fine, except the following issues

1.) It seems that the focus gets lost on the control and the RadioButton (current index) doesn't show clicked, if i click on another control, particularly another TTestRadioGroup control.

2.) In FMX controls, I would like to rearrange my buttons when a resize happens, however, it seems as if the resize method does not work if you override it.

thanx

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.
Solution

  • It turns out that it was the grouping that was causing the issue:

    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;