Can Firemonkey TTabControl replicate VCL TPageControl.OnChanging event? - delphi

Question

I'm Running Delphi Dx Seattle
In Delphi VCL's TPageControl there is a onChanging event where you could stop the page control from changing tab's
procedure TForm1.pgc1Changing(Sender: TObject; var AllowChange: Boolean);
begin
if MessageDlg('do you want to change tab?', mtConfirmation, [mbyes, mbno], 0, mbNo) = mrno then
AllowChange := false;
end;
Is there a way for Delphi Firemonkey TTabControl to replicate this?
e.g.if you have two tabs and clicking on the other tab pops up a question 'do you want to change tab?'
if you click No nothing happens click yes then it changes

Answer 1

This is the code i ended up using - it works with windows and android haven't tested with IOS
Ended up having to override some of the components procedures
TTabItem = class(FMX.TabControl.TTabItem)
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
end;
TTabControl = class(FMX.TabControl.TTabControl)
function GetTabIndex : integer;
public
procedure SetTabIndexv2(const Value: Integer);
property TabIndex: Integer read GetTabIndex write SetTabIndexv2 default -1;
end;
Here is an example of the full code
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl,
FMX.Controls.Presentation, FMX.StdCtrls;
type
TTabItem = class(FMX.TabControl.TTabItem)
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
end;
TTabControl = class(FMX.TabControl.TTabControl)
function GetTabIndex : integer;
public
procedure SetTabIndexv2(const Value: Integer);
property TabIndex: Integer read GetTabIndex write SetTabIndexv2 default -1;
end;
TForm1 = class(TForm)
tbc1: TTabControl;
tbtm1: TTabItem;
tbtm2: TTabItem;
btn1: TButton;
lblTab1: TLabel;
lblTab2: TLabel;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TTabItem.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Single);
begin
if (self.TabControl.ActiveTab <> self) and
((Button = TMouseButton.mbLeft) or (ssDouble in Shift)) then begin
MessageDlg('[Tab Item] do you want to do this?', System.UITypes.TMsgDlgType.mtInformation,
[System.UITypes.TMsgDlgBtn.mbYes, System.UITypes.TMsgDlgBtn.mbNo], 0, procedure (const AResult: TModalResult)
begin
begin
case AResult of
mrYes: self.TabControl.ActiveTab := self;
mrNo:;
end;
end;
end);
end else begin
inherited;
end;
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
if tbc1.TabIndex = 0 then
tbc1.TabIndex := 1
else
tbc1.TabIndex := 0;
end;
{ TTabControl }
function TTabControl.GetTabIndex: integer;
begin
result := FMX.TabControl.TTabControl(Self).TabIndex;
end;
procedure TTabControl.SetTabIndexv2(const Value: Integer);
begin
if self.TabIndex <> value then begin
MessageDlg('[tabcontrol] do you want to do this?', System.UITypes.TMsgDlgType.mtInformation,
[System.UITypes.TMsgDlgBtn.mbYes, System.UITypes.TMsgDlgBtn.mbNo], 0, procedure (const AResult: TModalResult)
begin
begin
case AResult of
mrYes: begin
FMX.TabControl.TTabControl(Self).TabIndex := value;
end;
mrNo : ;
end;
end;
end);
end;
end;
end.
if you can see any way to improve it please let me know