コピペ: Exemplo de código de tela de Splash

形式

Delphi

投稿日時

2020-07-23 23:04

公開期間

無期限

 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.