Firemonkey TTabControl

Question

我有一个问题。

我添加了一个带有这个简单代码的按钮，但它没有编译任何解决方案？

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.Controls.Presentation, FMX.StdCtrls, FMX.TabControl;

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;

type
  TForm1 = class(TForm)
    tbc1: TTabControl;
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

{ TTabItem }

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;

{ 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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if tbc1.TabIndex = 0 then
    tbc1.TabIndex := 1
  else
    tbc1.TabIndex := 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  tbitem: TTabItem;
begin
  tbitem := tbc1.Add( ); //Here Error !!!
end;

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.Controls.Presentation, FMX.StdCtrls, FMX.TabControl; 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; type TForm1 = class(TForm) tbc1: TTabControl; TabItem1: TTabItem; TabItem2: TTabItem; Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} { TTabItem } 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; { 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; procedure TForm1.Button1Click(Sender: TObject); begin if tbc1.TabIndex = 0 then tbc1.TabIndex := 1 else tbc1.TabIndex := 0; end; procedure TForm1.Button2Click(Sender: TObject); var tbitem: TTabItem; begin tbitem := tbc1.Add( ); //Here Error !!! end; end. [dcc32错误] Unit1.pas（106）：E2010不兼容的类型：'Unit1.TTabItem'和'FMX.TabControl.TTabItem'

Delphi can Fire monkey TTabControl replicate VCL TPageControl.OnChanging event

Answer 1

你快到了。

procedure TForm15.ButtonRandomSeedClick(Sender: TObject);
var
  tbitem: TTabItem;
begin
  tbitem := TabControl1.Add( TTabItem ) as TTabItem; //<<<<< Change 1
  tbItem.Text := 'Tab ' + IntToStr( TabControl1.TabCount );
end;

procedure TForm15.TabItem1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var
  tbitem: TTabItem;
begin
  tbitem := (Sender as TTabItem);  // <<<<<<this change for testing only  
  if (tbItem <> TabControl1.ActiveTab) 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: TabControl1.ActiveTab := (Sender as TTabItem);
          mrNo:;
        end;
      end;
    end);
  end else begin
    inherited;
  end;

end;

按您的意愿工作。 （我的名字与你的名字不同）

Answer 2

通过对代码的修改，只要选择了一个选项卡，就会显示一个询问“你想这样做”的弹出窗口。

procedure TForm22.Button2Click(Sender: TObject);
var
  tbitem: TTabItem;
begin
//  tbitem := tbc1.Add( ); //Here Error !!!
  tbItem := TTabItem(tbc1.Add(TTabItem));
  tbitem.Text := 'Item '+tbitem.Index.ToString();
end;

我添加的第二行只是为了查看标签中的一些文字。