Exemplo de código de tela de Splash, tal como é visto no Integrador CAIE
- unit UFormSplash;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, PngImage, ExtCtrls, StdCtrls, UPngImageList, Buttons,
- UDamoPrincipal, UFormPrincipal;
- type
- TOnAfterMainFormShow = procedure (AFormSplashHandle: HWND; out ASuccess: Boolean) of object;
- TFormSplash = class(TForm)
- IMAGBackground: TImage;
- IMAG1: TImage;
- LABENomeDoProjeto: TLabel;
- LABEVersion: TLabel;
- LABECopyright: TLabel;
- LABECompilation: TLabel;
- LABETradeMarks: TLabel;
- LABEInfoDebug: TLabel;
- PANEAbout: TPanel;
- LABEAbout: TLabel;
- procedure FormKeyPress(Sender: TObject; var Key: Char);
- procedure DoCloseAbout(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure FormShow(Sender: TObject);
- protected
- procedure CreateParams(var Params: TCreateParams); override;
- private
- { Private declarations }
- FIsAbout: Boolean;
- public
- { Public declarations }
- class procedure ShowMeAsSplash(ADamoPrincipal: TDamoPrincipal; AFormPrincipalClass: TFormPrincipalClass; out AFormPrincipalReference: TFormPrincipal; AOnAfterMainFormShow: TOnAfterMainFormShow);
- class procedure ShowMeAsAbout;
- end;
- implementation
- uses
- DateUtils, ClassesFileVersionInformation;
- {$R *.dfm}
- procedure TFormSplash.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- // Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
- // Como isso não funcinou ao abrir a tela de about, desisti de usar
- end;
- procedure TFormSplash.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- Action := caFree;
- end;
- procedure TFormSplash.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if Key = #27 then
- DoCloseAbout(Sender);
- end;
- procedure TFormSplash.FormShow(Sender: TObject);
- begin
- LABECopyright.Caption := Format(LABECopyright.Caption,[YearOf(Now)]);
- LABENomeDoProjeto.Caption := Application.Title;
- LABEVersion.Caption := InfoModulo(rimFullFileVersionNoBuild);
- LABECompilation.Caption := Format(LABECompilation.Caption,[InfoModulo(rimFileBuild),FormatDateTime('dd/mm/yyyy hh:nn:ss',DataHoraManutencao)]);
- LABEInfoDebug.Visible := DamoPrincipal.Ambiente <> aProducao;
- if LABEInfoDebug.Visible then
- case DamoPrincipal.Ambiente of
- aDesenvolvimento: LABEInfoDebug.Caption := 'ATENÇÃO: AMBIENTE DE DESENVOLVIMENTO';
- aTeste: LABEInfoDebug.Caption := 'ATENÇÃO: AMBIENTE DE TESTES';
- aHomologacao: LABEInfoDebug.Caption := 'ATENÇÃO: AMBIENTE DE HOMOLOGAÇÃO';
- end;
- PANEAbout.Visible := FIsAbout;
- end;
- procedure TFormSplash.DoCloseAbout(Sender: TObject);
- begin
- if FIsAbout then
- Close;
- end;
- class procedure TFormSplash.ShowMeAsAbout;
- begin
- with Self.Create(nil) do
- begin
- FIsAbout := True;
- ShowModal;
- end;
- end;
- {$WARN SYMBOL_PLATFORM OFF}
- class procedure TFormSplash.ShowMeAsSplash(ADamoPrincipal: TDamoPrincipal; AFormPrincipalClass: TFormPrincipalClass; out AFormPrincipalReference: TFormPrincipal; AOnAfterMainFormShow: TOnAfterMainFormShow);
- var
- TimeOut: Cardinal;
- FormSplash: TFormSplash;
- AfterMainFormShowSuccess: Boolean;
- begin
- TimeOut := 0;
- FormSplash := Self.Create(ADamoPrincipal);
- try
- FormSplash.FIsAbout := False;
- // Configura o FormSplash como o Form principal e o exibe
- Pointer((@Application.MainForm)^) := FormSplash;
- FormSplash.FormStyle := fsStayOnTop;
- FormSplash.Show;
- // Aguarda 1 segundo, mostrando apenas o FormSplash
- if DebugHook = 0 then
- TimeOut := GetTickCount + 1000;
- while TimeOut > GetTickCount do
- Application.ProcessMessages;
- // Cria o FormPrincipal e o exibe enquanto o FormSplash ainda está visível
- AFormPrincipalReference := TFormPrincipalClass.Create(ADamoPrincipal);
- AFormPrincipalReference.Enabled := False;
- AFormPrincipalReference.Show;
- if Assigned(AOnAfterMainFormShow) then
- AOnAfterMainFormShow(FormSplash.Handle,AfterMainFormShowSuccess);
- if AfterMainFormShowSuccess then
- begin
- // Aguarda 2 segundos com ambos os forms visíveis em tela
- if DebugHook = 0 then
- TimeOut := GetTickCount + 2000;
- while TimeOut > GetTickCount do
- Application.ProcessMessages;
- // Configura como Form principal AFormPrincipalReference
- Pointer((@Application.MainForm)^) := AFormPrincipalReference;
- end;
- finally
- // Habilita AFormPrincipalReference e fecha FormSplash
- AFormPrincipalReference.Enabled := True;
- FormSplash.Close;
- end;
- end;
- {$WARN SYMBOL_PLATFORM ON}
- end.