Tela Principal do Sistema/Menu

Delphi

24/08/2012

Olá
Estou tentando fazer com que meus formularios ao chamalos eles fiquem na tela, porem enfileirados com um "X" na parte de cima possibilitando meus usuarios fechar os mesmos..

Veja o exemplo [url]http://www.kleberalmeida.com.br/images/imagem.jpg[/url]
Kleber Silva

Kleber Silva

Curtidas 0

Respostas

William

William

24/08/2012

Baseado no exemplo poderia usar um TPageControl, só faltaria aquele "X" que vc precisa ..
GOSTEI 0
Rachel Andrade

Rachel Andrade

24/08/2012

Rapaz, você pode fazer a velha e boa "adaptação tecnológica", ou "gambiarra". Primeiramente você vai precisar usar o TPageControl, como foi sugerido acima, e abrir cada form em uma aba. Para o botão de fechar, eu vejo duas possibilidades:
1) Botar um botão de fechar em cada form (pode usar herança pra isso), tratando o layout conforme sua necessidade e preferência.
2) Botar um botão de fechar GERAL, fora do TPageControl, que feche a aba atualmente selecionada.

Agora, existem componentes de terceiros que podem ajudar. Acho que o grid da DevExpress é um deles.

Boa sorte.
GOSTEI 0
Joel Rodrigues

Joel Rodrigues

24/08/2012

Rapaz, você pode fazer a velha e boa "adaptação tecnológica", ou "gambiarra". Primeiramente você vai precisar usar o TPageControl, como foi sugerido acima, e abrir cada form em uma aba. Para o botão de fechar, eu vejo duas possibilidades:
1) Botar um botão de fechar em cada form (pode usar herança pra isso), tratando o layout conforme sua necessidade e preferência.
2) Botar um botão de fechar GERAL, fora do TPageControl, que feche a aba atualmente selecionada.

Agora, existem componentes de terceiros que podem ajudar. Acho que o grid da DevExpress é um deles.

Boa sorte.
GOSTEI 0
Jacques Silva

Jacques Silva

24/08/2012

Boa tarde,

Para fazer de acordo com a imagem que vc postou, vc ira precisar instalar os componentes JVCL.
Para conseguir aquele resultado vc ira usar os seguintes componentes.

JvPageList, JvTabBar, JvStatusBar.

Se vc quiser posto aqui as funções necessárias para o funcionamento destes componente, para ficarem de acordo com a imagem.
GOSTEI 0
Kleber Silva

Kleber Silva

24/08/2012

Boa tarde,

Para fazer de acordo com a imagem que vc postou, vc ira precisar instalar os componentes JVCL.
Para conseguir aquele resultado vc ira usar os seguintes componentes.

JvPageList, JvTabBar, JvStatusBar.

Se vc quiser posto aqui as funções necessárias para o funcionamento destes componente, para ficarem de acordo com a imagem.


Amado irmao,

blz, ja tenho esses componentes...

Se vc puder, posta ae como é que faz...Concertea vai ajudar muita gente com essa duvida..

Obrigado, desde ja´..
GOSTEI 0
Jacques Silva

Jacques Silva

24/08/2012

Boa tarde,
Vou postar o arquivo inteiro.

unit UMenu;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ComCtrls, StdCtrls, ExtCtrls, ImgList, XPMan,
JvExControls, JvComponent, JvPageList, JvTabBar, RibbonLunaStyleActnCtrls,
Ribbon, ToolWin, ActnMan, ActnCtrls, ActnList, RibbonSilverStyleActnCtrls,
JvExComCtrls, JvStatusBar, ActnMenus, RibbonActnMenus, JvOutlookBar, JvLookOut,
ScreenTips, ACBrBase, ACBrEnterTab;

type
TFMenu = class(TForm)
Image16: TImageList;
PopupMenu: TPopupMenu;
menuFechar: TMenuItem;
menuFecharTodasExcetoEssa: TMenuItem;
menuSepararAba: TMenuItem;
N2: TMenuItem;
JvTabBar: TJvTabBar;
JvModernTabBarPainter: TJvModernTabBarPainter;
JvPageList: TJvPageList;
Ribbon: TRibbon;
RibbonPageCadastros: TRibbonPage;
RibbonGrupoGeral: TRibbonGroup;
ActionManager: TActionManager;
JvStatusBar1: TJvStatusBar;
RibbonGrupoDiversos: TRibbonGroup;
Image48: TImageList;
ActionCliente: TAction;
ActionFornecedor: TAction;
ActionTransportadora: TAction;
ActionColaborador: TAction;
Image32: TImageList;
RibbonApplicationMenuBar1: TRibbonApplicationMenuBar;
ActionAtividade: TAction;
ActionSituacao: TAction;
ActionCargo: TAction;
ActionTipoColaborador: TAction;
ActionNivelFormacaoColaborador: TAction;
ActionProduto: TAction;
ActionMarca: TAction;
ActionNCM: TAction;
ActionUnidade: TAction;
ActionPais: TAction;
ActionUF: TAction;
ActionMunicipio: TAction;
ActionBairro: TAction;
ActionCEP: TAction;
ActionBanco: TAction;
ActionAgencia: TAction;
ActionConta: TAction;
ActionTalonario: TAction;
ActionCheque: TAction;
ActionConvenio: TAction;
ActionContador: TAction;
ActionAlmoxarifado: TAction;
ActionSetor: TAction;
ActionOperadoraCartao: TAction;
ActionCFOP: TAction;
ActionIndiceEconomico: TAction;
ActionEstadoCivil: TAction;
ScreenTipsManager1: TScreenTipsManager;
ActionEnderecos: TAction;
ActionSair: TAction;
ACBrEnterTab1: TACBrEnterTab;
RibbonPage1: TRibbonPage;
RibbonGroup1: TRibbonGroup;
ActionTipoDocumento: TAction;
ActionDocumentoGed: TAction;
RibbonPage2: TRibbonPage;
RibbonGroup2: TRibbonGroup;
RibbonGroup3: TRibbonGroup;
ActionCentroResultado: TAction;
ActionNaturezaFinanceira: TAction;
ActionDocumentoOrigem: TAction;
ActionStatusParcelaPagar: TAction;
ActionTipoPagamento: TAction;
ActionLancamentoPagar: TAction;
ActionPagamento: TAction;
RibbonGroup4: TRibbonGroup;
ActionStatusParcelaReceber: TAction;
ActionTipoRecebimento: TAction;
ActionLancamentoReceber: TAction;
ActionRecebimento: TAction;
RibbonGroup5: TRibbonGroup;
ActionMovimentoCaixaBanco: TAction;
procedure PageControlDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
procedure PageControlChange(Sender: TObject);
procedure menuFecharClick(Sender: TObject);
procedure menuFecharTodasExcetoEssaClick(Sender: TObject);
procedure menuSepararAbaClick(Sender: TObject);
procedure JvPageListChange(Sender: TObject);
procedure JvTabBarTabClosing(Sender: TObject; Item: TJvTabBarItem; var AllowClose: Boolean);
procedure ActionClienteExecute(Sender: TObject);
procedure ActionFornecedorExecute(Sender: TObject);
procedure ActionTransportadoraExecute(Sender: TObject);
procedure ActionColaboradorExecute(Sender: TObject);
procedure ActionAtividadeExecute(Sender: TObject);
procedure ActionSituacaoExecute(Sender: TObject);
procedure ActionCargoExecute(Sender: TObject);
procedure ActionTipoColaboradorExecute(Sender: TObject);
procedure ActionNivelFormacaoColaboradorExecute(Sender: TObject);
procedure ActionProdutoExecute(Sender: TObject);
procedure ActionMarcaExecute(Sender: TObject);
procedure ActionNCMExecute(Sender: TObject);
procedure ActionUnidadeExecute(Sender: TObject);
procedure ActionPaisExecute(Sender: TObject);
procedure ActionUFExecute(Sender: TObject);
procedure ActionMunicipioExecute(Sender: TObject);
procedure ActionBairroExecute(Sender: TObject);
procedure ActionCEPExecute(Sender: TObject);
procedure ActionBancoExecute(Sender: TObject);
procedure ActionAgenciaExecute(Sender: TObject);
procedure ActionContaExecute(Sender: TObject);
procedure ActionTalonarioExecute(Sender: TObject);
procedure ActionChequeExecute(Sender: TObject);
procedure ActionConvenioExecute(Sender: TObject);
procedure ActionContadorExecute(Sender: TObject);
procedure ActionAlmoxarifadoExecute(Sender: TObject);
procedure ActionSetorExecute(Sender: TObject);
procedure ActionOperadoraCartaoExecute(Sender: TObject);
procedure ActionCFOPExecute(Sender: TObject);
procedure ActionIndiceEconomicoExecute(Sender: TObject);
procedure ActionEstadoCivilExecute(Sender: TObject);
procedure ActionEnderecosExecute(Sender: TObject);
procedure ActionSairExecute(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ActionTipoDocumentoExecute(Sender: TObject);
procedure ActionDocumentoGedExecute(Sender: TObject);
procedure ActionCentroResultadoExecute(Sender: TObject);
procedure ActionNaturezaFinanceiraExecute(Sender: TObject);
procedure ActionDocumentoOrigemExecute(Sender: TObject);
procedure ActionStatusParcelaPagarExecute(Sender: TObject);
procedure ActionTipoPagamentoExecute(Sender: TObject);
procedure ActionLancamentoPagarExecute(Sender: TObject);
procedure ActionPagamentoExecute(Sender: TObject);
procedure ActionStatusParcelaReceberExecute(Sender: TObject);
procedure ActionLancamentoReceberExecute(Sender: TObject);
procedure ActionRecebimentoExecute(Sender: TObject);
procedure ActionTipoRecebimentoExecute(Sender: TObject);
procedure ActionMovimentoCaixaBancoExecute(Sender: TObject);
private

function PodeAbrirFormulario(ClasseForm: TFormClass; var Pagina: TJvCustomPage): Boolean;
function TotalFormsAbertos(ClasseForm: TFormClass): Integer;
procedure AjustarCaptionAbas(ClasseForm: TFormClass);
function ObterAba(Pagina: TJvCustomPage): TJvTabBarItem;
function ObterPagina(Aba: TJvTabBarItem): TJvCustomPage;

public
procedure NovaPagina(ClasseForm: TFormClass; IndiceImagem: Integer);
function FecharPagina(Pagina: TJvCustomPage): Boolean; overload;
function FecharPagina(Pagina: TJvCustomPage; TodasExcetoEssa: Boolean): Boolean; overload;
procedure SepararAba(Pagina: TJvCustomPage);

end;

var
FMenu: TFMenu;
FormAtivo: String;

implementation

uses UImportaContaCaixa;

{$R *.dfm}

{ TFMenu }

{$Region: 'Infra'}
procedure TFMenu.NovaPagina(ClasseForm: TFormClass; IndiceImagem: Integer);
var
Aba : TJvTabBarItem;
Pagina : TJvCustomPage;
Form : TForm;
begin

//verifica se pode abrir o form
if not PodeAbrirFormulario(ClasseForm, Pagina) then
begin
JvPageList.ActivePage := Pagina;
Exit;
end;

//cria uma nova aba
Aba := JvTabBar.AddTab('');

//instancia uma página padrão
Pagina := TJvStandardPage.Create(Self);

//seta a PageList da nova página para aquela que já está no form principal
Pagina.PageList := JvPageList;

//cria um form passando a página para o seu construtor, que recebe um TComponent
Form := ClasseForm.Create(Pagina);

//Propriedades do Form
with Form do
begin
Align := alClient;
BorderStyle := bsNone;
Parent := Pagina;
end;

//Propriedades da Aba
with Aba do
begin
Caption := Form.Caption;
ImageIndex := IndiceImagem;
PopupMenu := Self.PopupMenu;
end;

//ajusta o título (caption) das abas
AjustarCaptionAbas(ClasseForm);

//ativa a página
JvPageList.ActivePage := Pagina;

FormAtivo := Form.Name;

//exibe o formulário
Form.Show;
end;

function TFMenu.PodeAbrirFormulario(ClasseForm: TFormClass; var Pagina: TJvCustomPage): Boolean;
var
I: Integer;
begin
Result := True;
//varre a JvPageList para saber se já existe um Form aberto
for I := 0 to JvPageList.PageCount - 1 do
//se achou um form
if JvPageList.Pages[I].Components[0].ClassType = ClasseForm then
begin
Pagina := JvPageList.Pages[I];
//permite abrir o form novamente caso a Tag tenha o valor zero
Result := (Pagina.Components[0] as TForm).Tag = 0;
Break;
end;
end;

//verifica o total de formulários abertos
function TFMenu.TotalFormsAbertos(ClasseForm: TFormClass): Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to JvPageList.PageCount - 1 do
begin
if JvPageList.Pages[I].Components[0].ClassType = ClasseForm then
Inc(Result);
end;
end;

//ajusta o título (caption) das abas
procedure TFMenu.AjustarCaptionAbas(ClasseForm: TFormClass);
var
I, Indice, TotalForms: Integer;
NovoCaption: string;
begin
TotalForms := TotalFormsAbertos(ClasseForm);

if TotalForms > 1 then
begin
Indice := 1;
for I := 0 to JvPageList.PageCount - 1 do
begin
with JvPageList do
begin
if Pages[I].Components[0].ClassType = ClasseForm then
begin
NovoCaption := (Pages[I].Components[0] as TForm).Caption + ' (' + IntToStr(Indice) + ')';
(Pages[I] as TJvStandardPage).Caption := NovoCaption;
ObterAba(Pages[I]).Caption := NovoCaption;
Inc(Indice);
end;
end;
end;
end;
end;

//desenha a aba
procedure TFMenu.PageControlDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
CaptionAba, CaptionForm, CaptionContador: string;
I: Integer;
begin
with JvPageList do
begin
// Separa o caption da aba e o contador de forms
CaptionAba := (Pages[TabIndex] as TJvStandardPage).Caption;

CaptionForm := Trim(Copy(CaptionAba, 1, Pos('(', CaptionAba))) + ' ';

CaptionContador := Copy(CaptionAba, Pos('(', CaptionAba), Length(CaptionAba));
CaptionContador := Copy(CaptionContador, 1, Pos(')', CaptionContador));

Canvas.FillRect(Rect);

Canvas.TextOut(Rect.Left + 3, Rect.Top + 3, CaptionForm);
I := Canvas.TextWidth(CaptionForm);

Canvas.Font.Style := [fsBold];
Canvas.TextOut(Rect.Left + 3 + I, Rect.Top + 3, CaptionContador);
end;
end;

procedure TFMenu.PageControlChange(Sender: TObject);
begin
Caption := JvTabBar.SelectedTab.Caption;
Application.Title := Caption;

with (JvPageList.ActivePage.Components[0] as TForm) do
begin
if not Assigned(Parent) then
Show;
end;
end;

//controla o fechamento da página
function TFMenu.FecharPagina(Pagina: TJvCustomPage): Boolean;
var
Form: TForm;
PaginaEsquerda: TJvCustomPage;
begin
PaginaEsquerda := nil;
Form := Pagina.Components[0] as TForm;

Result := Form.CloseQuery;

if Result then
begin
if Pagina.PageIndex > 0 then
begin
PaginaEsquerda := JvPageList.Pages[Pagina.PageIndex - 1];
end;

Form.Close;
ObterAba(Pagina).Free;
Pagina.Free;

JvPageList.ActivePage := PaginaEsquerda;
end;
end;

//controla o fechamento da página - todas exceto a selecionada
function TFMenu.FecharPagina(Pagina: TJvCustomPage; TodasExcetoEssa: Boolean): Boolean;
var
I: Integer;
begin
Result := True;
for I := JvPageList.PageCount - 1 downto 0 do
if JvPageList.Pages[I] <> Pagina then
begin
Result := FecharPagina(JvPageList.Pages[I]);
if not Result then
Exit;
end;
end;

procedure TFMenu.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Application.MessageBox('Deseja Realmente Sair?', 'Sair do Sistema', MB_YesNo + MB_IconQuestion) <> IdYes then
Application.Run;
end;

//separa a aba (formulário)
procedure TFMenu.SepararAba(Pagina: TJvCustomPage);
begin
with Pagina.Components[0] as TForm do
begin
Align := alNone;
BorderStyle := bsSizeable;
Parent := nil;
end;
ObterAba(Pagina).Visible := False;
end;

function TFMenu.ObterAba(Pagina: TJvCustomPage): TJvTabBarItem;
var
Form: TForm;
begin
Result := nil;

Form := Pagina.Components[0] as TForm;

FormAtivo := Form.Name;

if Assigned(Pagina) then
Result := JvTabBar.Tabs[Pagina.PageIndex];
end;

procedure TFMenu.JvPageListChange(Sender: TObject);
begin
ObterAba(JvPageList.ActivePage).Selected := True;
end;

procedure TFMenu.JvTabBarTabClosing(Sender: TObject; Item: TJvTabBarItem;
var AllowClose: Boolean);
begin
AllowClose := FecharPagina(ObterPagina(Item));
end;

function TFMenu.ObterPagina(Aba: TJvTabBarItem): TJvCustomPage;
begin
Result := JvPageList.Pages[Aba.Index];
end;
{$EndRegion}

{$Region: 'Actions'}
procedure TFMenu.ActionClienteExecute(Sender: TObject);
begin
//NovaPagina(TFCliente, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionFornecedorExecute(Sender: TObject);
begin
//NovaPagina(TFFornecedor, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionProdutoExecute(Sender: TObject);
begin
//NovaPagina(TFProduto, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionRecebimentoExecute(Sender: TObject);
begin
// NovaPagina(TFParcelaRecebimento, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionAgenciaExecute(Sender: TObject);
begin
ShowMessage('agencia');
end;

procedure TFMenu.ActionAlmoxarifadoExecute(Sender: TObject);
begin
ShowMessage('almoxarifado');
end;

procedure TFMenu.ActionAtividadeExecute(Sender: TObject);
begin
ShowMessage('atividade');
end;

procedure TFMenu.ActionBairroExecute(Sender: TObject);
begin
ShowMessage('bairro');
end;

procedure TFMenu.ActionBancoExecute(Sender: TObject);
begin
// NovaPagina(TFBanco, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionCargoExecute(Sender: TObject);
begin
ShowMessage('cargo');
end;

procedure TFMenu.ActionCentroResultadoExecute(Sender: TObject);
begin
ShowMessage('cadastro do centro de resultado');
end;

procedure TFMenu.ActionCEPExecute(Sender: TObject);
begin
ShowMessage('cep');
end;

procedure TFMenu.ActionCFOPExecute(Sender: TObject);
begin
ShowMessage('CFOP');
end;

procedure TFMenu.ActionChequeExecute(Sender: TObject);
begin
ShowMessage('cheque');
end;

procedure TFMenu.ActionColaboradorExecute(Sender: TObject);
begin
ShowMessage('colaborador');
end;

procedure TFMenu.ActionContadorExecute(Sender: TObject);
begin
ShowMessage('contador');
end;

procedure TFMenu.ActionContaExecute(Sender: TObject);
begin
ShowMessage('conta');
end;

procedure TFMenu.ActionConvenioExecute(Sender: TObject);
begin
ShowMessage('convenio');
end;

procedure TFMenu.ActionDocumentoGedExecute(Sender: TObject);
begin
// NovaPagina(TFDocumento, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionDocumentoOrigemExecute(Sender: TObject);
begin
// NovaPagina(TFDocumentoOrigem, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionEnderecosExecute(Sender: TObject);
begin
//
end;

procedure TFMenu.ActionEstadoCivilExecute(Sender: TObject);
begin
ShowMessage('estado civil');
end;

procedure TFMenu.ActionIndiceEconomicoExecute(Sender: TObject);
begin
ShowMessage('indice economico');
end;

procedure TFMenu.ActionLancamentoPagarExecute(Sender: TObject);
begin
// NovaPagina(TFLancamentoPagar, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionLancamentoReceberExecute(Sender: TObject);
begin
// NovaPagina(TFLancamentoReceber, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionMarcaExecute(Sender: TObject);
begin
ShowMessage('marca');
end;

procedure TFMenu.ActionMovimentoCaixaBancoExecute(Sender: TObject);
begin
Application.CreateForm(TFImportaContaCaixa, FImportaContaCaixa);
FImportaContaCaixa.ShowModal;
end;

procedure TFMenu.ActionMunicipioExecute(Sender: TObject);
begin
ShowMessage('municipio');
end;

procedure TFMenu.ActionNaturezaFinanceiraExecute(Sender: TObject);
begin
ShowMessage('cadastro da natureza financeira');
end;

procedure TFMenu.ActionNCMExecute(Sender: TObject);
begin
ShowMessage('ncm');
end;

procedure TFMenu.ActionNivelFormacaoColaboradorExecute(Sender: TObject);
begin
ShowMessage('nivel de formação do colaborador');
end;

procedure TFMenu.ActionOperadoraCartaoExecute(Sender: TObject);
begin
ShowMessage('operadora cartao');
end;

procedure TFMenu.ActionPagamentoExecute(Sender: TObject);
begin
// NovaPagina(TFParcelaPagamento, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionPaisExecute(Sender: TObject);
begin
// NovaPagina(TFPais, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionSairExecute(Sender: TObject);
begin
Close;
end;

procedure TFMenu.ActionSetorExecute(Sender: TObject);
begin
ShowMessage('setor');
end;

procedure TFMenu.ActionSituacaoExecute(Sender: TObject);
begin
ShowMessage('situação');
end;

procedure TFMenu.ActionStatusParcelaPagarExecute(Sender: TObject);
begin
// NovaPagina(TFStatusParcelaPagar, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionStatusParcelaReceberExecute(Sender: TObject);
begin
// NovaPagina(TFStatusParcelaReceber, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionTalonarioExecute(Sender: TObject);
begin
ShowMessage('talonario');
end;

procedure TFMenu.ActionTipoColaboradorExecute(Sender: TObject);
begin
ShowMessage('tipo de colaborador');
end;

procedure TFMenu.ActionTipoDocumentoExecute(Sender: TObject);
begin
// NovaPagina(TFTipoDocumento, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionTipoPagamentoExecute(Sender: TObject);
begin
// NovaPagina(TFTipoPagamento, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionTipoRecebimentoExecute(Sender: TObject);
begin
// NovaPagina(TFTipoRecebimento, (Sender as TAction).ImageIndex);
end;

procedure TFMenu.ActionTransportadoraExecute(Sender: TObject);
begin
ShowMessage('transportadora');
end;

procedure TFMenu.ActionUFExecute(Sender: TObject);
begin
ShowMessage('uf');
end;

procedure TFMenu.ActionUnidadeExecute(Sender: TObject);
begin
ShowMessage('unidade');
end;
{$EndRegion}

{$Region: 'PopupMenu'}
procedure TFMenu.menuFecharClick(Sender: TObject);
begin
FecharPagina(JvPageList.ActivePage);
end;

procedure TFMenu.menuFecharTodasExcetoEssaClick(Sender: TObject);
begin
FecharPagina(JvPageList.ActivePage, True);
end;

procedure TFMenu.menuSepararAbaClick(Sender: TObject);
begin
SepararAba(JvPageList.ActivePage);
end;
{$EndRegion}

end.
GOSTEI 0
Kleber Silva

Kleber Silva

24/08/2012

amigao, nao deu certo...

Veja meu código..

unit Unit1;

interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, AdvToolBar, AdvToolBarStylers, AdvPreviewMenu,
AdvPreviewMenuStylers, AdvShapeButton, AdvOfficeStatusBar,
AdvOfficeStatusBarStylers, ExtCtrls, ComCtrls, Tabs, JvExComCtrls,
JvComCtrls, JvTabBar, JvExControls, JvPageList;

type
TFMenu = class(TAdvToolBarForm)
AdvToolBarPager1: TAdvToolBarPager;
AdvPage1: TAdvPage;
AdvToolBarOfficeStyler1: TAdvToolBarOfficeStyler;
AdvToolBar1: TAdvToolBar;
AdvShapeButton1: TAdvShapeButton;
AdvPreviewMenu1: TAdvPreviewMenu;
AdvPreviewMenuOfficeStyler1: TAdvPreviewMenuOfficeStyler;
AdvOfficeStatusBar1: TAdvOfficeStatusBar;
AdvOfficeStatusBarOfficeStyler1: TAdvOfficeStatusBarOfficeStyler;
AdvQuickAccessToolBar1: TAdvQuickAccessToolBar;
JvTabBar: TJvTabBar;
JvPageList: TJvPageList;
AdvToolBarButton1: TAdvToolBarButton;
procedure PageControlDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
procedure PageControlChange(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure JvPageListChange(Sender: TObject);
procedure JvTabBarTabClosing(Sender: TObject; Item: TJvTabBarItem; var AllowClose: Boolean);
procedure AdvToolBarButton1Click(Sender: TObject);
private
{ Private declarations }
function PodeAbrirFormulario(ClasseForm: TFormClass; var Pagina: TJvCustomPage): Boolean;
function TotalFormsAbertos(ClasseForm: TFormClass): Integer;
procedure AjustarCaptionAbas(ClasseForm: TFormClass);
function ObterAba(Pagina: TJvCustomPage): TJvTabBarItem;
function ObterPagina(Aba: TJvTabBarItem): TJvCustomPage;
protected
{ Protected declarations }
public
{ Public declarations }
procedure NovaPagina(ClasseForm: TFormClass; IndiceImagem: Integer);
function FecharPagina(Pagina: TJvCustomPage): Boolean; overload;
function FecharPagina(Pagina: TJvCustomPage; TodasExcetoEssa: Boolean): Boolean; overload;
procedure SepararAba(Pagina: TJvCustomPage);
end;

var
FMenu: TFMenu;
FormAtivo: String;

implementation

uses Unit2;

{$R *.dfm}
procedure TFMenu.NovaPagina(ClasseForm: TFormClass; IndiceImagem: Integer);
var
Aba : TJvTabBarItem;
Pagina : TJvCustomPage;
Form : TForm;
begin
//verifica se pode abrir o form
if not PodeAbrirFormulario(ClasseForm, Pagina) then
begin
JvPageList.ActivePage := Pagina;
Exit;
end;

//cria uma nova aba
Aba := JvTabBar.AddTab('');

//instancia uma página padrão
Pagina := TJvStandardPage.Create(Self);

//seta a PageList da nova página para aquela que já está no form principal
Pagina.PageList := JvPageList;

//cria um form passando a página para o seu construtor, que recebe um TComponent
Form := ClasseForm.Create(Pagina);

//Propriedades do Form
with Form do
begin
Align := alClient;
BorderStyle := bsNone;
Parent := Pagina;
end;

//Propriedades da Aba
with Aba do
begin
Caption := Form.Caption;
ImageIndex := IndiceImagem;
PopupMenu := Self.PopupMenu;
end;

//ajusta o título (caption) das abas
AjustarCaptionAbas(ClasseForm);

//ativa a página
JvPageList.ActivePage := Pagina;

FormAtivo := Form.Name;

//exibe o formulário
Form.Show;
end;

function TFMenu.PodeAbrirFormulario(ClasseForm: TFormClass; var Pagina: TJvCustomPage): Boolean;
var
I: Integer;
begin
Result := True;
//varre a JvPageList para saber se já existe um Form aberto
for I := 0 to JvPageList.PageCount - 1 do
//se achou um form
if JvPageList.Pages[I].Components[0].ClassType = ClasseForm then
begin
Pagina := JvPageList.Pages[I];
//permite abrir o form novamente caso a Tag tenha o valor zero
Result := (Pagina.Components[0] as TForm).Tag = 0;
Break;
end;
end;

//verifica o total de formulários abertos
function TFMenu.TotalFormsAbertos(ClasseForm: TFormClass): Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to JvPageList.PageCount - 1 do
begin
if JvPageList.Pages[I].Components[0].ClassType = ClasseForm then
Inc(Result);
end;
end;
//ajusta o título (caption) das abas
procedure TFMenu.AjustarCaptionAbas(ClasseForm: TFormClass);
var
I, Indice, TotalForms: Integer;
NovoCaption: string;
begin
TotalForms := TotalFormsAbertos(ClasseForm);

if TotalForms > 1 then
begin
Indice := 1;
for I := 0 to JvPageList.PageCount - 1 do
begin
with JvPageList do
begin
if Pages[I].Components[0].ClassType = ClasseForm then
begin
NovoCaption := (Pages[I].Components[0] as TForm).Caption + ' (' + IntToStr(Indice) + ')';
(Pages[I] as TJvStandardPage).Caption := NovoCaption;
ObterAba(Pages[I]).Caption := NovoCaption;
Inc(Indice);
end;
end;
end;
end;
end;

//desenha a aba
procedure TFMenu.PageControlDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
CaptionAba, CaptionForm, CaptionContador: string;
I: Integer;
begin
with JvPageList do
begin
// Separa o caption da aba e o contador de forms
CaptionAba := (Pages[TabIndex] as TJvStandardPage).Caption;

CaptionForm := Trim(Copy(CaptionAba, 1, Pos('(', CaptionAba))) + ' ';

CaptionContador := Copy(CaptionAba, Pos('(', CaptionAba), Length(CaptionAba));
CaptionContador := Copy(CaptionContador, 1, Pos(')', CaptionContador));

Canvas.FillRect(Rect);

Canvas.TextOut(Rect.Left + 3, Rect.Top + 3, CaptionForm);
I := Canvas.TextWidth(CaptionForm);

Canvas.Font.Style := [fsBold];
Canvas.TextOut(Rect.Left + 3 + I, Rect.Top + 3, CaptionContador);
end;
end;

procedure TFMenu.PageControlChange(Sender: TObject);
begin
Caption := JvTabBar.SelectedTab.Caption;
Application.Title := Caption;

with (JvPageList.ActivePage.Components[0] as TForm) do
begin
if not Assigned(Parent) then
Show;
end;
end;
//controla o fechamento da página
function TFMenu.FecharPagina(Pagina: TJvCustomPage): Boolean;
var
Form: TForm;
PaginaEsquerda: TJvCustomPage;
begin
PaginaEsquerda := nil;
Form := Pagina.Components[0] as TForm;

Result := Form.CloseQuery;

if Result then
begin
if Pagina.PageIndex > 0 then
begin
PaginaEsquerda := JvPageList.Pages[Pagina.PageIndex - 1];
end;

Form.Close;
ObterAba(Pagina).Free;
Pagina.Free;

JvPageList.ActivePage := PaginaEsquerda;
end;
end;

//controla o fechamento da página - todas exceto a selecionada
function TFMenu.FecharPagina(Pagina: TJvCustomPage; TodasExcetoEssa: Boolean): Boolean;
var
I: Integer;
begin
Result := True;
for I := JvPageList.PageCount - 1 downto 0 do
if JvPageList.Pages[I] <> Pagina then
begin
Result := FecharPagina(JvPageList.Pages[I]);
if not Result then
Exit;
end;
end;
//separa a aba (formulário)
procedure TFMenu.SepararAba(Pagina: TJvCustomPage);
begin
with Pagina.Components[0] as TForm do
begin
Align := alNone;
BorderStyle := bsSizeable;
Parent := nil;
end;
ObterAba(Pagina).Visible := False;
end;
function TFMenu.ObterAba(Pagina: TJvCustomPage): TJvTabBarItem;
var
Form: TForm;
begin
Result := nil;

Form := Pagina.Components[0] as TForm;

FormAtivo := Form.Name;

if Assigned(Pagina) then
Result := JvTabBar.Tabs[Pagina.PageIndex];
end;

procedure TFMenu.JvPageListChange(Sender: TObject);
begin
ObterAba(JvPageList.ActivePage).Selected := True;
end;
procedure TFMenu.JvTabBarTabClosing(Sender: TObject; Item: TJvTabBarItem;
var AllowClose: Boolean);
begin
AllowClose := FecharPagina(ObterPagina(Item));
end;

function TFMenu.ObterPagina(Aba: TJvTabBarItem): TJvCustomPage;
begin
Result := JvPageList.Pages[Aba.Index];
end;



procedure TFMenu.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Application.MessageBox('Deseja Realmente Sair?', 'Sair do Sistema', MB_YesNo + MB_IconQuestion) <> IdYes then
Application.Run;
end;

procedure TFMenu.AdvToolBarButton1Click(Sender: TObject);
begin
ShowMessage('form2');
end;

end.


Por favor, onde esta o erro....
Como faço para chamar o forme..?
GOSTEI 0
Jacques Silva

Jacques Silva

24/08/2012

Boa noite,
Entre em contato comigo pelo skype: elaborasyssistemas
ou msn: elaborasys@hotmail.com

Para poder lhe explicar passo a passo.
GOSTEI 0
Deivison Melo

Deivison Melo

24/08/2012

Quais os problemas que estao ocorrendo?
GOSTEI 0
POSTAR