unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls,
LCLIntf, LCLType, StdCtrls;
type
{$IFDEF WINDOWS}
{ TPageControl }
TPageControl = class(ComCtrls.TPageControl)
private
const btnSize = 10;
protected
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); override;
procedure PaintWindow(DC: HDC); override;
end;
{$ENDIF}
{ TForm1 }
TForm1 = class(TForm)
ImageList1: TImageList;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
procedure PageControl1Change(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.PageControl1Change(Sender: TObject);
var
TabSheet: TTabSheet;
ID_addtab: integer;
begin
if trim(PageControl1.ActivePage.Caption)='+' then
begin
ID_addtab:=PageControl1.PageIndex; // guardamos el ID de la pestaña +
// creamos una nueva pestaña
TabSheet := TTabSheet.Create(PageControl1);
TabSheet.Caption := 'New Tab Sheet ';
TabSheet.PageControl := PageControl1;
PageControl1.TabIndex:=PageControl1.PageCount-1; // abrir pestaña ultima
pagecontrol1.Pages[ID_addtab].PageIndex := PageControl1.PageCount-1; // movemos la pestaña + hacia el final, pero abierto la ultima pestaña creada
end;
end;
{$IFDEF WINDOWS}
procedure TPageControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var R : TRect;
begin
inherited MouseDown(Button, Shift, X, Y);
if Button = mbLeft then
begin
if ActivePageIndex<>PageCount-1 then // aqui evitar cerrar la ultima pestaña
begin
R := TabRect(ActivePageIndex);
if PtInRect(Classes.Rect(R.Right - btnSize - 4, R.Top + 2,
R.Right - 4, R.Top + btnSize + 2),
Classes.Point(X, Y))
then
begin
if PageCount=2 then // si solo hay dos pestañas entoces cerrar form sino cerrar pestaña
begin
Form1.Close;
end
else
begin
if PageIndex=PageCount-2 then // si estas en la penultima pestaña cerrar y foco a la nueva penultima pestaña
begin
ActivePage.Free;
Repaint; // yo lo agregue para que repinte sino pone la x en +
PageIndex:=PageCount-2;
end
else // de otra manera cerrar normal
begin
ActivePage.Free;
Repaint; // yo lo agregue para que repinte sino pone la x en +
end;
end;
end;
end;
end;
end;
procedure TPageControl.PaintWindow(DC: HDC);
var
i : integer;
R : TRect;
bm : TBitmap;
begin
inherited PaintWindow(DC);
bm := TBitmap.Create;
try
bm.SetSize(16, 16);
Images.GetBitmap(0, bm);
//for i := 0 to Pred(PageCount) do // original
for i := 0 to Pred(PageCount-1) do // pintar todo menos la ultima pestaña
begin
R := TabRect(i);
// Код привязан к размеру ImageList-а = 16
StretchBlt(DC, R.Right - btnSize - 4, R.Top + 2,
btnSize, btnSize, bm.Canvas.Handle, 0, 0, 16, 16, cmSrcCopy);
end;
finally
bm.Free;
end;
end;
{$ENDIF}
end.