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.

Comments are closed.