我正在尝试创建一个浏览器样式的 TabControl,在 FireMonkey FM2 的每个选项卡上都有一个小的关闭按钮。
由于 FM2 中没有 TTabsheet 和 TPageControl 组件,我无法使用“如何为 TPageControl 的 TTabsheet 实现关闭按钮”中的答案。我猜,这段代码提供了太多未声明的函数和变量,这些函数和变量在 FM2 中不再支持。
我不想使用任何第三方组件,因为你永远不知道它们是否会支持下一个版本的 Delphi :)
我可以提供在 Delphi XE3 VCL(但不是 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.