如何在 Delphi XE3 FireMonkey 2 的 TTabControl 的每个选项卡上实现关闭按钮? [英] How to implement a close button on every tab of TTabControl in Delphi XE3 FireMonkey 2?
问题描述
我正在尝试创建一个浏览器风格的 TabControl,在 FireMonkey FM2 的每个选项卡上都有一个小的关闭按钮.
I am trying to create a browser-style TabControl with a small close button on every tab in FireMonkey FM2.
由于FM2中没有TTabsheet和TPageControl组件,我无法使用如何为TPageControl的TTabsheet实现关闭按钮".这段代码提供了太多未声明的函数和变量,我猜这些函数和变量在 FM2 中不再受支持.
Since there are no TTabsheet and TPageControl components in FM2, I could not use the answer from "How to implement a close button for a TTabsheet of a TPageControl". This code gives too many undeclared functions and variables that are not longer supported in FM2, I guess.
我不想使用任何第三方组件,因为你永远不知道它们是否会支持 Delphi 的下一个版本:)
I don't want to use any third-part components because you never know if they are going to support the next version of Delphi :)
我可以提供在 Delphi XE3 VCL(但不是 FireMonkey)中运行良好的完整代码:
I can provide the full code that works fine in Delphi XE3 VCL (but not FireMonkey):
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Math, Vcl.Themes;
type
TFormMain = class(TForm)
PageControlCloseButton: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
procedure FormCreate(Sender: TObject);
procedure PageControlCloseButtonMouseLeave(Sender: TObject);
procedure PageControlCloseButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PageControlCloseButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure PageControlCloseButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PageControlCloseButtonDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
private
FCloseButtonsRect: array of TRect;
FCloseButtonMouseDownIndex: Integer;
FCloseButtonShowPushed: Boolean;
public
{ Public declarations }
end;
var
FormMain: TFormMain;
implementation
{$R *.dfm}
procedure TFormMain.FormCreate(Sender: TObject);
var
I: Integer;
begin
PageControlCloseButton.TabWidth := 150;
PageControlCloseButton.OwnerDraw := True;
//should be done on every change of the page count
SetLength(FCloseButtonsRect, PageControlCloseButton.PageCount);
FCloseButtonMouseDownIndex := -1;
for I := 0 to Length(FCloseButtonsRect) - 1 do
begin
FCloseButtonsRect[I] := Rect(0, 0, 0, 0);
end;
end;
procedure TFormMain.PageControlCloseButtonDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
CloseBtnSize: Integer;
PageControl: TPageControl;
TabCaption: TPoint;
CloseBtnRect: TRect;
CloseBtnDrawState: Cardinal;
CloseBtnDrawDetails: TThemedElementDetails;
const
UseThemes: boolean=true;
begin
PageControl := Control as TPageControl;
if InRange(TabIndex, 0, Length(FCloseButtonsRect) - 1) then
begin
CloseBtnSize := 14;
TabCaption.Y := Rect.Top + 3;
if Active then
begin
CloseBtnRect.Top := Rect.Top + 4;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 6;
end
else
begin
CloseBtnRect.Top := Rect.Top + 3;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 3;
end;
CloseBtnRect.Bottom := CloseBtnRect.Top + CloseBtnSize;
CloseBtnRect.Left := CloseBtnRect.Right - CloseBtnSize;
FCloseButtonsRect[TabIndex] := CloseBtnRect;
PageControl.Canvas.FillRect(Rect);
PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y, PageControl.Pages[TabIndex].Caption);
if not UseThemes then
begin
if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
CloseBtnDrawState := DFCS_CAPTIONCLOSE + DFCS_PUSHED
else
CloseBtnDrawState := DFCS_CAPTIONCLOSE;
DrawFrameControl(PageControl.Canvas.Handle,
FCloseButtonsRect[TabIndex], DFC_CAPTION, CloseBtnDrawState);
end
else
begin
Dec(FCloseButtonsRect[TabIndex].Left);
if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonPushed)
else
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonNormal);
ThemeServices.DrawElement(PageControl.Canvas.Handle, CloseBtnDrawDetails,
FCloseButtonsRect[TabIndex]);
end;
end;
end;
procedure TFormMain.PageControlCloseButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
I: Integer;
begin
if Button = mbLeft then
begin
for I := 0 to Length(FCloseButtonsRect) - 1 do
begin
if PtInRect(FCloseButtonsRect[I], Point(X, Y)) then
begin
FCloseButtonMouseDownIndex := I;
FCloseButtonShowPushed := True;
PageControlCloseButton.Repaint;
end;
end;
end;
end;
procedure TFormMain.PageControlCloseButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
Inside: Boolean;
begin
if (ssLeft in Shift) and (FCloseButtonMouseDownIndex >= 0) then
begin
Inside := PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y));
if FCloseButtonShowPushed <> Inside then
begin
FCloseButtonShowPushed := Inside;
PageControlCloseButton.Repaint;
end;
end;
end;
procedure TFormMain.PageControlCloseButtonMouseLeave(Sender: TObject);
var
PageControl: TPageControl;
begin
FCloseButtonShowPushed := False;
PageControlCloseButton.Repaint;
end;
procedure TFormMain.PageControlCloseButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
PageControl: TPageControl;
begin
if (Button = mbLeft) and (FCloseButtonMouseDownIndex >= 0) then
begin
if PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y)) then
begin
PageControlCloseButton.Pages[PageControlCloseButton.ActivePageIndex].TabVisible := false;
PageControlCloseButton.ActivePageIndex := 0;
FCloseButtonMouseDownIndex := -1;
PageControlCloseButton.Repaint;
end;
end;
end;
end.
推荐答案
在 github 上有一个开源组件,可在此链接上扩展基础 FMX TTabControl https://github.com/jkour/neTabControl 在这里你可以了解如何自己做.
On github there is an open source component that extend the base FMX TTabControl at this link https://github.com/jkour/neTabControl where you can understand how to do it by your self.
这篇关于如何在 Delphi XE3 FireMonkey 2 的 TTabControl 的每个选项卡上实现关闭按钮?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!