lazarus/ide/splash.pp

{  $Id$  }
{
 /***************************************************************************
                               Splash.pp
                             -------------------




 ***************************************************************************/

/***************************************************************************
 *                                                                         *
 *   This program is free software; you can redistribute it and/or modify  *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 ***************************************************************************/
}
unit Splash;

{$mode objfpc}{$H+}

interface

uses
  Classes, Controls, Forms, Buttons, SysUtils, StdCtrls, ExtCtrls, LResources,
  LCLLinux{must be used before graphics}, Graphics;

type
  TSplashForm = class(TForm)
    procedure ApplicationOnIdle(Sender: TObject; var Done: Boolean);
  private
    FPixmap : TPixmap;
    FTimer : TTimer;
    procedure HideFormTimer(Sender : TObject);
  protected
    procedure Click; override;
  public
    procedure Paint; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure StartTimer;
  end;

var
  SplashForm: TSplashForm;


implementation


constructor TSplashForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := 'Lazarus';
  Width := 429;
  Height := 341;
  Position:= poScreenCenter;
  BorderStyle  := bsToolWindow;

  FPixmap := TPixmap.Create;
  FPixmap.LoadFromLazarusResource('splash_logo');
  //FBitmap.Handle := CreatePixmapIndirect(@SPLASH_IMAGE, ColorToRGB(clBtnFace));

  FTimer := TTimer.Create(self);
  with FTimer do
  begin
    Interval := 500;
    OnTimer := @HideFormTimer;
    Enabled := False;
  end;

  Application.OnIdle:=@ApplicationOnIdle;
end;

destructor TSplashForm.Destroy;
begin
  FPixmap.Free;
  FPixmap:=nil;
  FTimer.Free;
  FTimer:=nil;
  if Application.OnIdle=@ApplicationOnIdle then
    Application.OnIdle:=nil;
  inherited Destroy;
end;

procedure TSplashForm.Click; 
begin
  Hide;
  if FTimer<>nil then begin
    FTimer.Enabled := False;
    //Release resources
    FTimer.Free;
    FTimer:=nil;
    FPixmap.Free;
    FPixmap:=nil;
  end;
end;

procedure TSplashForm.ApplicationOnIdle(Sender: TObject; var Done: Boolean);
begin
  Hide;
end;

procedure TSplashForm.HideFormTimer(Sender : TObject);
begin
  Click;
end;

procedure TSplashForm.Paint;
begin
  inherited Paint;
  if FPixmap <>nil
  then Canvas.Copyrect(Bounds(0, 0, Width, Height)
     ,FPixmap.Canvas, Rect(0,0, Width, Height));
end;

procedure TSplashForm.StartTimer;
begin
  if FTimer<>nil then
    FTimer.Enabled := True;
end;

initialization
  {$I splash.lrs}

end.

{ =============================================================================

  $Log$
  Revision 1.12  2002/05/06 08:58:33  lazarus
  MG: removed unused splash image

  Revision 1.11  2002/05/06 08:50:34  lazarus
  MG: replaced logo, increased version to 0.8.3a and some clientrectbugfix

  Revision 1.10  2002/03/30 21:09:07  lazarus
  MG: hide splash screen on message

  Revision 1.9  2002/03/30 07:29:15  lazarus
  MG: fixed splash screen, fixed parser of resource strings

  Revision 1.8  2002/03/18 11:44:41  lazarus
  MG: TForm.Position will now considered before creating form on 0,0

  Revision 1.7  2001/11/19 21:48:53  lazarus
  MG: fixed splash timer AV, incomplete project loading, application save as

  Revision 1.6  2001/11/19 12:14:24  lazarus
  MG: changed splashform borderstyle

  Revision 1.5  2001/10/15 17:41:31  lazarus
  MG: fixed splashform showing

  Revision 1.4  2001/03/20 16:59:15  lazarus
  MG: fixed many bugs (mem leaks, canvas)

  Revision 1.3  2001/03/19 14:00:47  lazarus
  MG: fixed many unreleased DC and GDIObj bugs

  Revision 1.2  2000/09/10 23:08:30  lazarus
  MWE:
    + Added CreateCompatibeleBitamp function
    + Updated TWinControl.WMPaint
    + Added some checks to avoid gtk/gdk errors
    - Removed no fixed warning from GetDC
    - Removed some output

  Revision 1.1  2000/07/13 10:27:48  michael
  + Initial import

  Revision 1.3  2000/03/30 23:12:17  lazarus
  MWE:
    Moved gtk stuff to ./lcl/interfaces/gtk
    Changed Makefiles

  Revision 1.2  2000/03/19 23:01:42  lazarus
  MWE:
    = Changed splashscreen loading/colordepth
    = Chenged Save/RestoreDC to platform  dependent, since they are
      relative to a DC

}