Ver Mensaje Individual
  #5  
Antiguo 06-11-2011
beginner01 beginner01 is offline
Miembro
NULL
 
Registrado: mar 2011
Ubicación: República Dominicana
Posts: 181
Reputación: 14
beginner01 Va por buen camino
Saludos.

Le hice unos cambios al códogo reemplaza el que tienes por este y prueba a ver que tal.

Código Delphi [-]
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);
    //función para crear las pestañas
    function pestana(Form: TForm ; Caption:string): TTabSheet;
 
    procedure CerrarPestana;
    
    function FormActivo: TForm;

  private
    { Private declarations }
    FCloseButtonsRect: array of TRect;
    FCloseButtonMouseDownIndex: Integer;
    FCloseButtonShowPushed: Boolean;
  public
    { Public declarations }

  end;

var
  frPrincipal: TfrPrincipal;
  NewTab : TTabSheet;
implementation

uses Clientes, Vendedores;

{$R *.dfm}

//Implementación crear pestañas
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;

  //el parent sera la nueva pestaña
   Form.Parent := NewTab;

  with Form do
  begin
    Align := alClient;
    //asignar caption al tabsheet creado
    NewTab.Caption := Caption;

    Show;

  end;

  PageControlCloseButton.ActivePage := NewTab;

  PageControlCloseButton.TabWidth := 120;

  Result := NewTab;

  SetLength(FCloseButtonsRect, PageControlCloseButton.PageCount);

  PageControlCloseButton.Repaint;
  //  CheckPageCount;
  //should be done on every change of the page count
  for I := 0 to Length(FCloseButtonsRect) - 1 do
    FCloseButtonsRect[i] := Rect(0, 0, 0, 0);

end;


//Papa cerrar las pestañas
procedure TfrPrincipal.CerrarPestana;
begin
   if FormActivo <> nil then
   begin
      FormActivo.Close;
      PageControlCloseButton.Pages[PageControlCloseButton.TabIndex].Free;
      //PageControlCloseButton.Repaint;
   end;
end;


{
esta funcion te permite saber siempre cual es el formulario activo para poder manejarlo
ya sea cambiarle propiedades o liberarlo en cualquier momentro

}
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);
{
var
  Page: TTabSheet;
  I :Integer;
 }
begin

 if  FrmCliente = nil then
 begin

    FrmCliente := TfrmCliente.Create(Self);

    pestana(FrmCliente,'Cliente');
 end;
  {
  Try

    FrmCliente.Parent := frPrincipal.PageControlCloseButton;
    Page := TTabSheet.Create(PageControlCloseButton);
    Page.PageControl := PageControlCloseButton;

    //Page.Caption :='Cliente';
    //PageControlCloseButton.TabWidth := 120;
    //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;
  Finally
     FrmCliente.show;
    // En esta parte no se que pondría...
  end;
    }
end;

procedure TfrPrincipal.bVendedorExecute(Sender: TObject);
{
var
Page : TTabSheet;
I: Integer;
}
begin
  
 if  frmVendedores = nil then
 begin

   frmVendedores := Tfrmvendedores.Create(Self);
  
   pestana(frmVendedores, 'Vendedores');
 end;
 {
  Try

    frmVendedores.Parent  := frPrincipal.PageControlCloseButton;
    Page := TTabSheet.Create(PageControlCloseButton);
    Page.PageControl := PageControlCloseButton;
    Page.Caption :='Vendedores';
    PageControlCloseButton.TabWidth := 120;
    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;
  Finally
    frmVendedores.Show;

  end;
    }
end;


procedure TfrPrincipal.FormCreate(Sender: TObject);
//var
  //I: Integer;
begin

//  PageControlCloseButton.TabWidth := 120;
//  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 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
    //  ShowMessage('Boton ' + IntToStr(FCloseButtonMouseDownIndex + 1) +
     //   ' Precionado!');
     // PageControlCloseButton.ActivePage.Free;
      FCloseButtonMouseDownIndex := -1;
      pagecontrol.Repaint;
      {
      aqui la función cerrar pestaña
      }
      CerrarPestana
    end;
  end;
end;

end.
Responder Con Cita