Firemonkey TTabControl 可以复制 VCL TPageControl.OnChanging 事件吗？

Question

我是运行 Delphi 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 有办法复制这个吗？例如
如果您有两个选项卡，点击另一个选项卡会弹出一个问题'do you want to change tab?'
如果你点击没有任何反应点击是然后它改变

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.

如果您能找到任何改进方法，请告诉我

Firemonkey TTabControl 可以复制 VCL TPageControl.OnChanging 事件吗？

Can Firemonkey TTabControl replicate VCL TPageControl.OnChanging event?

delphi

tabcontrol

firemonkey