Exemplo de código de tela de Splash, tal como é visto no Integrador CAIE

形式
Delphi
投稿日時
2020-07-23 23:04
公開期間
無期限
  1. unit UFormSplash;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5. Dialogs, PngImage, ExtCtrls, StdCtrls, UPngImageList, Buttons,
  6. UDamoPrincipal, UFormPrincipal;
  7. type
  8. TOnAfterMainFormShow = procedure (AFormSplashHandle: HWND; out ASuccess: Boolean) of object;
  9. TFormSplash = class(TForm)
  10. IMAGBackground: TImage;
  11. IMAG1: TImage;
  12. LABENomeDoProjeto: TLabel;
  13. LABEVersion: TLabel;
  14. LABECopyright: TLabel;
  15. LABECompilation: TLabel;
  16. LABETradeMarks: TLabel;
  17. LABEInfoDebug: TLabel;
  18. PANEAbout: TPanel;
  19. LABEAbout: TLabel;
  20. procedure FormKeyPress(Sender: TObject; var Key: Char);
  21. procedure DoCloseAbout(Sender: TObject);
  22. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  23. procedure FormShow(Sender: TObject);
  24. protected
  25. procedure CreateParams(var Params: TCreateParams); override;
  26. private
  27. { Private declarations }
  28. FIsAbout: Boolean;
  29. public
  30. { Public declarations }
  31. class procedure ShowMeAsSplash(ADamoPrincipal: TDamoPrincipal; AFormPrincipalClass: TFormPrincipalClass; out AFormPrincipalReference: TFormPrincipal; AOnAfterMainFormShow: TOnAfterMainFormShow);
  32. class procedure ShowMeAsAbout;
  33. end;
  34. implementation
  35. uses
  36. DateUtils, ClassesFileVersionInformation;
  37. {$R *.dfm}
  38. procedure TFormSplash.CreateParams(var Params: TCreateParams);
  39. begin
  40. inherited;
  41. // Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
  42. // Como isso não funcinou ao abrir a tela de about, desisti de usar
  43. end;
  44. procedure TFormSplash.FormClose(Sender: TObject; var Action: TCloseAction);
  45. begin
  46. Action := caFree;
  47. end;
  48. procedure TFormSplash.FormKeyPress(Sender: TObject; var Key: Char);
  49. begin
  50. if Key = #27 then
  51. DoCloseAbout(Sender);
  52. end;
  53. procedure TFormSplash.FormShow(Sender: TObject);
  54. begin
  55. LABECopyright.Caption := Format(LABECopyright.Caption,[YearOf(Now)]);
  56. LABENomeDoProjeto.Caption := Application.Title;
  57. LABEVersion.Caption := InfoModulo(rimFullFileVersionNoBuild);
  58. LABECompilation.Caption := Format(LABECompilation.Caption,[InfoModulo(rimFileBuild),FormatDateTime('dd/mm/yyyy hh:nn:ss',DataHoraManutencao)]);
  59. LABEInfoDebug.Visible := DamoPrincipal.Ambiente <> aProducao;
  60. if LABEInfoDebug.Visible then
  61. case DamoPrincipal.Ambiente of
  62. aDesenvolvimento: LABEInfoDebug.Caption := 'ATENÇÃO: AMBIENTE DE DESENVOLVIMENTO';
  63. aTeste: LABEInfoDebug.Caption := 'ATENÇÃO: AMBIENTE DE TESTES';
  64. aHomologacao: LABEInfoDebug.Caption := 'ATENÇÃO: AMBIENTE DE HOMOLOGAÇÃO';
  65. end;
  66. PANEAbout.Visible := FIsAbout;
  67. end;
  68. procedure TFormSplash.DoCloseAbout(Sender: TObject);
  69. begin
  70. if FIsAbout then
  71. Close;
  72. end;
  73. class procedure TFormSplash.ShowMeAsAbout;
  74. begin
  75. with Self.Create(nil) do
  76. begin
  77. FIsAbout := True;
  78. ShowModal;
  79. end;
  80. end;
  81. {$WARN SYMBOL_PLATFORM OFF}
  82. class procedure TFormSplash.ShowMeAsSplash(ADamoPrincipal: TDamoPrincipal; AFormPrincipalClass: TFormPrincipalClass; out AFormPrincipalReference: TFormPrincipal; AOnAfterMainFormShow: TOnAfterMainFormShow);
  83. var
  84. TimeOut: Cardinal;
  85. FormSplash: TFormSplash;
  86. AfterMainFormShowSuccess: Boolean;
  87. begin
  88. TimeOut := 0;
  89. FormSplash := Self.Create(ADamoPrincipal);
  90. try
  91. FormSplash.FIsAbout := False;
  92. // Configura o FormSplash como o Form principal e o exibe
  93. Pointer((@Application.MainForm)^) := FormSplash;
  94. FormSplash.FormStyle := fsStayOnTop;
  95. FormSplash.Show;
  96. // Aguarda 1 segundo, mostrando apenas o FormSplash
  97. if DebugHook = 0 then
  98. TimeOut := GetTickCount + 1000;
  99. while TimeOut > GetTickCount do
  100. Application.ProcessMessages;
  101. // Cria o FormPrincipal e o exibe enquanto o FormSplash ainda está visível
  102. AFormPrincipalReference := TFormPrincipalClass.Create(ADamoPrincipal);
  103. AFormPrincipalReference.Enabled := False;
  104. AFormPrincipalReference.Show;
  105. if Assigned(AOnAfterMainFormShow) then
  106. AOnAfterMainFormShow(FormSplash.Handle,AfterMainFormShowSuccess);
  107. if AfterMainFormShowSuccess then
  108. begin
  109. // Aguarda 2 segundos com ambos os forms visíveis em tela
  110. if DebugHook = 0 then
  111. TimeOut := GetTickCount + 2000;
  112. while TimeOut > GetTickCount do
  113. Application.ProcessMessages;
  114. // Configura como Form principal AFormPrincipalReference
  115. Pointer((@Application.MainForm)^) := AFormPrincipalReference;
  116. end;
  117. finally
  118. // Habilita AFormPrincipalReference e fecha FormSplash
  119. AFormPrincipalReference.Enabled := True;
  120. FormSplash.Close;
  121. end;
  122. end;
  123. {$WARN SYMBOL_PLATFORM ON}
  124. end.
ダウンロード 印刷用表示

このコピペの URL

JavaScript での埋め込み

iframe での埋め込み

元のテキスト