splashform.pas

lansd aslda sldasdnaslda sdlandslasd

unit SplashForm;

interface

{$define PNG_GRAPHICEX}
{.$define PNG_GDIPLUS}

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

type
  TFormSplash = class(TForm)
    TimerSplash: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TimerSplashTimer(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
  protected
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure Fade;
  public
    procedure Execute;
  end;

var
  FormSplash: TFormSplash;

implementation

// Make sure exactly one of the PNG libraries are enabled
{$ifdef PNG_GRAPHICEX}
{$undef PNG_GDIPLUS}
{$endif}
{$ifdef PNG_GDIPLUS}
{$undef PNG_GRAPHICEX}
{$endif}
{$ifndef PNG_GRAPHICEX}
{$ifndef PNG_GDIPLUS}
{$define PNG_GRAPHICEX}
{$endif}
{$endif}


uses
{$ifdef PNG_GRAPHICEX}
  GraphicEx;
{$endif}
{$ifdef PNG_GDIPLUS}
  GdipObj,
  GdipApi,
  ActiveX;
{$endif}

{$R *.dfm}

// The following declarations are missing in Delphi 5, but included in later versions:
{$ifdef VER130}
function UpdateLayeredWindow(hwnd: HWND; hdcDst: HDC; pptDst: PPoint;
  psize: PSize; hdcSrc: HDC; pptSrc: PPoint; crKey: TColor;
  pblend: PBlendFunction; dwFlags: DWORD): BOOL; stdcall; external 'user32.dll';

const
  WS_EX_LAYERED = $00080000;
  AC_SRC_ALPHA = $01;
  ULW_ALPHA = $00000002;
{$endif}

procedure TFormSplash.TimerSplashTimer(Sender: TObject);
begin
  Close;
end;

procedure TFormSplash.Fade;
begin

end;

procedure TFormSplash.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TFormSplash.FormKeyPress(Sender: TObject; var Key: Char);
begin
  Close;
end;

procedure PremultiplyBitmapSlow(Bitmap: TBitmap);
var
  Row, Col: integer;
  p: PRGBQuad;
begin
  for Row := 0 to Bitmap.Height-1 do
  begin
    Col := Bitmap.Width;
    p := Bitmap.ScanLine[Row];
    while (Col > 0) do
    begin
      p.rgbBlue := p.rgbBlue * p.rgbReserved div 255;
      p.rgbGreen := p.rgbGreen * p.rgbReserved div 255;
      p.rgbRed := p.rgbRed * p.rgbReserved div  255;

      inc(p);
      dec(Col);
    end;
  end;
end;

procedure PremultiplyBitmap(Bitmap: TBitmap);
var
  Row, Col: integer;
  p: PRGBQuad;
  PreMult: array[byte, byte] of byte;
begin
  // precalculate all possible values of a*b
  for Row := 0 to 255 do
    for Col := Row to 255 do
    begin
      PreMult[Row, Col] := Row*Col div 255;
      if (Row <> Col) then
        PreMult[Col, Row] := PreMult[Row, Col]; // a*b = b*a
    end;

  for Row := 0 to Bitmap.Height-1 do
  begin
    Col := Bitmap.Width;
    p := Bitmap.ScanLine[Row];
    while (Col > 0) do
    begin
      p.rgbBlue := PreMult[p.rgbReserved, p.rgbBlue];
      p.rgbGreen := PreMult[p.rgbReserved, p.rgbGreen];
      p.rgbRed := PreMult[p.rgbReserved, p.rgbRed];
      inc(p);
      dec(Col);
    end;
  end;
end;

{$ifdef PNG_GDIPLUS}
type
  TFixedStreamAdapter = class(TStreamAdapter)
  public
    function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult; override; stdcall;
  end;

function TFixedStreamAdapter.Stat(out statstg: TStatStg; grfStatFlag: Integer): HResult;
begin
  Result := inherited Stat(statstg, grfStatFlag);
  statstg.pwcsName := nil;
end;

// GDI+ version
procedure TFormSplash.Execute;
var
  Ticks: DWORD;
  BlendFunction: TBlendFunction;
  BitmapPos: TPoint;
  BitmapSize: TSize;
  exStyle: DWORD;
  Bitmap: TBitmap;
  PNGBitmap: TGPBitmap;
  BitmapHandle: HBITMAP;
  Stream: TStream;
  StreamAdapter: IStream;
begin
  // Enable window layering
  exStyle := GetWindowLongA(Handle, GWL_EXSTYLE);
  if (exStyle and WS_EX_LAYERED = 0) then
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);

  Bitmap := TBitmap.Create;
  try
    // Load the PNG from a resource
    Stream := TResourceStream.Create(HInstance, 'SPLASH', RT_RCDATA);
    try
      // Wrap the VCL stream in a COM IStream
      StreamAdapter := TFixedStreamAdapter.Create(Stream);
      try
        // Create and load a GDI+ bitmap from the stream
        PNGBitmap := TGPBitmap.Create(StreamAdapter);
        try
          // Convert the PNG to a 32 bit bitmap
          PNGBitmap.GetHBITMAP(MakeColor(0,0,0,0), BitmapHandle);
          // Wrap the bitmap in a VCL TBitmap
          Bitmap.Handle := BitmapHandle;
        finally
          PNGBitmap.Free;
        end;
      finally
        StreamAdapter := nil;
      end;
    finally
      Stream.Free;
    end;

    ASSERT(Bitmap.PixelFormat = pf32bit, 'Wrong bitmap format - must be 32 bits/pixel');

    // Perform run-time premultiplication
    PremultiplyBitmap(Bitmap);


    // Resize form to fit bitmap
    ClientWidth := Bitmap.Width;
    ClientHeight := Bitmap.Height;

    // Position bitmap on form
    BitmapPos := Point(0, 0);
    BitmapSize.cx := Bitmap.Width;
    BitmapSize.cy := Bitmap.Height;

    // Setup alpha blending parameters
    BlendFunction.BlendOp := AC_SRC_OVER;
    BlendFunction.BlendFlags := 0;
    BlendFunction.SourceConstantAlpha := 0; // Start completely transparent
    BlendFunction.AlphaFormat := AC_SRC_ALPHA;

    Show;
    // ... and action!
    Ticks := 0;
    while (BlendFunction.SourceConstantAlpha < 255) do
    begin
      while (Ticks = GetTickCount) do
        Sleep(10); // Don't fade too fast
      Ticks := GetTickCount;
      inc(BlendFunction.SourceConstantAlpha,
        (255-BlendFunction.SourceConstantAlpha) div 32+1); // Fade in
      UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, Bitmap.Canvas.Handle,
        @BitmapPos, 0, @BlendFunction, ULW_ALPHA);
    end;
  finally
    Bitmap.Free;
  end;
  // Start timer to hide form after a short while
  TimerSplash.Enabled := True;
end;
{$endif}

{$ifdef PNG_GRAPHICEX}
// GraphicEx version
procedure TFormSplash.Execute;
var
  Ticks: DWORD;
  BlendFunction: TBlendFunction;
  BitmapPos: TPoint;
  BitmapSize: TSize;
  exStyle: DWORD;
  Bitmap: TBitmap;
  Stream: TStream;
begin
  // Enable window layering
  exStyle := GetWindowLongA(Handle, GWL_EXSTYLE);
  if (exStyle and WS_EX_LAYERED = 0) then
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);

  // Bitmap := TBitmap.Create;
  Bitmap := TPNGGraphic.Create;
  try
    // Bitmap.LoadFromFile('splash.bmp');
    Stream := TResourceStream.Create(HInstance, 'SPLASH', RT_RCDATA);
    try
      Bitmap.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;


    ASSERT(Bitmap.PixelFormat = pf32bit, 'Wrong bitmap format - must be 32 bits/pixel');

    // Perform run-time premultiplication
    PremultiplyBitmap(Bitmap);


    // Resize form to fit bitmap
    ClientWidth := Bitmap.Width;
    ClientHeight := Bitmap.Height;

    // Position bitmap on form
    BitmapPos := Point(0, 0);
    BitmapSize.cx := Bitmap.Width;
    BitmapSize.cy := Bitmap.Height;

    // Setup alpha blending parameters
    BlendFunction.BlendOp := AC_SRC_OVER;
    BlendFunction.BlendFlags := 0;
    BlendFunction.SourceConstantAlpha := 0; // Start completely transparent
    BlendFunction.AlphaFormat := AC_SRC_ALPHA;

    Show;
    // ... and action!
    Ticks := 0;
    while (BlendFunction.SourceConstantAlpha < 255) do
    begin
      while (Ticks = GetTickCount) do
        Sleep(10); // Don't fade too fast
      Ticks := GetTickCount;
      inc(BlendFunction.SourceConstantAlpha,
        (255-BlendFunction.SourceConstantAlpha) div 32+1); // Fade in
      UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, Bitmap.Canvas.Handle,
        @BitmapPos, 0, @BlendFunction, ULW_ALPHA);
    end;
  finally
    Bitmap.Free;
  end;
  // Start timer to hide form after a short while
  TimerSplash.Enabled := True;
end;
{$endif}

procedure TFormSplash.WMNCHitTest(var Message: TWMNCHitTest);
begin
  Message.Result := HTCAPTION;
end;

end.