问题
I am trying to create a browser-style TabControl with a small close button on every tab in FireMonkey 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.
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 :)
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.
来源:https://stackoverflow.com/questions/14580733/how-to-implement-a-close-button-on-every-tab-of-ttabcontrol-in-delphi-xe3-firemo