Question

我正在运行Delphi Dx Seattle

在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.

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

Delphi可以通过Fire猴子TTabControl复制VCL TPageControl.OnChanging事件

1 个答案: