Delphi XE6從VCL代碼創建FMX TRadioGroup?
我試圖使用VCL代碼創建一個FMX TRadioGroup。一切有關控制似乎工作正常,除了以下問題
1)似乎焦點迷失在控制和RadioButton(當前索引)不顯示點擊,如果我點擊另一個控件,特別是另一個TTestRadioGroup控件。
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.
VCL和FMX是不同的框架,他們沒有設計爲一起使用。這就是說,你並沒有創建一個VCL項目或使用VCL代碼。您僅創建一個FMX代碼的FMX項目。此代碼中沒有VCL。你應該從你的問題中刪除它。 –
這裏有兩個問題,你應該將它們分開。只有一次答案才能被接受! – Dsm
@DSM - 好的,完成! – JakeSays