varias paginas con PageControl

[novato_erick]

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:


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

[novato_erick]

Bueno yo mismo respondiendo.

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


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

[beginner01]

Saludos.

Echale un vistazo a este (http://stackoverflow.com/questions/2201850/how-to-implement-a-close-button-for-a-ttabsheet-of-a-tpagecontrol) tema a ver si es lo que buscas.

[novato_erick]

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.


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.

[beginner01]

Saludos.

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

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.

[novato_erick]

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

[Casimiro Notevi]

http://www.clubdelphi.com/foros/images/icons/icon14.gif
Gracias por compartirlo.