Exemplo de criação de uma tela de Splash a partir de um TDataModule. Normalmente apenas um TForm ou TDataModule deve ser criado no arquivo .dpr para fazer com que a inicialização de um programa seja mais rápida, o que tornaria desnecessária a tela de Splash, contudo, esta implementação faz uso de GetTickCount para manter a tela de Splash visível por um período de tempo especificado

形式
Delphi
投稿日時
2019-11-23 02:46
公開期間
無期限
  1. // UFormSlpash.pas
  2. // Unit básica de um Splash com alguns elementos gráficos que podem ser suprimidos. A ideia aqui é apenas mostrar um exemplo
  3. // de tela de Splash, onde os métodos principais são ShowMeAsSplash e ShowMeAsAbout. O primeiro método exibe a tela de Splash
  4. // na inicialização de um programa e o segundo exibe a mesma tela de Slpash, porém com o intuito de ser uma tela de About.
  5. unit UFormSplash;
  6. interface
  7. uses
  8. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  9. Dialogs, PngImage, ExtCtrls, StdCtrls, UPngImageList, Buttons,
  10. UDamoPrincipal, UFormPrincipal;
  11. type
  12. TOnAfterMainFormShow = procedure (AFormSplashHandle: HWND; out ASuccess: Boolean) of object;
  13. TFormSplash = class(TForm)
  14. IMAGBackground: TImage;
  15. IMAG1: TImage;
  16. LABENomeDoProjeto: TLabel;
  17. LABEVersion: TLabel;
  18. LABECopyright: TLabel;
  19. LABECompilation: TLabel;
  20. LABETradeMarks: TLabel;
  21. LABEInfoDebug: TLabel;
  22. PANEAbout: TPanel;
  23. LABEAbout: TLabel;
  24. procedure FormKeyPress(Sender: TObject; var Key: Char);
  25. procedure DoCloseAbout(Sender: TObject);
  26. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  27. procedure FormShow(Sender: TObject);
  28. protected
  29. procedure CreateParams(var Params: TCreateParams); override;
  30. private
  31. { Private declarations }
  32. FIsAbout: Boolean;
  33. public
  34. { Public declarations }
  35. class procedure ShowMeAsSplash(ADamoPrincipal: TDamoPrincipal; AFormPrincipalClass: TFormPrincipalClass; out AFormPrincipalReference: TFormPrincipal; AOnAfterMainFormShow: TOnAfterMainFormShow);
  36. class procedure ShowMeAsAbout;
  37. end;
  38. implementation
  39. uses
  40. DateUtils, ClassesFileVersionInformation;
  41. {$R *.dfm}
  42. procedure TFormSplash.CreateParams(var Params: TCreateParams);
  43. begin
  44. inherited;
  45. // Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
  46. // Como isso não funcinou ao abrir a tela de about, desisti de usar
  47. end;
  48. procedure TFormSplash.FormClose(Sender: TObject; var Action: TCloseAction);
  49. begin
  50. Action := caFree;
  51. end;
  52. procedure TFormSplash.FormKeyPress(Sender: TObject; var Key: Char);
  53. begin
  54. if Key = #27 then
  55. DoCloseAbout(Sender);
  56. end;
  57. procedure TFormSplash.FormShow(Sender: TObject);
  58. begin
  59. LABECopyright.Caption := Format(LABECopyright.Caption,[YearOf(Now)]);
  60. LABENomeDoProjeto.Caption := Application.Title;
  61. LABEVersion.Caption := InfoModulo(rimFullFileVersionNoBuild);
  62. LABECompilation.Caption := Format(LABECompilation.Caption,[InfoModulo(rimFileBuild),FormatDateTime('dd/mm/yyyy hh:nn:ss',DataHoraManutencao)]);
  63. LABEInfoDebug.Visible := DamoPrincipal.Ambiente <> aProducao;
  64. if LABEInfoDebug.Visible then
  65. case DamoPrincipal.Ambiente of
  66. aDesenvolvimento: LABEInfoDebug.Caption := 'ATENÇÃO: AMBIENTE DE DESENVOLVIMENTO';
  67. aTeste: LABEInfoDebug.Caption := 'ATENÇÃO: AMBIENTE DE TESTES';
  68. aHomologacao: LABEInfoDebug.Caption := 'ATENÇÃO: AMBIENTE DE HOMOLOGAÇÃO';
  69. end;
  70. PANEAbout.Visible := FIsAbout;
  71. end;
  72. procedure TFormSplash.DoCloseAbout(Sender: TObject);
  73. begin
  74. if FIsAbout then
  75. Close;
  76. end;
  77. class procedure TFormSplash.ShowMeAsAbout;
  78. begin
  79. with Self.Create(nil) do
  80. begin
  81. FIsAbout := True;
  82. ShowModal;
  83. end;
  84. end;
  85. {$WARN SYMBOL_PLATFORM OFF}
  86. class procedure TFormSplash.ShowMeAsSplash(ADamoPrincipal: TDamoPrincipal; AFormPrincipalClass: TFormPrincipalClass; out AFormPrincipalReference: TFormPrincipal; AOnAfterMainFormShow: TOnAfterMainFormShow);
  87. var
  88. TimeOut: Cardinal;
  89. FormSplash: TFormSplash;
  90. AfterMainFormShowSuccess: Boolean;
  91. begin
  92. TimeOut := 0;
  93. FormSplash := Self.Create(ADamoPrincipal);
  94. try
  95. FormSplash.FIsAbout := False;
  96. // Configura o FormSplash como o Form principal e o exibe
  97. Pointer((@Application.MainForm)^) := FormSplash;
  98. FormSplash.FormStyle := fsStayOnTop;
  99. FormSplash.Show;
  100. // Aguarda 1 segundo, mostrando apenas o FormSplash
  101. if DebugHook = 0 then
  102. TimeOut := GetTickCount + 1000;
  103. while TimeOut > GetTickCount do
  104. Application.ProcessMessages;
  105. // Cria o FormPrincipal e o exibe enquanto o FormSplash ainda está visível
  106. AFormPrincipalReference := TFormPrincipalClass.Create(ADamoPrincipal);
  107. AFormPrincipalReference.Enabled := False;
  108. AFormPrincipalReference.Show;
  109. if Assigned(AOnAfterMainFormShow) then
  110. AOnAfterMainFormShow(FormSplash.Handle,AfterMainFormShowSuccess);
  111. if AfterMainFormShowSuccess then
  112. begin
  113. // Aguarda 2 segundos com ambos os forms visíveis em tela
  114. if DebugHook = 0 then
  115. TimeOut := GetTickCount + 2000;
  116. while TimeOut > GetTickCount do
  117. Application.ProcessMessages;
  118. // Configura como Form principal AFormPrincipalReference
  119. Pointer((@Application.MainForm)^) := AFormPrincipalReference;
  120. end;
  121. finally
  122. // Habilita AFormPrincipalReference e fecha FormSplash
  123. AFormPrincipalReference.Enabled := True;
  124. FormSplash.Close;
  125. end;
  126. end;
  127. {$WARN SYMBOL_PLATFORM ON}
  128. end.
  129. // Para chamar a tela de Splash como tela de About, simplesmente execute em qualquer lugar o método
  130. TFormSplash.ShowMeAsAbout;
  131. // Para usar a tela de Splash na inicialização de um programa que cria apenas o TDataModule no .dpr, utilize o OnCreate do
  132. // TDataModule assim (veja os comentários):
  133. procedure TDamoPrincipal.DataModuleCreate(Sender: TObject);
  134. begin
  135. // Como o TDataModule é o único módulo sendo criado, o formulário principal deve ser criado aqui. Atualmente, é
  136. // TFormSplash quem cria o Form principal, identificado por FFormPrincipal, que é um campo privado do
  137. // DataModule, definido como FFormPrincipal: TFormPrincipal
  138. // OnAfterMainFormShow é um manipulador de evento que deve ser criado para atuar apenas quando TFormPrincipal for
  139. // exibido (mais adiante será mostrado seu código)
  140. TFormSplash.ShowMeAsSplash(Self,TFormPrincipal,FFormPrincipal,OnAfterMainFormShow);
  141. end;
  142. // O manipulador do evento OnAfterMainFormShow é visto abaixo. Nele tentamos realizar a conexão ao banco de dados.
  143. // O método Conectar levanta uma exceção no caso de não ser possível conectar ao banco de dados. Este método é
  144. // um método simples que deve levantar uma exceção se a conexão ao banco de dados não for bem sucedida.
  145. // Dependendo da sua estratégia de validação de usuários, vc também pode dentro do método conectar exibir uma tela de login e senha
  146. // para o usuário ser validado
  147. procedure TDamoPrincipal.OnAfterMainFormShow(AFormSplashHandle: HWND; out ASuccess: Boolean);
  148. begin
  149. ASuccess := True;
  150. try
  151. Conectar;
  152. except
  153. on E: Exception do
  154. begin
  155. MessageBox(AFormSplashHandle,PChar('Não foi possível conectar ao banco de dados. A mensagem de erro original foi:'#13#10#13#10 + Trim(E.Message) + #13#10#13#10'Pressione "CTRL+C" para copiar esta mensagem de erro. Pressione "OK" para fechar a aplicação'),'Erro ao conectar',MB_ICONERROR);
  156. ASuccess := False;
  157. end;
  158. end;
  159. end;
ダウンロード 印刷用表示

このコピペの URL

JavaScript での埋め込み

iframe での埋め込み

元のテキスト