unit SplashAbout;
{

[SplashAbout] [1.3]
Delphi 2005
March 2008

LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[SplashAbout.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005-2008 Martin Holmes
and the University of Victoria Computing and Media Centre. The code was 
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
 Unit written by Martin Holmes, October 2005, using Delpi 2005, and only tested with
 Delphi 2005. Updated March 2008 to add the capability to pass in extra
 pieces of information for display in the About box.

 This unit aims to encapsulate a splash screen and an About box for an
 application. It includes an object for retrieving application version
 information from the executable itself through the Windows API. This
 information is displayed in the About box, but is also available
 to the main application through the SplashAbout object.

 Use it like this:

 In the application's main form, create a variable:

  SplashAbout: TSplashAbout;

 Include a suitable image in your app, perhaps as in a hidden TImage component.

 In the main form's Show event, call:

  SplashAbout := TSplashAbout.Create;

 Then make a call to show the Splash screen:

  SplashAbout.ShowSplash(imgSplash.Picture.Bitmap, 3, BoundsRect);

 Passing BoundsRect from the main form makes the splash screen show up centred
 on the main form's position, rather than on the screen. This is preferable,
 I think. The second parameter is the number of seconds to show the splash.

 The function automatically detects a command-line parameter of -nosplash, and
 suppresses itself if it finds one.

 In the main form's Close event, free the object:

  SplashAbout.Free;

 To show an About box, do this:

  SplashAbout.ShowAbout(imgSplash.Picture.Bitmap, BoundsRect, clWhite);

 Dependencies:

  VersionInfo (this has a class for getting version info
 about the running application). It would be feasible to use an instantiated
 TAppVersionInfo belonging to another object owned by the main
 form, but then this library wouldn't be portable.

  TntUnicode libraries (Troy Wolbrink).


}
interface

uses
  Classes, Graphics, Forms, Windows, SysUtils, Controls, TntForms, TntStdCtrls,
  TntExtCtrls, ExtCtrls, TntClasses, VersionInfo, StdCtrls, ShellAPI;

type
  {TSplashAbout}

  TSplashAbout = class(TObject)
  private

    FForm: TTntForm;
    FImage: TImage;
    FPic: Graphics.TBitmap;
    FRect: TRect;
    FAppVersionInfo: TAppVersionInfo;
    FuslExtraInfo: TTntStringList;
    FSuppressCmdParam: string;
    procedure FreeTheForm(Sender: TObject; var Action: TCloseAction);
    procedure ClickLinkLabel(Sender: TObject);
  protected
    procedure AddInfoText(Text: WideString; isLink: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    procedure ShowSplash(Pic: Graphics.TBitmap; Seconds: integer; ContextRect: TRect);
    procedure ShowAbout(Pic: Graphics.TBitmap; ContextRect: TRect; Background: TColor);
    procedure AddExtraInfoLine(wsLine: WideString; isLink: Boolean);
    procedure ClearExtraInfo;
    property AppVersionInfo: TAppVersionInfo read FAppVersionInfo;
    property SuppressCmdParam: string read FSuppressCmdParam write FSuppressCmdParam;
  end;

implementation

{ TSplashAbout }

procedure TSplashAbout.AddInfoText(Text: WideString; isLink: Boolean);
var
L: TTntLabel;
begin
  if Length(Text) < 1 then
    Exit;
  L := TTntLabel.Create(FForm);
  with L do
    begin
      Parent := FForm;
      if isLink then
        begin
          Font.Style := [fsUnderline];
          Font.Color := clBlue;
          Cursor := crHandPoint;
          onClick := ClickLinkLabel;
        end;
      Caption := Text;
      //Color := FForm.Color;
      Transparent := True;
      Alignment := taCenter;
      WordWrap := True;
      Left := 4;
      Top := FForm.ClientHeight + 1;
      Width := FForm.ClientWidth - 8;
    end;
  FForm.ClientHeight := FForm.ClientHeight + L.Height + 2;
end;

procedure TSplashAbout.FreeTheForm(Sender: TObject; var Action: TCloseAction);
begin
  if FForm <> nil then
    FreeAndNil(FForm);
end;

constructor TSplashAbout.Create;
begin
  inherited;
  FAppVersionInfo := TAppVersionInfo.Create;
  FuslExtraInfo := TTntStringList.Create;
  SuppressCmdParam := '-nosplash';
end;

destructor TSplashAbout.Destroy;
begin
  if FForm <> nil then
    FreeAndNil(FForm);
  FreeAndNil(FuslExtraInfo);
  FAppVersionInfo.Free;
  inherited;
end;

procedure TSplashAbout.ShowAbout(Pic: Graphics.TBitmap; ContextRect: TRect; Background: TColor);
var
L, T: integer;
i: integer;
isLink: Boolean;

begin
  if FForm <> nil then
    FreeAndNil(FForm);
  FPic := Pic;
  FRect := ContextRect;
  FForm := TTntForm.Create(nil);
  try
    with FForm do
      begin
        BorderStyle := bsSingle;
        Caption := 'About ' + AppVersionInfo.ProductName;
        FormStyle := fsStayOnTop;
        Color := Background;
        Scaled := False;
        AutoScroll := False;
        OnClose := FreeTheForm;
      end;
    FImage := TImage.Create(FForm);
    with FImage do
      begin
        Parent := FForm;
        AutoSize := True;
        Left := 0;
        Top := 0;
        Picture.Bitmap.Assign(FPic);
      end;
    with FForm do
      begin
//Set the size to the image, initially
        ClientWidth := FImage.Width;
        ClientHeight := FImage.Height;

//Add the relevant info
        AddInfoText(AppVersionInfo.ProductName, False);
        AddInfoText(AppVersionInfo.DottedVersion, False);
        AddInfoText(AppVersionInfo.FileDescription, False);
        AddInfoText(AppVersionInfo.CompanyName, False);
        AddInfoText(AppVersionInfo.LegalCopyright, False);
        AddInfoText(AppVersionInfo.Comments, False);
        AddInfoText(AppVersionInfo.URL, True);

//Add any extra info passed in.
        if FuslExtraInfo.Count > 0 then
          for i := 0 to FuslExtraInfo.Count-1 do
            begin
              isLink := (integer(FuslExtraInfo.Objects[i]) = 1);
              AddInfoText(FuslExtraInfo[i], isLink);
            end;
//        LockWindowUpdate(FForm.Handle);
        Show;
//Set the size of the form to match the image and position it properly
        L := ((FRect.Right - FRect.Left) div 2) + FRect.Left - (Width div 2);
        T := ((FRect.Bottom - FRect.Top) div 2) + FRect.Top - (Height div 2);
        if L+Width > Screen.DesktopWidth then
          L := Screen.DesktopWidth - Width;
        if T+Height > Screen.DesktopHeight then
          T := Screen.DesktopHeight - Height;
        SetBounds(L, T, Width, Height);
//        LockWindowUpdate(0);
        Update;
        Application.ProcessMessages;
      end;
  finally

  end;
end;

procedure TSplashAbout.ShowSplash(Pic: Graphics.TBitmap; Seconds: integer; ContextRect: TRect);
var
L, T: integer;

begin
//Only show if the command line doesn't include a -nosplash parameter
  if (Pos(SuppressCmdParam, CmdLine) < 1) then
    begin
      FPic := Pic;
      FRect := ContextRect;
      FForm := TTntForm.Create(nil);
      try
        with FForm do
          begin
            BorderStyle := bsNone;
            FormStyle := fsStayOnTop;
            AutoScroll := False;
            Scaled := False;
          end;
        FImage := TImage.Create(FForm);
        with FImage do
          begin
            Parent := FForm;
            AutoSize := True;
            Left := 0;
            Top := 0;
            Picture.Bitmap.Assign(FPic);
          end;
        with FForm do
          begin
{TODO: BUG! On dual monitors, if the ContextRect is on the second monitor, the splash
screen fails to appear. This may be a bug in my own display card drive, or it may
be more general. Get feedback from users on this.}
//            LockWindowUpdate(FForm.Handle);
            {Application.ProcessMessages;
            Show;
            Application.ProcessMessages;}
            ClientWidth := FImage.Width;
            ClientHeight := FImage.Height;
//Set the size of the form to match the image and position it properly
            //Set the size of the form to match the image and position it properly
            L := ((FRect.Right - FRect.Left) div 2) + FRect.Left - (FImage.Width div 2);
            T := ((FRect.Bottom - FRect.Top) div 2) + FRect.Top - (FImage.Height div 2);
            if L+FImage.Width > Screen.DesktopWidth then
              L := Screen.DesktopWidth - FImage.Width;
            if T+FImage.Height > Screen.DesktopHeight then
              T := Screen.DesktopHeight - FImage.Height;
            SetBounds(L, T, FImage.Width, FImage.Height);
            Show;
//            LockWindowUpdate(0);
            Application.ProcessMessages;
            Update;
            Application.ProcessMessages;
            Sleep(Seconds * 1000);
            Hide;
          end;
      finally
        FreeAndNil(FForm);
      end;
    end;
end;

procedure TSplashAbout.ClickLinkLabel(Sender: TObject);
begin
  ShellExecute(0, 'open', PChar(string(TTntLabel(Sender).Caption)), nil, nil, SW_NORMAL);
end;

procedure TSplashAbout.ClearExtraInfo;
begin
  FuslExtraInfo.Clear;
end;

procedure TSplashAbout.AddExtraInfoLine(wsLine: WideString; isLink: Boolean);
var
intLink: integer;

begin
  intLink := 0;
  if isLink then
    intLink := 1;
  FuslExtraInfo.AddObject(wsLine, Pointer(intLink));
end;

end.