Delphi能夠火猴TTabControl複製VCL TPageControl.OnChanging事件

Question

我跑德爾福DX西雅圖

在Delphi VCL的TPageControl有一個onChanging事件，您可以更改標籤的

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; 

停止，頁面控制

Delphi Firemonkey TTabControl有沒有辦法複製這個？ 例如
如果你有兩個標籤，點擊另一個標籤彈出一個問題'你想改變標籤嗎？'
如果您單擊否沒有任何反應單擊是，那麼它的變化

Answer 1

這是我最後使用的代碼 - 它適用於Windows和Android都沒有與IOS

測試

最後不得不重寫一些組件的過程

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; 

這裏是全碼

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. 

的一個例子

如果您看到任何改進方法，請讓我知道