Display different splash screens anytime during program execution

Problem/Question/Abstract:

How to display different splash screens anytime during program execution

Answer:

Solve 1:

I wanted to be able to display a splash screen anytime during the program run with different durations and different images each time. The problem with using the Release method from within a form is that it doesn't set the variable referencing the splash form to NIL. When the splash form is released, I need to reset the reference so that I can test it when displaying the form to make sure it's NIL (that there isn't one already up). I could easily have made the reference public and set it to NIL after calling Release from within the timer event, but that's not very reusable.

What I ended up doing is creating a class (TFormWithSplash) derived from TForm that has all mechanisms necessary to handle the splash screen itself. Then, any form I want to be able to display splashscreens, I simply derive from this class instead of TForm. The unit that defines TFormWithSplash has a simple form within it that contains an image and timer control. The ShowSplash method of TFormWithSplash creates an instance of this form and displays it. This form then loads the image file and starts the timer. When the timer elapses, the form closes itself and sends a user defined message its parent form which frees the reference and resets it to nil. Everything but the PicFileName, SplashDuration, StayOnTop properties and the ShowSplash function calls are invisible to the programmer. Here is the code; it still needs a few features, but seems to work well.

unit SplashFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;

const
  WM_SPLASHCLOSED = WM_USER + 113;

type
  TFormWithSplash = class;
  TSplashForm = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
  private
    CloseOnDeactivate: Boolean;
    procedure LoadAndDisplay(PicFile: string);
  public
    constructor Create(Owner: TFormWithSplash; DisplayFor: Cardinal;
      CloseOnLostFocus: Boolean; TopMost: Boolean);
  end;

  TFormWithSplash = class(TForm)
    PicFile: string;
    SplashForm: TSplashForm;
    procedure SetPicFile(FileName: string);
    procedure OnSplashClosed(var msg: TMessage); message WM_SPLASHCLOSED;
  public
    SplashDuration: Cardinal;
    StayOnTop, CloseOnLostFocus: Boolean;
    constructor Create(Owner: TComponent); override;
    procedure ShowSplash;
    property SplashPicFile: string read PicFile write SetPicFile;
  end;

implementation

{$R *.DFM}

constructor TFormWithSplash.Create(Owner: TComponent);
begin
  SplashForm := nil;
  PicFile := '';
  StayOnTop := True;
  CloseOnLostFocus := False;
  inherited Create(Owner);
end;

procedure TFormWithSplash.OnSplashClosed(var msg: TMessage);
begin
  SplashForm.Free;
  SplashForm := nil;
end;

procedure TFormWithSplash.SetPicFile(FileName: string);
begin
  if not FileExists(FileName) then
    raise EInOutError.Create('Couldn''t load image file: ' + FileName)
  else
    PicFile := FileName;
end;

procedure TFormWithSplash.ShowSplash;
begin
  if PicFile = '' then
    Exit;
  while Assigned(SplashForm) do
    Application.ProcessMessages;
  SplashForm := TSplashForm.Create(self, SplashDuration, CloseOnLostFocus, StayOnTop);
  SplashForm.LoadAndDisplay(PicFile);
end;

constructor TSplashForm.Create(Owner: TFormWithSplash; DisplayFor: Cardinal;
  CloseOnLostFocus: Boolean; TopMost: Boolean);
begin
  inherited Create(Owner);
  CloseOnDeactivate := CloseOnLostFocus;
  if TopMost then
    FormStyle := fsStayOnTop;
  Image1.AutoSize := True;
  Timer1.Interval := DisplayFor * 1000;
end;

procedure TSplashForm.LoadAndDisplay(PicFile: string);
begin
  Image1.Picture.LoadFromFile(PicFile);
  ClientHeight := Image1.Picture.Height + 1;
  ClientWidth := Image1.Picture.Width + 1;
  Left := Screen.Width div 2 - Width div 2;
  Top := Screen.Height div 2 - Height div 2;
  Show;
end;

procedure TSplashForm.FormShow(Sender: TObject);
begin
  Application.RestoreTopmosts;
  Timer1.Enabled := True;
end;

procedure TSplashForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  PostMessage(TFormWithSplash(Owner).Handle, WM_SPLASHCLOSED, 0, 0);
end;

procedure TSplashForm.Timer1Timer(Sender: TObject);
begin
  Close;
end;

procedure TSplashForm.FormDeactivate(Sender: TObject);
begin
  if CloseOnDeactivate then
  begin
    Timer1.Enabled := False;
    Close;
  end;
end;

end.


Solve 2:

This information is found in the View Menu and then view Project Source.

begin
  SplashScreen := TSplashScreen.Create(Application); //These 3 lines
  SplashScreen.Show; //Added Manually
  SplashScreen.Update; //to load SplashScreen
  Application.Initialize;
  Application.Title := 'Application Title';
  Application.CreateForm(TForm1, Form1);
  SplashScreen.Hide; //These 2 added
  SplashScreen.Free; //manually to close Splash
  Application.Run;
end.

In Project Options, set SplashScreen Form to be an available form, not Autocreate.