unit pagecontrol;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, ActnList, PlatformDefaultStyleActnCtrls, ActnMan, Ribbon,
RibbonLunaStyleActnCtrls, ComCtrls, ToolWin, ActnCtrls, UxTheme, Themes, Math,
StdCtrls, Buttons, ExtCtrls;
type
TfrPrincipal = class(TForm)
mPrueba: TActionManager;
acrear: TAction;
ImageList1: TImageList;
PageControlCloseButton: TPageControl;
bVendedor: TAction;
btnClientes: TButton;
btnVendedores: TButton;
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
procedure PageControlCloseButtonDrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
procedure PageControlCloseButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure PageControlCloseButtonMouseLeave(Sender: TObject);
procedure PageControlCloseButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure acrearExecute(Sender: TObject);
procedure PageControlCloseButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure bVendedorExecute(Sender: TObject);
function pestana(Form: TForm ; Caption:string): TTabSheet;
procedure CerrarPestana;
function FormActivo: TForm;
private
FCloseButtonsRect: array of TRect;
FCloseButtonMouseDownIndex: Integer;
FCloseButtonShowPushed: Boolean;
public
end;
var
frPrincipal: TfrPrincipal;
NewTab : TTabSheet;
implementation
uses Clientes, Vendedores;
{$R *.dfm}
function TfrPrincipal.pestana(Form: TForm;Caption:string): TTabSheet;
var
I: Integer;
begin
NewTab := TTabSheet.Create(PageControlCloseButton);
with NewTab do
begin
PageControl := PageControlCloseButton;
Parent := PageControlCloseButton;
PageIndex := PageControlCloseButton.ActivePageIndex;
end;
Form.Parent := NewTab;
with Form do
begin
Align := alClient;
NewTab.Caption := Caption;
Show;
end;
PageControlCloseButton.ActivePage := NewTab;
PageControlCloseButton.TabWidth := 120;
Result := NewTab;
SetLength(FCloseButtonsRect, PageControlCloseButton.PageCount);
PageControlCloseButton.Repaint;
for I := 0 to Length(FCloseButtonsRect) - 1 do
FCloseButtonsRect[i] := Rect(0, 0, 0, 0);
end;
procedure TfrPrincipal.CerrarPestana;
begin
if FormActivo <> nil then
begin
FormActivo.Close;
PageControlCloseButton.Pages[PageControlCloseButton.TabIndex].Free;
end;
end;
function TfrPrincipal.FormActivo: TForm;
var
i: Integer;
begin
Result := nil;
if PageControlCloseButton.ActivePage <> nil then
Result := TForm(PageControlCloseButton.ActivePage.Controls[0]);
end;
procedure TfrPrincipal.acrearExecute(Sender: TObject);
begin
if FrmCliente = nil then
begin
FrmCliente := TfrmCliente.Create(Self);
pestana(FrmCliente,'Cliente');
end;
end;
procedure TfrPrincipal.bVendedorExecute(Sender: TObject);
begin
if frmVendedores = nil then
begin
frmVendedores := Tfrmvendedores.Create(Self);
pestana(frmVendedores, 'Vendedores');
end;
end;
procedure TfrPrincipal.FormCreate(Sender: TObject);
begin
end;
procedure TfrPrincipal.PageControlCloseButtonDrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
CloseBtnSize: Integer;
pagecontrol: TPageControl;
TabCaption: TPoint;
CloseBtnRect: TRect;
CloseBtnDrawState: Cardinal;
CloseBtnDrawDetails: TThemedElementDetails;
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;
Windows.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 TfrPrincipal.PageControlCloseButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
I: Integer;
pagecontrol: TPageControl;
begin
pagecontrol := Sender as TPageControl;
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;
pagecontrol.Repaint;
end;
end;
end;
end;
procedure TfrPrincipal.PageControlCloseButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
pagecontrol: TPageControl;
Inside: Boolean;
begin
pagecontrol := Sender as TPageControl;
if (ssLeft in Shift) and (FCloseButtonMouseDownIndex >= 0) then
begin
Inside := PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex],
Point(X, Y));
if FCloseButtonShowPushed <> Inside then
begin
FCloseButtonShowPushed := Inside;
pagecontrol.Repaint;
end;
end;
end;
procedure TfrPrincipal.PageControlCloseButtonMouseLeave(Sender: TObject);
var
pagecontrol: TPageControl;
begin
pagecontrol := Sender as TPageControl;
FCloseButtonShowPushed := False;
pagecontrol.Repaint;
end;
procedure TfrPrincipal.PageControlCloseButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
pagecontrol: TPageControl;
begin
pagecontrol := Sender as TPageControl;
if (Button = mbLeft) and (FCloseButtonMouseDownIndex >= 0) then
begin
if PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y)) then
begin
FCloseButtonMouseDownIndex := -1;
pagecontrol.Repaint;
CerrarPestana
end;
end;
end;
end.