Delphi TTabControl在TabItem添加关闭按钮-木庄网络博客

本文整理自网络，侵删。
 
unit uFMXTabItemWithCloseBtn;
 
interface
 
uses
  FMX.TabControl;
 
type
  TTabControlHelper = class helper for TTabControl
  private
    procedure CloseButtonClick(Sender: TObject);
    procedure TimerOnTimer(Sender: TObject);
  public
    procedure CheckCloseBtn(const iBtnResourceName: String = 'closebutton');
  end;
 
implementation
 
uses
  System.UITypes
  , System.Classes
  , FMX.Types
  , FMX.StdCtrls
  ;
 
{ TTabControlHelper }
 
var
  GRemoveTimer: TTimer;
  GIndex: Integer;
  GRemoveTab: TTabItem;
  GTabControlHelperChecked: Boolean = False;
 
procedure TTabControlHelper.CheckCloseBtn;
var
  B: TFmxObject;
  TabItem: TTabItem;
  i: Integer;
begin
  if (GTabControlHelperChecked) then
    Exit;
 
  for i := 0 to TabCount - 1 do begin
    TabItem := Tabs[i];
 
    B := TabItem.FindStyleResource(iBtnResourceName);
 
    if (B <> nil) and (B is TCustomButton) then begin
      B.TagObject := TabItem;
 
      TabItem.AutoSize := False;
      TabItem.Width := TabItem.Width + TCustomButton(B).Width * 1.5;
 
      TCustomButton(B).OnClick := CloseButtonClick;
 
      GTabControlHelperChecked := True;
    end;
  end;
end;
 
procedure TTabControlHelper.CloseButtonClick(Sender: TObject);
var
  TabItem: TTabItem;
  i: Integer;
  Len: Integer;
begin
  if (Sender is TCustomButton) then begin
    GRemoveTab := TTabItem(TCustomButton(Sender).TagObject);
 
    GIndex := -1;
    Len := TabCount - 1;
 
    for i := 0 to Len do begin
      TabItem := Tabs[i];
 
      if (TabItem = GRemoveTab) then begin
        if (i = Len) then begin
          if (Len > 0) then
            GIndex := i - 1;
 
          Break;
        end
        else begin
          GIndex := i;
          Break;
        end;
      end;
    end;
 
    GRemoveTab.Release;
 
    TabIndex := -1;
 
    if (GIndex <> -1) then begin
      GRemoveTimer := TTimer.Create(nil);
      GRemoveTimer.OnTimer := TimerOnTimer;
      GRemoveTimer.Interval := 20;
      GRemoveTimer.Enabled := True;
    end;
  end;
end;
 
procedure TTabControlHelper.TimerOnTimer(Sender: TObject);
var
  Ist: Boolean;
  i: Integer;
begin
  Ist := False;
 
  for i := 0 to TabCount - 1 do
    if (Tabs[i] = GRemoveTab) then begin
      Ist := True;
      Break;
    end;
 
  if (Ist) then
    Exit;
 
  GRemoveTimer.DisposeOf;
  GRemoveTImer := nil;
  GRemoveTab := nil;
 
  TabIndex := GIndex;
end;
 
end.
 
然后在主程序上进行调用
unit Unit1;
 
interface
 
uses
  System.SysUtils
  , System.Types
  , System.Classes
  , System.Generics.Collections
  , FMX.Types
  , FMX.Controls
  , FMX.Graphics
  , FMX.Forms
  , FMX.StdCtrls
  , FMX.TabControl
  ;
 
type
  TForm1 = class(TForm)
    StyleBook1: TStyleBook;
    TabControl1: TTabControl;
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    TabItem3: TTabItem;
    procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
  private
  public
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses
  uFMXTabItemWithCloseBtn;
 
{$R *.fmx}
 
procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
begin
  TabControl1.CheckCloseBtn;
end;
 
end.
 
来源：https://www.cnblogs.com/YiShen/p/9722997.html
Delphi TTabControl在TabItem添加关闭按钮

相关推荐

评论
