(************************************************************************
*    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 AHMTPresentation;

interface
{$I AHM.INC}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls,AHMEnhancedClass,ComCtrls,AHMTBackground,
  AHMControls,AHMEnhancedConst;


type
   TAHMSlideeffects=(efRandom,efNone,efWipeTopToBottom,efWipeBottomToTop,efWipeLeftToRight,
                    efWipeRightToLeft,efStretchUp,efStretchDown,efStretchLeft,efStretchRight,
                    efCloseHorizontalCurtain,efOpenHorizontalCurtain,efCloseVerticalCurtain,
                    efOpenVerticalCurtain,efVerticalInterlace,efHorizontalInterlace,efLeftRightDoppel,
                    efTopBottomDoppel,efRightLeftDoppel,efBottomTopDoppel,efLeftRightDoppelInOut,
                    efTopBottomDoppelInOut,efRightLeftDoppelInOut,efBottomTopDoppelInOut,efLeftTopToRightBottomWipe,
                    efLeftBottomToRightTopWipe,efRightTopToLeftBottomWipe,efRightBottomToLeftTopWipe,
                    efLTRBClosingCurtain,efRTLBClosingCurtain,efQuadVerticalInterlace,efQuadHorizontalInterlace,
                    efDoppelVerticalInterlace,efDoppelHorizontalInterlace,efVerticalQuadUp,efVerticalDoppelDown,
                    efVeticalQuadDown,efVerticalDoppelUp,efWipeEffect1,efWipeEffect2,efWipeEffect3,efBitBlt,
                    efDripVertical,efDripHorizontal,efStepWipeVertical,efStepWipeHorizontal,efScreenOff,
                    efFadeDown,efWipeEffect4,efWipeEffect5,efWipeEffect6,efHorizontalQuadLeft,efHorizontalDoppelRight,
                    efHorizontalQuadRight,efHorizontalDoppelLeft);

                    TAHMPresentation = class;
  TAHMSlide = class(TCollectionItem)
  private
    fID : String;
    ftext : String;
    fstyle,feffect: Integer;
    fbitmap : TBitmap;
    FStretch: Boolean;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Bitmap : TBitmap read fbitmap write fbitmap stored true;
    property Style : Integer read fstyle write fstyle stored true;
    property Effect : Integer read feffect write feffect stored true;
    property Text : String read ftext write ftext stored true;
    Property ID : String read fid write fid stored true;
    Property Stretch : Boolean read FStretch write FStretch;
  end;

  TAHMSlides = class(TCollection)
  private
    FOwner : TComponent;
    fsel : integer;
    function GetItem(Index: Integer): TAHMSlide;
    procedure SetItem(Index: Integer; Value: TAHMSlide);
  protected
  public
    constructor Create(AOwner : TComponent);
    function Add: TAHMSlide;
    function Delete(number:integer):Boolean;
    procedure Move(fromslide,toslide:Integer);
    property Items[Index: Integer]: TAHMSlide read GetItem write SetItem; default;
    property SelectedItem : Integer read fsel write fsel;
    property TheOwner : TComponent read fowner;
  end;
  TAHMPresentation = class(TCustomLabel)
  private
    timtag : Integer;
    fslidedone : TNotifyEvent;
    floopdone : TNotifyevent;
    fasize : Boolean;
    FSlides: TAHMSlides;
    fspeed : integer;
    FAHMAboutStr : TAHMAboutEnhancedStr;
    floop : Boolean;
    ftim : TAHMEnhancedTimer32;
    f3D : TAHMFont3D;
    fback : TAHMBackground;
    fback2 : TAHMBackground;
    procedure SetBack(value : TAHMBackground);
    procedure SetBack2(value : TAHMBackground);
    procedure Set3D(Value: TAHMFont3D);
    procedure SetSlides(Value: TAHMSlides);
    procedure SetSpeed(value : Integer);
    procedure RunSlides(Sender : TObject);
  protected
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Paint; override;
    procedure LoopSlides;
    procedure DoOneSlide(which : Integer); virtual;
    procedure Stop;
  published
    property About : TAHMAboutEnhancedStr read FAHMAboutStr write FAHMAboutStr stored False;
    {$IFDEF AHMONLY4}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    {$ENDIF}
    property AutoSize read fasize default false;
    property Align;
    property Alignment;
    property Color;
    property Enabled;
    property FocusControl;
    property Slides: TAHMSlides read FSlides write SetSlides;
    property Speed: Integer read fspeed write Setspeed default 1000;
    property KeepLooping : Boolean read floop write floop default False;
    property Background : TAHMBackground read fback write Setback;
    property Font;
    property Font3D : TAHMFont3D read f3d write Set3D stored true;
    property FontBackground : TAHMBackground read fback2 write Setback2;
    property OnSlideDone : Tnotifyevent read fslidedone write fslidedone;
    property OnLoopDone : TNotifyEvent read floopdone write floopdone;
    property ShowHint;
    property Visible;
    property WordWrap;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDragDrop;
    property OnEndDrag;
    property OnStartDrag;
    property OnDragOver;
    property DragCursor;
    property DragMode;
    property ParentColor;
    property ParentFont;
    Property ShowAccelChar;
  end;
  TAHMFormSlide = class(TCustomControl)
  private
    IsDrawing : Boolean;
    OldParent : TWincontrol;
    Oldimage: TBitmap;
    IsInstance : Boolean;
    xCurrent : TForm;
    FSlideeffect: TAHMSlideeffects;
    Procedure SetSlideEffect(const Value : TAHMSlideeffects);
  protected
  public
    Procedure Show(const Value : Tform);
    Procedure ShowInstance(Value : TPersistentclass);
    Procedure Paint; override;
    Constructor Create(AOwner : TComponent); override;
    Destructor Destroy; override;
    property CurrentForm : TForm read XCurrent;
  published
    Property SlideEffect : TAHMSlideeffects read FSlideeffect write SetSlideeffect default efRandom;
    Property ShowHint;
    Property Visible;
    Property Align;
  end;

Procedure AHMPaintEffect(xeffect:Integer;xsrc,xdst:TCanvas;xw,xh : Integer);

implementation

constructor TAHMPresentation.Create(AOwner: TComponent );
begin
  fasize:=false;
  inherited create(AOwner);
  AutoSize:=false;
  randomize;
  Controlstyle:=ControlStyle-[csSetCaption];
  f3d:=TAHMFont3d.create(Self);
  fSlides:=TAHMSlides.create(self);
  ftim:=TAHMEnhancedTimer32.create;
  ftim.OnTimer:=RunSlides;
  timtag:=0;
  ftim.Interval:=1000;
  fspeed:=1000;
  ftim.enabled:=false;
end;

procedure TAHMPresentation.Loaded;
begin
  inherited Loaded;
end;

destructor TAHMPresentation.Destroy;
begin
  ftim.free;
  fSlides.free;
  if fback<>nil then fback.OList.remove(self);
  if fback2<>nil then fback2.OList.remove(self);
  F3d.free;
  inherited Destroy;
end;

constructor TAHMSlide.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  fbitmap:=TBitmap.create;
end;

procedure TAHMSlide.Assign(Source: TPersistent);
begin
  if Source is TAHMSlide then
  begin
    Bitmap.assign(TAHMSlide(Source).Bitmap);
    Style:=TAHMSlide(Source).Style;
    Effect:=TAHMSlide(Source).Effect;
    Text:=TAHMSlide(Source).Text;
    Id:=TAHMSlide(Source).Id;
    Exit;
  end;
  inherited Assign(Source);
end;

destructor TAHMSlide.Destroy;
begin
  fbitmap.free;
  inherited Destroy;
end;


constructor TAHMSlides.Create(AOwner : TComponent);
begin
  inherited Create(TAHMSlide);
  fowner := AOwner;
end;

function TAHMSlides.Add: TAHMSlide;
begin
  Result := TAHMSlide(inherited Add);
end;

function TAHMSlides.Delete(number:integer):Boolean;
var li : integer;
begin
  result:=true;
  items[number].free;
  if count>0 then
  for li:=0 to count-1 do
    self.items[li].Id:=ahmscslideed+inttostr(li);
end;

procedure TAHMSlides.Move(fromslide,toslide:Integer);
var tempslide : TAHMSlide;
    id,id2 : string;
begin
  Tempslide:=TAHMSlide.create(self);
  try
   Tempslide.assign(items[toslide]);
   id := items[fromslide].id;
   id2 := items[toslide].id;
   items[toslide].assign(items[fromslide]);
   items[fromslide].assign(tempslide);
   items[toslide].id:=id2;
   items[fromslide].id:=id;
  finally
    tempslide.free;
  end;
end;


function TAHMSlides.GetItem(Index: Integer): TAHMSlide;
begin
  Result := TAHMSlide(inherited GetItem(Index));
end;

procedure TAHMPresentation.LoopSlides;
begin
  ftim.enabled:=true;
end;

procedure TAHMPresentation.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and  (AComponent = Background) then SetBack(nil);
  if (Operation = opRemove) and  (AComponent = FontBackground) then SetBack2(nil);
end;

procedure TAHMPresentation.Setback(Value: TAHMBackground);
begin
  if fback<>nil then fback.OList.remove(self);
  if value<>nil then value.additem(self);
  fback:=value;
  invalidate;
end;

procedure TAHMPresentation.Setback2(Value: TAHMBackground);
begin
  if fback2<>nil then fback2.OList.remove(self);
  if value<>nil then value.additem(self);
  fback2:=value;
  invalidate;
end;

procedure TAHMPresentation.Set3D(Value: TAHMFont3D);
begin
  if value<>f3d then
  begin
    f3d:=value;
    invalidate;
  end;
end;

procedure TAHMPresentation.Paint;
var tt : TRect;
begin
  Tt:=clientrect;
  if assigned(fback) then fback.draw(canvas.Handle,width,height,true)
  else inherited paint;
end;

Procedure AHMPaintEffect(xeffect:integer;xsrc,xdst:tCanvas;xw,xh : integer);
const pin : array[0..8,0..1] of byte =((1,1),(1,0),(2,0),
                                       (2,1),(2,2),(1,2),
                                       (0,2),(0,1),(0,0));
var xrect,xrect2,xrect3 : trect;
    xx,yy,ww,hh,ii,jj,i2,j2 : integer;

Procedure DrawBox(x1,y1:integer);
var TheRect : TRect;
begin
  if x1>xw then x1:=xw;
  if y1>xh then y1:=xh;
  Therect:=rect(x1,y1,x1+1,y1+1);
  xdst.copyrect(Therect,xsrc,Therect);
  Application.Processmessages;
end;

Procedure StretchBox(x1,y1,w1,h1:integer);
var TheRect : TRect;
    xbitm : TBitmap;
begin
  if x1>xw then x1:=xw; if x1<0 then x1:=0;
  if y1>xh then y1:=xh; if y1<0 then y1:=0;
  if w1>xw then x1:=xw; if w1<0 then x1:=0;
  if h1>xh then y1:=xh; if h1<0 then y1:=0;
  xbitm := TBitmap.create;
  xbitm.width:=xw;
  xbitm.height:=xh;
  Therect:=rect(0,0,xw,xh);
  xbitm.canvas.Copyrect(Therect,xsrc,Therect);
  xdst.stretchdraw(rect(x1,y1,w1,h1),xbitm);
  xbitm.free;
  Application.Processmessages;
end;

function GetHorLine(bline:Integer): TRect;
begin
  if bline>xh then bline:=xh;
  result := Rect(0,bline,xw,bline-1);
end;

function GetVerLine(bline:Integer): TRect;
begin
  if bline>xw then bline:=xw;
  result := Rect(bline,0,bline-1,xh);
  Application.Processmessages;
end;

begin
  Randomize;
  Random(54);
  if xeffect=0 then xEffect:=Random(54)+1;
  xrect := xsrc.Cliprect;
  case xEffect of
    1 : xdst.CopyRect(xrect,xsrc,xrect);
    2 : for yy:=0 to xh do for xx:=0 to xw do DrawBox(xx,yy);
    3 : for yy:=xh downto 0 do for xx:=0 to xw do DrawBox(xx,yy);
    4 : for xx:=0 to xw do for yy:=0 to xh do DrawBox(xx,yy);
    5 : for xx:=xw downto 0 do for yy:=0 to xh do DrawBox(xx,yy);
    6 : begin
          yy:=0;
          hh:=(xh div 30);
          while yy<xh do
          begin
            StretchBox(0,xh-yy,xw,xh);
            Inc(YY,hh);
          end;
          xdst.CopyRect(xrect,xsrc,xrect);
        end;
    7 : begin
          yy:=0;
          hh:=(xh div 30);
          while yy<xh do
          begin
            StretchBox(0,0,xw,yy);
            Inc(YY,hh);
          end;
          xdst.CopyRect(xrect,xsrc,xrect);
        end;
    8 : begin
          xx:=0;
          hh:=(xw div 30);
          while xx<xw do
          begin
            StretchBox(xw-xx,0,xw,xh);
            Inc(XX,hh);
          end;
          xdst.CopyRect(xrect,xsrc,xrect);
        end;
    9 : begin
          xx:=0;
          hh:=(xw div 30);
          while xx<xw do
          begin
            StretchBox(0,0,xx,xh);
            Inc(XX,hh);
          end;
          xdst.CopyRect(xrect,xsrc,xrect);
        end;
    10: begin ww := round((xw+1)/2);
	  for xx:=0 to ww do begin
            for yy:=0 to xh do begin
              DrawBox(xw-xx,yy);  DrawBox(xx,yy);
          end; end; end;
    11: begin ww := round((xw+1)/2);
	  for xx:=ww downto 0 do begin
            for yy:=0 to xh do begin
              DrawBox(xx,yy); DrawBox(xw-xx,yy);
          end; end; end;
    12: begin
          hh := round((xh+1)/2); for yy:=0 to hh do
          begin for xx:=0 to xw do
            begin DrawBox(xx,yy); DrawBox(xx,xh-yy);
          end; end; end;
    13: begin
          hh := round((xh+1)/2);
    	  for yy:=hh downto 0 do
          begin
            for xx:=0 to xw do
            begin
              DrawBox(xx,yy);
              DrawBox(xx,xh-yy);
            end;
	  end;
    	end;
    14: begin
	  for xx:=0 to xw do
          begin
            ww:= xw-xx;
	    yy:= 0;
            while yy<=xh do
            begin
              DrawBox(xx,yy-1);
              if yy<xh then DrawBox(ww,yy);
              inc(yy,2);
            end;
          end;
    	end;
    15: begin
	  for yy:=0 to xh do
          begin
            hh:= xh-yy;
	    xx:= 0;
            while xx<=xw do
            begin
              DrawBox(xx-1,yy);
              if xx<xw then DrawBox(xx,hh);
              inc(xx,2);
            end;
          end;
    	end;
    16: begin
	  for hh:=0 to 1 do
          begin
	    for xx:=0 to xw do
            begin
              yy:=hh;
    	      while yy<=xh do
              begin
        	DrawBox(xx,yy);
		inc(yy,2);
              end;
            end;
          end;
    	end;
    17: begin
	  for ww:=0 to 1 do
          begin
	    for yy:=0 to xh do
            begin
              xx:=ww;
    	      while xx<=xw do
              begin
        	DrawBox(xx,yy);
		inc(xx,2);
              end;
            end;
          end;
    	end;
    18: begin
	  for hh:=0 to 1 do
          begin
	    for xx:=xw downto 0 do
            begin
              yy:=hh;
    	      while yy<=xh do
              begin
        	DrawBox(xx,yy);
		inc(yy,2);
              end;
            end;
          end;
    	end;
    19: begin
	  for ww:=0 to 1 do
          begin
	    for yy:=xh downto 0 do
            begin
              xx:=ww;
    	      while xx<=xw do
              begin
        	DrawBox(xx,yy);
		inc(xx,2);
              end;
            end;
          end;
    	end;
    20: begin
    	  for xx:=0 to xw do
          begin
    	    yy := 1;
	    while yy<=xh do
            begin
              DrawBox(xx,yy);
	      inc(yy,2);
            end;
	  end;
	  for xx:=xw downto 0 do
          begin
    	    yy := 0;
	    while yy<=xh do
            begin
              DrawBox (xx,yy);
	      inc(yy,2);
            end;
          end;
    	end;
    21: begin
    	  for yy:=0 to xh do
          begin
    	    xx := 1;
	    while xx<=xw do
            begin
              DrawBox(xx,yy);
	      inc(xx,2);
            end;
	  end;
	  for yy:=xh downto 0 do
          begin
    	    xx := 0;
	    while xx<=xw do
            begin
              DrawBox (xx,yy);
	      inc(xx,2);
            end;
          end;
    	end;
    22: begin
    	  for xx:=xw downto 0 do
          begin
    	    yy := 1;
	    while yy<=xh do
            begin
              DrawBox(xx,yy);
	      inc(yy,2);
            end;
	  end;
	  for xx:=0 to xw do
          begin
    	    yy := 0;
	    while yy<=xh do
            begin
              DrawBox (xx,yy);
	      inc(yy,2);
            end;
          end;
    	end;
    23: begin
    	  for yy:=xh downto 0 do
          begin
    	    xx := 1;
	    while xx<=xw do
            begin
              DrawBox(xx,yy);
	      inc(xx,2);
            end;
	  end;
	  for yy:=0 to xh do
          begin
    	    xx := 0;
	    while xx<=xw do
            begin
              DrawBox (xx,yy);
	      inc(xx,2);
            end;
          end;
    	end;
    24: begin
    	  ww:=0; hh:=0;
    	  while (ww<xw) or (hh<xh) do
          begin
    	    inc(ww);
            if ww>xw then
            begin
              ww:=xw;
              if hh<xh then inc(hh);
            end;
    	    xx:=ww; yy:=hh;
            while not((xx<0) or (yy>xh) or (xx>xw)) do
            begin
              DrawBox(xx,yy);
              dec(xx); inc(yy);
            end;
          end;
    	end;
    25: begin
    	  ww:=0; hh:=xh;
    	  while (ww<xw) or (hh>0) do
          begin
    	    inc(ww);
            if ww>xw then
            begin
              ww:=xw;
              if hh>0 then dec(hh);
            end;
    	    xx:=ww; yy:=hh;
            while not((xx<0) or (yy<0) or (xx>xw)) do
            begin
              DrawBox(xx,yy);
              dec(xx); dec(yy);
            end;
          end;
    	end;
    26: begin
    	  ww:=xw; hh:=0;
    	  while (ww>0) or (hh<xh) do
          begin
    	    dec(ww);
            if ww<0 then
            begin
              ww:=0;
              if hh<xh then inc(hh);
            end;
    	    xx:=ww; yy:=hh;
            while not((xx<0) or (yy>xh) or (xx>xw)) do
            begin
              DrawBox(xx,yy);
              inc(xx); inc(yy);
            end;
          end;
    	end;
    27: begin
    	  ww:=xw; hh:=xh;
    	  while (ww>0) or (hh>0) do
          begin
    	    dec(ww);
            if ww<0 then
            begin
              ww:=0;
              if hh>0 then dec(hh);
            end;
    	    xx:=ww; yy:=hh;
            while not((xx<0) or (yy<0) or (xx>xw)) do
            begin
              DrawBox(xx,yy);
              inc(xx); dec(yy);
            end;
          end;
    	end;
    28: begin
    	  ww:=0; hh:=0; xx:=xw; yy:=xh;
    	  while ((ww<xw) or (hh<xh)) and ((xx>0) or (yy>0)) do
          begin
	    inc(ww); dec(yy);
            if ww>xw then
            begin
	      ww:=xw;
              if hh<xh then inc(hh);
            end;
	    if yy<0 then
            begin
              yy:=0;
	      if xx>0 then dec(xx);
            end;
	    ii:=ww; jj:=hh;
            while true do
            begin
	      DrawBox(ii,jj);
              dec(ii); inc(jj);
	      if (ii<0) or (jj>xh) or (ii>xw) then break;
            end;
	    ii:=xx; jj:=yy;
	    while true do
            begin
              DrawBox(ii,jj);
	      dec(ii); inc(jj);
              if (jj>xh) or (ii<0) or (jj<0) then break;
	    end;
          end;
    	end;
    29: begin
    	  ww:=xw; hh:=0; xx:=0; yy:=xh;
	  while ((ww>0) or (hh<xh)) and ((xx<xw) or (yy<0)) do
	  begin
	    dec(ww);
            if ww<0 then
            begin
	      ww:=0;
              if hh<xh then inc(hh);
	    end;
	    dec(yy);
	    if yy<0 then
            begin
              yy:=0;
	      if xx<xw then inc(xx);
            end;
	    ii:=ww; jj:=hh;
	    while true do
            begin
              DrawBox(ii,jj);
	      inc(ii); inc(jj);
              if (jj>xh) or (ii<0) or (ii>xw) then break;
	    end;
	    ii:=xx; jj:=yy;
            while true do
            begin
	      DrawBox(ii,jj);
              inc(ii); inc(jj);
	      if (jj>xh) or (jj<0) or (ii>xw) then break;
            end;
          end;
    	end;
    30: begin
    	   i2 := round((xw+1)/4);
           for ii:=0 to xh do
           begin
             for jj:=0 to i2 do
             begin
	       DrawBox(jj,ii);
               DrawBox(i2+jj,(xh)-ii);
               DrawBox((i2*2)+jj,ii);
               DrawBox((i2*3)+jj,(xh-1)-ii);
	     end;
           end;
         end;
    31: begin
	  i2:=round((xh+1)/4);
	  for ii:=0 to xw do
          begin
    	    for jj:=0 to i2 do
            begin
	      DrawBox(ii,jj);
              DrawBox((xw)-ii,i2+jj);
              DrawBox(ii,(i2*2)+jj);
              DrawBox((xw)-ii,(i2*3)+jj);
            end;
          end;
    	end;
    32: begin
    	  i2:=round((xw+1)/2);
          for ii:=0 to xh do
          begin
    	    for jj:=0 to i2 do
            begin
	      DrawBox(jj,ii);
              DrawBox(i2+jj,(xh)-ii);
            end;
          end;
    	end;
    33: begin
	  i2:=round((xh+1)/2);
          for ii:=0 to xw do
          begin
    	    for jj:=0 to i2 do
            begin
	      DrawBox(ii,jj);
              DrawBox((xw)-ii,i2+jj);
            end;
          end;
    	end;
    34: begin
	  i2:=round((xw+1)/2);
          j2:= round((xh+1)/2);
	  for ii:=0 to j2 do
          begin
    	    for jj:=0 to i2 do
            begin
	      DrawBox(jj,ii);
              DrawBox(jj,j2+ii);
              DrawBox(i2+jj,(xh)-ii-j2);
              DrawBox(i2+jj,(xh)-ii);
            end;
          end;
    	end;
    35: begin
	  i2:=round((xw+1)/2);
          j2:= round((xh+1)/2);
	  for ii:=0 to j2 do
          begin
    	    for jj:=0 to i2 do
            begin
	      DrawBox(jj,ii);
              DrawBox(i2+jj,ii);
              DrawBox((xw)-jj-i2,j2+ii);
              DrawBox((xw)-jj,j2+ii);
            end;
          end;
    	end;
    36: begin
	  i2:=round((xw+1)/2);
          j2:= round((xh+1)/2);
	  for ii:=j2 downto 0 do
          begin
    	    for jj:=i2 downto 0 do
            begin
	      DrawBox(jj,ii);
              DrawBox(jj,j2+ii);
              DrawBox(i2+jj,(xh)-ii-j2);
              DrawBox(i2+jj,(xh)-ii);
            end;
          end;
    	end;
    37: begin
	  i2:=round((xw+1)/2);
          j2:= round((xh+1)/2);
	  for ii:=j2 downto 0 do
          begin
    	    for jj:=i2 downto 0 do
            begin
	      DrawBox(jj,ii);
              DrawBox(i2+jj,ii);
              DrawBox((xw)-jj-i2,j2+ii);
              DrawBox((xw)-jj,j2+ii);
            end;
          end;
    	end;
    38: begin
	  j2 := round((xh+1)/3);
	  yy := j2*2;
          i2 := round((xw+1)/2);
          for ii:=0 to i2 do
          begin
    	    for jj:=j2 to yy do
            begin
	      DrawBox(i2-ii,jj);
              DrawBox(i2+ii,jj);
            end;
	  end;
	  for ii:=0 to j2 do
          begin
    	    for jj:=0 to xw do
            begin
	      DrawBox(jj,j2-1-ii);
              DrawBox(jj,yy+ii-1);
            end;
          end;
    	end;
    39: begin
	  j2 := round((xh+1)/3);
	  yy := j2*2;
          i2 := round((xw+1)/2);
          for ii:=i2 downto 0 do
          begin
    	    for jj:=j2 to yy do
            begin
	      DrawBox(i2-ii,jj);
              DrawBox(i2+ii,jj);
            end;
	  end;
	  for ii:=0 to j2 do
          begin
    	    for jj:=0 to xw do
            begin
	      DrawBox(jj,j2-1-ii);
              DrawBox(jj,yy+ii-1);
            end;
          end;
    	end;
    40: begin
	  j2 := round((xh+1)/3);
	  yy := j2*2;
          i2 := round((xw+1)/2);
          for ii:=i2 downto 0 do
          begin
    	    for jj:=j2 to yy do
            begin
	      DrawBox(i2-ii,jj);
              DrawBox(i2+ii,jj);
            end;
	  end;
	  for ii:=j2 downto 0 do
          begin
    	    for jj:=0 to xw do
            begin
	      DrawBox(jj,j2-1-ii);
              DrawBox(jj,yy+ii-1);
            end;
          end;
    	end;
    41: begin
	  for hh:=0 to 8 do
          begin
	    ii:=pin[hh,0];
            while ii<=xw do
            begin
	      jj:=pin[hh,1];
              while jj<=xh do
              begin
            	DrawBox(ii,jj);
                inc(jj,3);
              end;
	      inc(ii,3);
            end;
          end;
    	end;
    42: begin
          for ii:=xh downto 0 do
          begin
	    xrect2 := GetHorLine(ii);
            Application.ProcessMessages;
            for hh:=0 to ii do
            begin
              xrect3 := GetHorLine(hh);
	      xdst.CopyRect(xrect3,xsrc,xrect2);
            end;
          end;
    	end;
    43: begin
          for ii:=xw downto 0 do
          begin
	    xrect2 := GetVerLine(ii);
            Application.ProcessMessages;
            for hh:=0 to ii do
            begin
              xrect3 := GetVerLine(hh);
	      xdst.CopyRect(xrect3,xsrc,xrect2);
            end;
          end;
    	end;
    44: begin
          for ii:=0 to 1 do
          begin
            xx := ii;
            while xx<=xw do
            begin
    	      if (xx mod 2)=1 then for yy:=0 to xh do DrawBox(xx,yy)
                 else for yy:=xh downto 0 do DrawBox(xx,yy);
                 inc(xx,2);
            end;
          end;
        end;
    45: begin
          for ii:=0 to 1 do
          begin
            yy := ii;
            while yy<=xh do
            begin
    	      if (yy mod 2)=1 then for xx:=0 to xw do DrawBox(xx,yy)
                 else for xx:=xw downto 0 do DrawBox(xx,yy);
                 inc(yy,2);
            end;
          end;
        end;
    46: begin
	  ww:=0; hh:=0; xx:=xw; yy:=xh;
	  while ww<xx do
          begin
    	    for i2:=ww to xx do DrawBox(i2,hh);
	    for i2:=hh to yy do DrawBox(xx,i2);
            for i2:=xx downto ww do DrawBox(i2,yy);
	    for i2:=yy downto hh do DrawBox(ww,i2);
            inc(ww); inc(hh); dec(xx); dec(yy);
          end;
    	end;
    47: begin
	  for hh:=0 to 1 do
          begin
	    jj:=0;
            while jj<=xh do
            begin
	      ii:=(jj mod 2)+hh;
              while ii<=xw do
              begin
		DrawBox(ii,jj);
                inc(ii,2);
              end;
              inc(jj);
            end;
          end;
    	end;
    48: begin
	  j2 := round((xw+1)/3);
	  yy := j2*2;
          i2 := round((xh+1)/2);
          for ii:=0 to i2 do
          begin
    	    for jj:=j2 to yy do
            begin
	      DrawBox(jj,i2-ii);
              DrawBox(jj,i2+ii);
            end;
	  end;
	  for ii:=0 to j2 do
          begin
    	    for jj:=0 to xh do
            begin
	      DrawBox(j2-1-ii,jj);
              DrawBox(yy+ii-1,jj);
            end;
          end;
    	end;
    49: begin
	  j2 := round((xw+1)/3);
	  yy := j2*2;
          i2 := round((xh+1)/2);
          for ii:=i2 downto 0 do
          begin
    	    for jj:=j2 to yy do
            begin
	      DrawBox(jj,i2-ii);
              DrawBox(jj,i2+ii);
            end;
	  end;
	  for ii:=0 to j2 do
          begin
    	    for jj:=0 to xh do
            begin
	      DrawBox(j2-1-ii,jj);
              DrawBox(yy+ii-1,jj);
            end;
          end;
    	end;
    50: begin
	  j2 := round((xw+1)/3);
	  yy := j2*2;
          i2 := round((xh+1)/2);
          for ii:=i2 downto 0 do
          begin
    	    for jj:=j2 to yy do
            begin
	      DrawBox(jj,i2-ii);
              DrawBox(jj,i2+ii);
            end;
	  end;
	  for ii:=j2 downto 0 do
          begin
    	    for jj:=0 to xh do
            begin
	      DrawBox(j2-1-ii,jj);
              DrawBox(yy+ii-1,jj);
            end;
          end;
    	end;
    51: begin
	  i2:=Round((xh+1)/2);
          j2:= Round((xw+1)/2);
	  for ii:=0 to j2 do
          begin
    	    for jj:=0 to i2 do
            begin
	      DrawBox(ii,jj);
              DrawBox(j2+ii,jj);
              DrawBox((xw)-ii-j2,i2+jj);
              DrawBox((xw)-ii,i2+jj);
            end;
          end;
    	end;
    52: begin
	  i2:=Round((xh+1)/2);
          j2:= Round((xw+1)/2);
	  for ii:=0 to j2 do
          begin
    	    for jj:=0 to i2 do
            begin
	      DrawBox(ii,jj);
              DrawBox(ii,i2+jj);
              DrawBox(j2+ii,(xh)-jj-i2);
              DrawBox(j2+ii,(xh)-jj);
            end;
          end;
    	end;
    53: begin
	  i2:=Round((xh+1)/2);
          j2:= Round((xw+1)/2);
	  for ii:=j2 downto 0 do
          begin
    	    for jj:=i2 downto 0 do
            begin
	      DrawBox(ii,jj);
              DrawBox(j2+ii,jj);
              DrawBox((xw)-ii-j2,i2+jj);
              DrawBox((xw)-ii,i2+jj);
            end;
          end;
    	end;
    54: begin
	  i2:=Round((xh+1)/2);
          j2:= Round((xw+1)/2);
	  for ii:=j2 downto 0 do
          begin
    	    for jj:=i2 downto 0 do
            begin
	      DrawBox(ii,jj);
              DrawBox(ii,i2+jj);
              DrawBox(j2+ii,(xh)-jj-i2);
              DrawBox(j2+ii,(xh)-jj);
            end;
          end;
    	end;

  end;
end;

procedure TAHMPresentation.DoOneSlide(which : Integer);
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  TempRect:TRect;
  flags : Longint;
  xspec : TBitmap;
  xleft,xtop : integer;
begin
  TempRect:=Clientrect;
  flags:=DT_EXPANDTABS or DT_WORDBREAK or Alignments[Alignment];
  if (Slides.count>0) and (which<=slides.count) and (which>-1) then
  begin
    xspec:=TBitmap.create;
    try
      xspec.width:=self.width;
      xspec.height:=self.height;
      if assigned(fback) then fback.draw(xspec.canvas.Handle,width,height,true)
      else
      begin
        xspec.canvas.brush.color:=color; xspec.canvas.brush.style:=bssolid;
        fillrect(xspec.canvas.handle,rect(0,0,width,height),xspec.canvas.brush.handle);
      end;
      if Slides.items[which].style=1 then
      begin
        if assigned(FontBackground) then
           FontBackground.write(Font3D,self.Font,xspec.canvas,temprect,Slides.items[which].text,flags)
        else Font3D.write(Font,xspec.canvas.handle,temprect,Slides.items[which].text,flags,enabled);
      end
      else
      if Slides.items[which].style=2 then
      begin
        xtop:=round(height/2)-round(Slides.items[which].bitmap.height/2);
        xleft:=round(width/2)-round(Slides.items[which].bitmap.width/2);
        if xtop<0 then xtop:=0; if xleft<0 then xleft:=0;
        if Slides.items[which].Stretch then
           Stretchblt(xspec.canvas.handle,0,0,self.width,self.height,
           Slides.items[which].bitmap.canvas.handle,0,0,
           Slides.items[which].bitmap.width,
           Slides.items[which].bitmap.height,srccopy)
        else
           Bitblt(xspec.canvas.handle,xleft,xtop,width,height,
           Slides.items[which].bitmap.canvas.handle,0,0,srccopy);
      end;
      AHMPaintEffect(Slides.items[which].effect,xspec.canvas,Canvas,
                  width,height);
   finally
      xspec.free;
    end;
  end;
end;


procedure TAHMPresentation.RunSlides(Sender: TObject);
begin
  DoOneslide(timtag);
  if assigned(fslidedone) then fslidedone(self);
  if Slides.count-1>timtag then timtag:=timtag+1
  else
    begin
      timtag:=0;
      if floop=false then ftim.enabled:=false;
      if assigned(floopdone) then floopdone(self);
    end;
end;

procedure TAHMPresentation.Stop;
begin
  ftim.enabled:=false;
end;

procedure TAHMPresentation.SetSpeed(value : Integer);
begin
  if value>-1 then
  begin
    fspeed:=value;
    ftim.Interval:=value;
  end;
end;

procedure TAHMSlides.SetItem(Index: Integer; Value: TAHMSlide);
begin
  inherited SetItem(Index, Value);
end;

procedure TAHMPresentation.SetSlides(Value: TAHMSlides);
begin
  FSlides.Assign(Value);
end;


Procedure TAHMFormSlide.Paint;
begin
  if (csdesigning in Componentstate) then
  with Canvas do
  begin
    Pen.Style:= psDash;
    Pen.Color:= clBtnShadow;
    Pen.Mode:= pmCopy;
    Brush.style:=bsSolid;
    Brush.Color:=clbtnshadow;
    FillRect(Clientrect);
  end
  else
  begin
    if not(IsDrawing) then
    if (XCurrent<>nil) then self.canvas.draw(0,0,OldImage) else inherited;
  end;
end;

procedure TAHMFormSlide.ShowInstance(Value : TPersistentClass);
var OForm : Tform;
    OParent: TWinCOntrol;
begin
  if (Value<>nil) and ((TForm(Value))<>(XCurrent)) and not(IsDrawing) then
  begin
    OForm:=nil;
    OParent:=nil;
    IsDrawing:=true;
    if assigned(xcurrent) then
    begin
      OldImage.Free;
      OldImage:=TBitmap.Create;
      Oldimage.Width:=XCurrent.Width;
      OldImage.Height:=Xcurrent.height;
     {$IFDEF AHMINPRISE3}
      Oldimage.Canvas.Lock;
      try
        XCurrent.PaintTo(OldImage.Canvas.Handle,0,0);
      finally
        Oldimage.Canvas.Unlock;
      end;
      {$ELSE}
        XCurrent.PaintTo(XCurrent.Canvas.Handle,0,0);
        OldImage.Canvas.Copyrect(XCurrent.Clientrect,XCurrent.Canvas,XCurrent.Clientrect);
      {$ENDIF}
      self.canvas.draw(0,0,OldImage);
      begin
        OForm:=(XCurrent);
        OParent:=oldparent;
      end;
    end;
    XCurrent:=(TComponentClass(Value).Create(nil) as TForm);
    (XCurrent as TForm).BorderStyle:=bsNone;
    XCurrent.Width:=self.Width;
    XCurrent.Height:=self.Height;
    XCurrent.left:=XCurrent.left+screen.width;
    XCurrent.top:=XCurrent.top+screen.height;
    OldParent:=XCurrent.parent;
    XCurrent.parent:=self;
    try
      (XCurrent as TScrollingwincontrol).visible:=true;
      AHMPaintEffect(Integer(FSlideEffect),XCurrent.Getformimage.canvas,Canvas,width,height);
    finally
       MoveWindow(XCurrent.handle,0,0,xcurrent.width,xcurrent.height,False);
    end;
    If Assigned(OForm) then
    begin
      if IsInstance then OForm.free else
      begin
        (OForm as TScrollingwincontrol).visible:=false;
        OForm.parent:=oparent;
      end;
    end;
    IsInstance:=true; IsDrawing:=false;
  end;
end;


procedure TAHMFormSlide.Show(const Value : TForm);
var OForm : TForm;
    OParent: TWinCOntrol;
begin
  if (Value<>nil) and ((TForm(Value))<>(XCurrent)) and not(IsDrawing) then
  begin
    OForm:=nil;
    OParent:=nil;
    IsDrawing:=true;

    if assigned(xcurrent) then
    begin
      OldImage.Free;
      OldImage:=TBitmap.Create;
      Oldimage.Width:=XCurrent.Width;
      OldImage.Height:=Xcurrent.height;
     {$IFDEF AHMINPRISE3}
      Oldimage.Canvas.Lock;
      try
        XCurrent.PaintTo(OldImage.Canvas.Handle,0,0);
      finally
        Oldimage.Canvas.Unlock;
      end;
      {$ELSE}
        XCurrent.PaintTo(XCurrent.Canvas.Handle,0,0);
        OldImage.Canvas.Copyrect(XCurrent.Clientrect,XCurrent.Canvas,XCurrent.Clientrect);
      {$ENDIF}
      self.canvas.draw(0,0,OldImage);
      begin
        OForm:=(XCurrent);
        OParent:=oldparent;
      end;
    end;
    XCurrent:=Value;
    (XCurrent as TForm).BorderStyle:=bsNone;
    XCurrent.Width:=self.clientWidth;
    XCurrent.Height:=self.clientHeight;
    XCurrent.left:=XCurrent.left+screen.width;
    XCurrent.top:=XCurrent.top+screen.height;
    OldParent:=XCurrent.parent;
    XCurrent.parent:=self;
    try
      try
       (XCurrent as TScrollingwincontrol).visible:=true;
      finally
        AHMPaintEffect(Integer(FSlideEffect),XCurrent.GetFormImage.Canvas,Canvas,width,height);
      end;
    finally
      MoveWindow(XCurrent.handle,0,0,xcurrent.width,xcurrent.height,False);
    end;
    If Assigned(OForm) then
    begin
      if IsInstance then OForm.free else
      begin
        (OForm as TScrollingwincontrol).visible:=false;
        OForm.parent:=oparent;
      end;
    end;
    IsInstance:=false; IsDrawing:=false;
  end;
end;

Procedure TAHMFormSlide.SetSlideEffect(const Value : TAHMSlideeffects);
begin
  FSlideEffect:=Value;
end;

constructor TAHMFormSlide.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle:=ControlStyle-[csSetCaption];
  FSlideEffect:= efRandom;
  OldImage:=TBitmap.CReate;
end;

destructor TAHMFormSlide.Destroy;
begin
  OldImage.free;
  inherited Destroy;
end;

end.
