Firemonkey TTabControl可以复制VCL TPageControl.OnChanging事件吗？ [英] Can Firemonkey TTabControl replicate VCL TPageControl.OnChanging event?

问题描述

我正在运行Delphi Dx Seattle

I'm Running Delphi Dx Seattle

在Delphi VCL的TPageControl中有一个onChanging事件，您可以在其中停止页面控件更改选项卡的

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;

Delphi Firemonkey TTabControl是否可以复制此方法？
例如
如果您有两个选项卡，然后单击另一个选项卡，则会弹出一个问题：您要更改选项卡吗？

如果您单击否，则单击是，然后更改

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

推荐答案

这是我最终使用的代码-可以在Windows和android上使用，但尚未通过iOS进行测试

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

这篇关于Firemonkey TTabControl可以复制VCL TPageControl.OnChanging事件吗？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！