(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTSplashScreen;

interface

uses
  Windows,Messages, SysUtils, Classes, Graphics, Controls,
  AHMEnhancedClass,AHMTBackground,Forms;

type
  TAHMSplashScreen = class(TAHMEnhancedExecComponent)
  private
    fOnRun : TNotifyevent;
    fimg : TBitmap;
    fdel : Longint;
    fback : TAHMBackground;
    fwidth,fheight: Integer;
    fosd : TNotifyevent;
    fins,fout : TAHMFrame;
    fbord : Integer;
    fcent : boolean;
    procedure SetBack(value : TAHMBackground);
    procedure SetImg(value : TBitmap);
    procedure Delay(MSecs: Integer);
    procedure SetDel(value : Longint);
    procedure Setbord(value : Integer);
  protected
  public
    Constructor Create(AOwner : TComponent); override;
    Destructor Destroy; override;
    Function Execute : Boolean; override;
    procedure Close;
    procedure Loaded; override;
  published
    property Image : TBitmap read fimg write Setimg;
    property OnRun : TNotifyevent read fOnRun write fOnRun;
    property SplashWidth : Integer read fwidth write fwidth;
    property SplashHeight : Integer read fheight write fheight;
    property OnSplashDone : Tnotifyevent read fosd write fosd;
    property DelayInMsec : LongInt read fdel write Setdel default 1000;
    property Background : TAHMBackground read fback write Setback;
    property OutsideFrame : TAHMFrame read fout write fout;
    property InsideFrame : TAHMFrame read fins write fins;
    property Borderwidth : Integer read fbord write Setbord;
    property Screencenter : Boolean read fcent write fcent default True;
  end;

var  Go : Boolean;

implementation

type
  TSplashForm = class(TForm)
    procedure Run;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    sRun,sosd : TNotifyevent;
  end;
var
  SplashForm: TSplashForm;


Constructor TAHMSplashScreen.Create(AOwner:TComponent);
begin
  fwidth:=300;
  fHeight:=200;
  fdel:=1000;
  fbord:=2;
  fcent:=true;
  inherited create(AOwner as TForm);
  fimg:=TBitmap.create;
  fins:=TAHMFrame.create(self);
  fins.framestyle:=framelowered;
  fout:=TAHMFrame.create(self);
end;

procedure TAHMSplashscreen.Loaded;
begin
  inherited Loaded;
end;

Destructor TAHMSplashScreen.Destroy;
begin
  fimg.free;
  fins.free;
  fout.free;
  inherited Destroy;
end;

procedure TAHMSplashscreen.SetBack(Value: TAHMBackground);
Begin
  fback:=Value;
end;

procedure TAHMSplashscreen.SetBord(value : Integer);
begin
  if value>=0 then fbord:=value;
end;

Function TAHMSplashscreen.execute : Boolean;
var xb : TBitmap;
    x1,y1 : Integer;
    lr : TRect;
begin
  SplashForm:=TSplashForm.CreateNew(Application);
  with SplashForm do
  try
    BorderStyle:=bsNone;
    lr:=rect(0,0,fwidth,fheight);
    if fwidth<=fimg.width then x1:=0
    else x1:=round((fwidth-fimg.width)/2);
    if fheight<=fimg.height then y1:=0
    else y1:=round((fheight-fimg.height)/2);
    xb:=TBitmap.create;
    xb.width:=fwidth;
    xb.height:=fheight;
    if assigned(fback) then fback.draw(xb.canvas.Handle,fwidth,fheight,true);
    if not(fimg.empty) then
    xb.canvas.draw(x1,y1,fimg);
    fout.draw(xb.canvas.handle,lr);
    inflaterect(lr,-fbord,-fbord);
    fins.draw(xb.canvas.handle,lr);
    Splashform.width:=fwidth;
    Splashform.height:=fheight;
    Splashform.srun:=fOnRun;
    Splashform.sosd:=fosd;
    if fcent then Splashform.Position:=poScreencenter
    else Splashform.Position:=poDefault;
    SplashForm.show;
    Splashform.canvas.draw(0,0,xb);
    Splashform.Run;
    Delay(fdel);
    xb.free;
    close;
  finally
    Free;
  end;
  result:=true;
end;

procedure TAHMSplashScreen.Delay(MSecs: Integer);
var FirstTickCount : DWord;
begin
  FirstTickCount:=GetTickCount;
  repeat Application.ProcessMessages until
         ((GetTickCount-FirstTickCount) >= DWord(MSecs));
end;

procedure TAHMSplashScreen.Setimg(value : TBitmap);
begin
  fimg.assign(value);
end;

procedure TAHMSplashScreen.SetDel(value : Longint);
begin
  if value>=0 then fdel:=value;
end;

procedure TAHMSplashScreen.Close;
begin
  SplashForm.Close;
end;

procedure TSplashForm.Run;
begin
  if assigned(SRun) then SRun(Self);
end;

procedure TSplashForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if assigned(sosd) then sosd(self);
  go:=false;
end;

end.
