代码之家 › 专栏 › 技术社区 › Wesley Bobato

Firemonkey TTabControl:添加选项卡项

tabitem tabcontrol firemonkey delphi

Wesley Bobato · 技术社区 · 6 年前

我添加了一个 TTabItem 使用此简单代码但不编译:

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错误]第一单元。pas(106):E2010不兼容类型:“第一单元。TTabItem和FMX。选项卡控件。TTabItem'

Can Firemonkey TTabControl replicate VCL TPageControl.OnChanging event?

2 回复 | 直到 3 年前

Dsm 6 年前

你就快到了。

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;

按您的意愿工作。(我的名字和你的不同)

Tom Brunberg 6 年前

通过对代码的修改,每当要选择选项卡时,都会显示一个弹出窗口,询问“do you want to do this”。

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;

我添加的第二行只是为了在选项卡中看到一些文本。