varias paginas con PageControl
 

Hola a Todos

Agradezco enormemente a las personas que siempre colaboran en evacuar mis dudas al utilizar componentes para lograr comportamientos deseados.

Este es comportamiento es algo que me gustaría modificar en mi aplicación.

Por ejemplo todos han visto el comportamiento parecido los exploradores actuales de internet puedes ver diferentes paginas. bueno algo parecido deseo.

Ya tengo formularios creados de mi proyecto solo que estoy haciendo lo siguiente:

Código Delphi [-]
procedure TfrPriincipal.acrearExecute(Sender: TObject);

var
Page : TTabSheet;

begin
 FrmCliente := TfrmCliente.Create(FrmCliente);
  Try
    FrmCliente.Parent := frPriincipal.PageControl1;
    FrmCliente.Caption := 'Clientes';
    FrmCliente.show;
  Finally
   If frPriincipal.PageControl1.ActivePage.Caption = ' ' then
    Begin
      Page := TTabSheet.Create(PageControl1);
      Page.PageControl := PageControl1;
      Page.Caption := 'Cliente';
      Page.Free;
    end;
  end;

end;

los componente que necesito ya están en el formulario y el PageControl será como el padre de mi formulario principal (Si me equivoco de esta forma de trabajar corrijan a este novato). ahora lo que deseo es que cuando llamo al formulario aparezca un Tabsheet con el caption del formulario y en el se pueda cerrar y liberar el formulario.

Saludos


novato_erick

Bueno yo mismo respondiendo.

Viendo un poco logre presentara el caption en el tabSheet de esta manera:

Código Delphi [-]
procedure TfrPriincipal.acrearExecute(Sender: TObject);

var
Page : TTabSheet;

begin
 FrmCliente := TfrmCliente.Create(FrmCliente);
  Try
    FrmCliente.Parent := frPriincipal.PageControl1;
    Page := TTabSheet.Create(PageControl1);
    Page.PageControl := PageControl1;
    Page.Caption :='Cliente';
    FrmCliente.show;
  Finally
   // En esta parte no se que pondría...
    end;
  end;

end;

lo único malo es que no encuentro ahora una propiedad para cerrar ese formulario el tabSheet...

alguien con alguna idea?


Saludos

novato_erick

Saludos.

Echale un vistazo a este tema a ver si es lo que buscas.

con el link proporcionado por beginner01 la cual le doy las gracias y si era lo que deseaba no he logrado la manera en que cada formulario que yo desee aparezca independientemente en un tapSheet.

Este es el codigo el cual permite poner un boton en el componente PageControl cabe destacar el PageControlCloseButton es el nombre que se le dio al componente lo demas son eventos creados.

Código Delphi [-]
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;
      frmCliente.Close;
    end;
  end;
end;

el asunto es que yo creo un formulario utilizando el pagecontrol como parent de mi formulario sin embargo si llamo a otro formulario se pone en cima del anterior. y al final si cambio de pestaña se borran. pongo mi ejemplo para que alguien me de una posible solución a como manejar este comportamiento indeseado


Saludos

novato_erick

nota: adjunto archivo.

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.

solucionado los comportamiento en las pestañas con pagecontrol
 

Agradezco enormemente a beginner01 por la ayuda que me brindo, puedo decir que siempre los programadores del clubDelphi me han brindado grandes aportes, y para retribuir esto envio ya el pequeño proyecto para que otros programadores que deseen implementar el comportamiento de navegadores en sus proyectoel link esta abajo para descargar el codigo.


Saludos a todos


novato_erick

Gracias por compartirlo.