Can Firemonkey TTabControl replicate VCL TPageControl.OnChanging event?

问题

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

回答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

来源：https://stackoverflow.com/questions/32877118/can-firemonkey-ttabcontrol-replicate-vcl-tpagecontrol-onchanging-event

标签

Delphi

tabcontrol

firemonkey