unit Transit;

{the much improved (and completely rewritten) version of the TTransitionEffect
Control. Makes animated bitmap transitions easey
created by Mathias Dellaert}

interface

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

type
  TTEAutoSize = (asFitWidth,asFitHeight,asFitBoth);
  TBGType = (btBitmap,btColor,btTransparant);
  {creating the transition Type}
  TTETransition = (StretchFromLeft,StretchFromRight,StretchFromTop,
     StretchFromBottom,StretchFromTopLeft,StretchFromBottomRight,
     StretchFromXcenter,StretchFromYcenter,PushFromBottom,PushFromLeft,
     PushFromRight,PushFromTop,
     SlideFromLeft,SlideFromRight,SlideFromTop,SlideFromBottom,
     SlideFromTopLeft,SlideFromBottomRight,Zoom);
  TTransitionEffect = class(TGraphicControl)
  private
    valAutoSize: TTEAutoSize;
    valBitmap, valBGBitmap: TBitmap;
    valCurrentstep, valSteps, valInterval: Integer;
    valBGColor: TColor;
    valBGType: TBGType;
    valTransition: TTETransition;
    valOnNotify, valOnLoad, valOnBStep, valOnAStep: TNotifyEvent;
    valSwap, valAutoSwap, valLoop, valPlaySound, blnFirstLoad: Boolean;
    valSoundFile: string;
    valLastError: String;
    sglGrowX, sglGrowY: single;
    tmrTimer: TTimer;
  protected
    {property setters}
    procedure setBitmap(V: TBitmap);
    procedure setBGBitmap(V: TBitmap);
    procedure setAutoSize(V: TTEAutoSize);
    procedure setInterval(V: integer);
    procedure setSteps(V: integer);
    procedure setSwap(V: boolean);
    {key procedures}
    procedure Paint; override;
    procedure itsTime(sender: TObject);
  public
    destructor Destroy; override;
    constructor Create(AOwner: TComponent);override;
    {Key procedures}
    procedure Go;
    procedure step;
    procedure stop;
    procedure swapNow;
    {public properties}
    property CurrentStep: integer read valCurrentStep write valCurrentStep;
    property LastError: string read valLastError write valLastError;
  published
    {BackGround properties}
    property BGBitmap: TBitmap read valBGBitmap write setBGBitmap;
    property BGColor: TColor read valBGColor write valBGColor;
    property BGType: TBGType read valBGType write valBGType;
    {other key properties}
    property Autosize: TTEAutoSize read valAutoSize write setAutoSize;
    property AutoSwap: Boolean read valAutoSwap write valAutoSwap;
    property Bitmap: TBitmap read valBitmap write setBitmap;
    property Interval: integer read valInterval write setInterval;
    property Loop: boolean read valLoop write valLoop;
    property PlaySound: boolean read valPlaySound write valPlaySound;
    property SoundFile: String read valSoundFile write valSoundFile;
    property Steps: integer read valSteps write setSteps;
    property Swap: boolean read valSwap write setSwap;
    property Transition: TTETransition read valTransition write valTransition;
    {regular properties}
    property Enabled;
    property Height default 160;
    property PopUpMenu;
    property ShowHint;
    property Visible;
    property Width default 240;
    {Events}
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnLoad: TNotifyEvent read valOnLoad write valOnLoad;
    property OnNotify: TNotifyEvent read valOnNotify Write valOnNotify;
    property OnBeforeStep: TNotifyEvent read valOnBStep Write valOnBStep;
    property OnAfterStep: TNotifyEvent read valOnAStep Write valOnAStep;
  end;

 TSoundFileProp = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('tanimation', [TTransitionEffect]);
  RegisterPropertyEditor(TypeInfo(String), TTransitionEffect, 'SoundFile', TSoundFileProp);
end;

constructor TTransitionEffect.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 valBitmap:= TBitmap.Create;
 valBGBitmap:= TBitmap.Create;
 setbounds(0,0,100,100);
 blnFirstLoad:=True;
 valLastError:='';
 valSteps:=10;
 valInterval:=100;
 {Create Timer}
 tmrTimer:= TTimer.Create(self);
 tmrTimer.Enabled:= False;
 tmrTimer.onTimer:= itsTime;
 tmrTimer.Interval:=valInterval;
end; {constructor}

destructor TTransitionEffect.Destroy;
begin
  valBitmap.free;
  valBGBitmap.free;
  tmrTimer.free;
  sndPlaySound(nil,SND_ASYNC); //stop sound playing
  inherited Destroy;
end; {destructor}

{key procedures}
procedure TTransitionEffect.Go;
Begin
try
 sglGrowX:=Width/valSteps;
 sglGrowY:=Height/valSteps;
 invalidate;
 tmrTimer.Interval:=valInterval;
 tmrTimer.Enabled:=True;
 if valPlaysound and (valSoundFile<>'') then begin
    sndPlaySound(NIL,SND_ASYNC);
    sndPlaySound(pchar(valSoundFile),SND_ASYNC+SND_LOOP); //starts the sound
   end; // if
except
 on EZeroDivide do Begin
  Stop;
  valSteps:= 10;
  Go;
  valLastError:='Invallid steps value: 0, set to 10';
 end; //on EZeroDivide
end; //Try ... Except
end; //Procedure Go

procedure TTransitionEffect.paint;
var
 sglTemp: Single;
begin
 {autosizing}
  if (valBGBitmap.empty=False) or (valBGBitmap.Height<>0) then
   begin
   {get width/height proportion}
    sglTemp:= valBGBitmap.Width/valBGBitmap.Height;
    if valAutoSize = asFitWidth then Height:=  Trunc(Width/sglTemp);
    if valAutoSize = asFitHeight then Width:=  Trunc(Height*sglTemp);
   end {if valBGBitmap.Empty = False}
  else
   LastError:='BGBitmap Empty or BGBitmap.height=0';
  {painting}
if (valBGBitmap.empty and (valBGType = btbitmap)) or (valBGType=btTransparant) then
  inherited Paint
 else
   if (valBGType = btColor) then begin
    Canvas.brush.color:=valBGColor;
    Canvas.Rectangle(-2,-2,Width+2,Height+2)
   end //end if valBGType = btColor
   else
    Canvas.CopyRect(clientRect,valBGBitmap.canvas,
      rect(0,0,valBGBitmap.Width,ValBGBitmap.Height));

{Draw if in desing mode}
if (csDesigning in ComponentState) then
 Begin
  Canvas.Pen.Style:= psDash;
  canvas.Brush.Style:=bsClear;
  canvas.Rectangle(0, 0, Width, Height);
  canvas.Brush.style:=bsSolid;
 end //if csDesinging
else
 if blnFirstLoad then
  begin
   if valSwap then swapNow;
   if assigned(onLoad) then onLoad(Self);
   blnFirstLoad:=False;
  end; //if blnFirstLoad
end; //procedure paint

procedure TTransitionEffect.Step;
 var
  intLeft, intRight, intTop, intBottom: integer;
begin
if assigned(valOnBStep) then valOnBStep(self);

//set defaults
intLeft:=0;
intRight:=Width;
intTop:=0;
intBottom:=Height;

if valBitmap.empty then begin
  Stop;
  valLastError:='Bitmap empty';
 end //if valBitmap.empty
else begin

//Set intLeft
case valTransition of
 SlideFromLeft,SlideFromTopLeft, PushFromLeft:
    intLeft:=  Trunc((sglGrowX*valCurrentStep)-width);
 StretchFromBottomRight, StretchFromRight, SlideFromRight,SlideFromBottomRight,
 PushFromRight:
    intLeft:=  Trunc(Width-(sglGrowX*valCurrentStep));
 Zoom, StretchFromXcenter:
    intLeft:=  Trunc((Width-(sglGrowX*valCurrentStep))/ 2);
 else
  intLeft:=0;
end; //Case

//set intRight
case valTransition of
 SlideFromRight,SlideFromBottomRight,PushFromRight:
   intRight:=  Trunc((width*2)-(sglGrowX*valCurrentStep));
 StretchFromLeft, StretchFromTopLeft, SlideFromLeft,SlideFromTopLeft,
 PushFromLeft:
   intRight:=  Trunc(sglGrowX*valCurrentStep);
 Zoom, StretchFromXcenter:
   intRight:=  intLeft + trunc(sglGrowX*valCurrentStep);
end; //Case

//set intTop
case valTransition of
 SlideFromTop,SlideFromTopLeft,PushFromTop:
   intTop:=Trunc((sglGrowY*valCurrentStep)-Height);
 StretchFromBottom, StretchFromBottomRight,SlideFromBottom,SlideFromBottomRight,
 PushFromBottom:
   intTop:=Trunc(Height-(sglGrowY*valCurrentStep));
 Zoom, StretchFromYcenter:
   intTop:=Trunc((Height-(sglGrowY*valCurrentStep))/ 2);
end; //Case

//set intBottom
case valTransition of
 SlideFromBottom,SlideFromBottomRight, PushFromBottom:
   intBottom:=Trunc((Height*2)-(sglGrowY*valCurrentStep));
 StretchFromTop, StretchFromTopLeft,SlideFromTop,SlideFromTopLeft,PushFromTop:
   intBottom:=Trunc(sglGrowY*valCurrentStep);
 Zoom, StretchFromYcenter:
   intBottom:=intTop+Trunc(sglGrowY*valCurrentstep);
end; //Case

//copy the Bitmap to the Canvas in the right rectangle
canvas.copyrect(rect(intLeft,intTop,intRight,intBottom),valBitmap.Canvas,
                rect(0,0,valBitmap.Width,valBitmap.Height));

//resolve 'pushing'
case  valTransition of
 PushFromBottom:
   Canvas.CopyRect(rect(0,intTop-Height,Width,intTop),valBGBitmap.Canvas,
                rect(0,0,valBGBitmap.Width,valBGBitmap.Height));
 PushFromLeft:
   Canvas.CopyRect(rect(intRight,0,intRight+Width,Height),valBGBitmap.Canvas,
                rect(0,0,valBGBitmap.Width,valBGBitmap.Height));
 PushFromRight:
   Canvas.CopyRect(rect(intLeft-Width,0,intLeft,Height),valBGBitmap.Canvas,
                rect(0,0,valBGBitmap.Width,valBGBitmap.Height));
 PushFromTop:
   Canvas.CopyRect(rect(0,intBottom,Width,intBottom+Height),valBGBitmap.Canvas,
                rect(0,0,valBGBitmap.Width,valBGBitmap.Height));
end; //Case

valCurrentstep:=valCurrentStep+1;

if assigned(valOnAStep) then valOnAStep(self);

if valCurrentStep>valSteps then begin
 if Loop then
  valCurrentStep:=1
 else Begin
  Stop;
  if assigned(OnNotify) then Onnotify(self);
 end; //If Loop ... else
 if valAutoSwap then Swap:= not Swap;
end; //if valcurrentstep>valsteps
end; //if valBitmap.empty...else
end; //procedure step

procedure TTransitionEffect.itsTime(Sender: TObject);
begin
 Step;
end;

procedure TTransitionEffect.Stop;
begin
 if valPlaysound and (valSoundFile<>'') then
     sndPlaySound(Nil,SND_ASYNC); //stops the sound
 tmrTimer.Enabled:=False; //disable the timer
 valCurrentStep:=0; //reset the animation
end;

procedure TTransitionEffect.SwapNow;
var
 bmpTemp: TBitmap;
begin
 bmpTemp:= TBitmap.Create;
try
 bmpTemp.Assign(valBitmap);
 valBitmap.Assign(valBGBitmap);
 valBGBitmap.Assign(bmpTemp);
 if valBgType=btBitmap then invalidate;
finally
 bmpTemp.Free;
end; //try...finally
end; //procedure swapnow

{property setters}
procedure TTransitionEffect.setBitmap(V: TBitmap);
begin
 try
  valBitmap.assign(V);
  invalidate;
 except
  on EInvalidGraphic do valLastError:='Invalid Bitmap for Bitmap';
 end; //try...except
end; {procedure}

procedure TTransitionEffect.setBGBitmap(V: TBitmap);
begin
 try
  valBGBitmap.assign(V);
  invalidate;
 except
  on EInvalidGraphic do valLastError:= 'invalid Bitmap for BGBitmap';
 end; //try...except
end; {procedure}

procedure TTransitionEffect.setAutoSize(V:TTEAutoSize);
Begin
 valAutoSize:=V;
 invalidate;
end; {procedure}

procedure TTransitionEffect.setSteps(V: Integer);
Begin
 if (V>0) and (V<Height) and (V<Width) then
  valSteps:= V
 else begin
  if (csDesigning in ComponentState) then
   Application.MessageBox('invalid Value, must be 0 < steps < Width and 0 < steps < Height',
     'ERROR', mb_OK+MB_ICONERROR);
   valLastError:='invalid Steps Value, must be 0 < steps < Width and 0 < steps < Height'
  end; //if (V>0) and (V<Height) and (V<Width)...else
end; {procedure}

procedure TTransitionEffect.setInterval(V: Integer);
Begin
 if V>0 then
  valInterval:= V
 else begin
  if (csDesigning in ComponentState) then
   Application.MessageBox('invalid Value, must be 0 < Interval',
     'ERROR', mb_OK+MB_ICONERROR);
   valLastError:='invalid Interval Value, must be 0 < Interval'
  end; //if V>0...else
end; {procedure}

procedure TTransitionEffect.setSwap(V: boolean);
Begin
 if (valSwap<>V) and (valBitmap.empty=False) and (valBGBitmap.empty=false) then begin
   swapNow;
   valSwap:=V;
 end; //if
end; //procedure setswap

{SoundFile Property Editor}

procedure TSoundFileProp.Edit;
var
  dlgFileOpen: TOpenDialog;
begin
  dlgFileOpen := TOpenDialog.Create(Application);
  with dlgFileOpen do Begin
   Filter := 'WaveForm Audio File (*.wav)|*.wav';
   Filename := GetValue;
   Options := dlgFileOpen.Options + [ofPathMustExist, ofFileMustExist];
  end;//with
  try
    if dlgFileOpen.Execute then SetValue(dlgFileOpen.Filename);
  finally
    dlgFileOpen.Free;
  end;
end;

function TSoundFileProp.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

end. {unit}