Delphi XE7实现TTabControl在TabItem添加关闭按钮

介绍

本文章介绍了Delphi XE7实现TTabControl在TabItem添加关闭按钮，该程序使用到了uFMXTabItemWithCloseBtn，在这个单元中实现了点击按钮关闭tabitem的功能，具体代码如下：

1. unit uFMXTabItemWithCloseBtn;
   
2. 
   
3. interface
   
4. 
   
5. uses
   
6.   FMX.TabControl;
   
7. 
   
8. type
   
9.   TTabControlHelper = class helper for TTabControl
   
10.   private
    
11.     procedure CloseButtonClick(Sender: TObject);
    
12.     procedure TimerOnTimer(Sender: TObject);
    
13.   public
    
14.     procedure CheckCloseBtn(const iBtnResourceName: String = 'closebutton');
    
15.   end;
    
16. 
    
17. implementation
    
18. 
    
19. uses
    
20.   System.UITypes
    
21.   , System.Classes
    
22.   , FMX.Types
    
23.   , FMX.StdCtrls
    
24.   ;
    
25. 
    
26. { TTabControlHelper }
    
27. 
    
28. var
    
29.   GRemoveTimer: TTimer;
    
30.   GIndex: Integer;
    
31.   GRemoveTab: TTabItem;
    
32.   GTabControlHelperChecked: Boolean = False;
    
33. 
    
34. procedure TTabControlHelper.CheckCloseBtn;
    
35. var
    
36.   B: TFmxObject;
    
37.   TabItem: TTabItem;
    
38.   i: Integer;
    
39. begin
    
40.   if (GTabControlHelperChecked) then
    
41.     Exit;
    
42. 
    
43.   for i := 0 to TabCount - 1 do begin
    
44.     TabItem := Tabs[i];
    
45. 
    
46.     B := TabItem.FindStyleResource(iBtnResourceName);
    
47. 
    
48.     if (B <> nil) and (B is TCustomButton) then begin
    
49.       B.TagObject := TabItem;
    
50. 
    
51.       TabItem.AutoSize := False;
    
52.       TabItem.Width := TabItem.Width + TCustomButton(B).Width * 1.5;
    
53. 
    
54.       TCustomButton(B).OnClick := CloseButtonClick;
    
55. 
    
56.       GTabControlHelperChecked := True;
    
57.     end;
    
58.   end;
    
59. end;
    
60. 
    
61. procedure TTabControlHelper.CloseButtonClick(Sender: TObject);
    
62. var
    
63.   TabItem: TTabItem;
    
64.   i: Integer;
    
65.   Len: Integer;
    
66. begin
    
67.   if (Sender is TCustomButton) then begin
    
68.     GRemoveTab := TTabItem(TCustomButton(Sender).TagObject);
    
69. 
    
70.     GIndex := -1;
    
71.     Len := TabCount - 1;
    
72. 
    
73.     for i := 0 to Len do begin
    
74.       TabItem := Tabs[i];
    
75. 
    
76.       if (TabItem = GRemoveTab) then begin
    
77.         if (i = Len) then begin
    
78.           if (Len > 0) then
    
79.             GIndex := i - 1;
    
80. 
    
81.           Break;
    
82.         end
    
83.         else begin
    
84.           GIndex := i;
    
85.           Break;
    
86.         end;
    
87.       end;
    
88.     end;
    
89. 
    
90.     GRemoveTab.Release;
    
91. 
    
92.     TabIndex := -1;
    
93. 
    
94.     if (GIndex <> -1) then begin
    
95.       GRemoveTimer := TTimer.Create(nil);
    
96.       GRemoveTimer.OnTimer := TimerOnTimer;
    
97.       GRemoveTimer.Interval := 20;
    
98.       GRemoveTimer.Enabled := True;
    
99.     end;
    
100.   end;
     
101. end;
     
102. 
     
103. procedure TTabControlHelper.TimerOnTimer(Sender: TObject);
     
104. var
     
105.   Ist: Boolean;
     
106.   i: Integer;
     
107. begin
     
108.   Ist := False;
     
109. 
     
110.   for i := 0 to TabCount - 1 do
     
111.     if (Tabs[i] = GRemoveTab) then begin
     
112.       Ist := True;
     
113.       Break;
     
114.     end;
     
115. 
     
116.   if (Ist) then
     
117.     Exit;
     
118. 
     
119.   GRemoveTimer.DisposeOf;
     
120.   GRemoveTImer := nil;
     
121.   GRemoveTab := nil;
     
122. 
     
123.   TabIndex := GIndex;
     
124. end;
     
125. 
     
126. end.

复制代码

然后在主程序上进行调用

1. unit Unit1;
   
2. 
   
3. interface
   
4. 
   
5. uses
   
6.   System.SysUtils
   
7.   , System.Types
   
8.   , System.Classes
   
9.   , System.Generics.Collections
   
10.   , FMX.Types
    
11.   , FMX.Controls
    
12.   , FMX.Graphics
    
13.   , FMX.Forms
    
14.   , FMX.StdCtrls
    
15.   , FMX.TabControl
    
16.   ;
    
17. 
    
18. type
    
19.   TForm1 = class(TForm)
    
20.     StyleBook1: TStyleBook;
    
21.     TabControl1: TTabControl;
    
22.     TabItem1: TTabItem;
    
23.     TabItem2: TTabItem;
    
24.     TabItem3: TTabItem;
    
25.     procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
    
26.   private
    
27.   public
    
28.   end;
    
29. 
    
30. var
    
31.   Form1: TForm1;
    
32. 
    
33. implementation
    
34. 
    
35. uses
    
36.   uFMXTabItemWithCloseBtn;
    
37. 
    
38. {$R *.fmx}
    
39. 
    
40. procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
    
41.   const ARect: TRectF);
    
42. begin
    
43.   TabControl1.CheckCloseBtn;
    
44. end;
    
45. 
    
46. end.