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

interface

uses Windows, Classes, Forms, AHMSystemClass,AHMSystemConst;

type
  TAHMWipeType           = (wsFormTopBorder,wsFormBottomBorder,wsFormLeftBorder,wsFormRightBorder,
                            wsScreenTopBorder,wsScreenBottomBorder,wsScreenLeftBorder,
                            wsScreenRightBorder,wsFormTopLeft,wsFormBottomLeft,wsFormTopRight,
                            wsFormBottomRight,wsScreenTopLeft,wsScreenBottomLeft,wsScreenTopRight,
                            wsScreenBottomRight,wsFormMiddle,wsScreenMiddle,wsCustompoint);
  TAHMShowType           = (onAlways, onShow, onHide);
  TAHMOnGetPoints = procedure(Sender : TObject;var CustomLeft,CustomTop,CustomRight,CustomBottom: Integer) of Object;
  TAHMFormExplode = class(TAHMSystemsComponent)
  private
    FOnShowType : TAHMWipeType;
    FOnCloseType : TAHMWipeType;
    FNoOfSteps : Word;
    FOnGetPoints : TAHMOnGetPoints;
    FShowType: TAHMShowType;
    FCustomLeft: word;
    FCustomTop: word;
    FCustomWidth: word;
    FCustomHeight: word;
    OwnerOnShow: TNotifyEvent;
    OwnerOnPaint: TNotifyEvent;
    OwnerOnHide: TNotifyEvent;
    FDelay: Integer;
    procedure SetShow( Value: TAHMShowType );
  protected
    Explode: boolean;
    Dc : HDc;
    OldPen, NewPen : HPen;
    OldBrush, NewBrush : HBrush;
    OldROP : Integer;
    procedure MyOnShow(Sender: TObject);
    procedure MyOnPaint(Sender: TObject);
    procedure MyOnHide(Sender: TObject);
    procedure ShowForm( Dc: Hdc; Dest: TForm; Steps: Integer );
    procedure HideForm( Dc: Hdc; Dest: TForm; Steps: Integer );
  public
    constructor Create( AOwner: TComponent ); override;
    procedure GetSrect(var x,y,w,h : integer;ws : TAHMWipeType);
  published
    property NoOfSteps: Word read FNoOfSteps write FNoOfSteps default 40;
    property ShowType: TAHMShowType read FShowType write SetShow default onAlways;
    property Delay : Integer read FDelay write FDelay default 2;
    property OnShowType: TAHMWipeType read FOnShowType write FOnShowType default wsFormMiddle;
    property OnCloseType: TAHMWipeType read FOnCloseType write FOnCloseType default wsFormMiddle;
    property CustomLeft: Word read FCustomLeft write FCustomLeft default 0;
    property CustomTop: Word read FCustomTop write FCustomTop default 0;
    property CustomBottom: Word read FCustomHeight write FCustomHeight default 0;
    property CustomRight: Word read FCustomWidth write FCustomWidth default 0;
    property OnGetPoints : TAHMOnGetPoints read FOnGetPoints write FOnGetPoints;
  end;


implementation

constructor TAHMFormExplode.Create( AOwner: TComponent );
begin
  FNoOfSteps := 40;
  inherited Create( AOwner );
  FDelay:=2;
  FCustomLeft:=0;
  FCustomTop:=0;
  FCustomwidth:=0;
  FCustomheight:=0;
  FOnShowType:=wsFormMiddle;
  FOnCloseType:=wsFormMiddle;
  if (Owner is TCustomForm) then
  begin
    with TForm(Owner) do
    begin
      OwnerOnShow := OnShow;
      OnShow := MyOnShow;
      OwnerOnPaint := OnPaint;
      OnPaint := MyOnPaint;
      OwnerOnHide := OnHide;
      OnHide := MyOnHide;
    end;
    Explode := True;
  end else raise EAHMOwnerFormNeeded.Create(self.ClassName+ahmscownerform);
end;

procedure TAHMFormExplode.GetSrect(var x,y,w,h : integer;ws : TAHMWipeType);
var tf : TForm;
begin
  tf:=Owner as TForm;
  case ws of
    wsFormTopBorder :
    begin
      x:=tf.left;y:=tf.Top;w:=tf.left+tf.width;h:=tf.top;
    end;
    wsFormBottomBorder :
    begin
      x:=tf.left;y:=tf.top+tf.height;w:=tf.left+tf.width;h:=tf.top+tf.height;
    end;
    wsFormLeftBorder :
    begin
      x:=tf.left;y:=tf.top;w:=tf.left;h:=tf.top+tf.height;
    end;
    wsFormRightBorder :
    begin
      x:=tf.left+tf.width;y:=tf.top;w:=tf.left+tf.width;h:=tf.top+tf.height;
    end;
    wsScreenTopBorder :
    begin
      x:=0;y:=0;w:=Screen.width;h:=0;
    end;
    wsScreenBottomBorder :
    begin
      x:=0;y:=Screen.height;
      w:=Screen.width;h:=Screen.height;
    end;
    wsScreenLeftBorder :
    begin
      x:=0;y:=0;w:=0;h:=Screen.height;
    end;
    wsScreenRightBorder :
    begin
      x:=Screen.width;y:=0;
      w:=Screen.width;h:=Screen.height;
    end;
    wsFormTopLeft :
    begin
      x:=tf.left;y:=tf.top;w:=tf.left+5;h:=tf.top+5;
    end;
    wsFormBottomLeft :
    begin
      x:=tf.left;y:=tf.top+tf.height-5;w:=tf.left+5;h:=tf.top+tf.height;
    end;
    wsFormTopRight :
    begin
      x:=tf.left+tf.width;y:=tf.top;w:=tf.left+tf.width-5;h:=tf.top+5;
    end;
    wsFormBottomRight :
    begin
      x:=tf.left+tf.width;y:=tf.top+tf.height;
      w:=tf.left+tf.width-5;h:=tf.top+tf.height-5;
    end;
    wsScreenTopLeft :
    begin
      x:=0;y:=0;w:=5;h:=5;
    end;
    wsScreenBottomLeft :
    begin
      x:=0;y:=Screen.height-5;
      w:=5;h:=Screen.height;
    end;
    wsScreenTopRight :
    begin
      x:=Screen.width;y:=0;
      w:=Screen.width-5;h:=5;
    end;
    wsScreenBottomRight :
    begin
      x:=Screen.width;y:=Screen.height;
      w:=Screen.width-5;h:=Screen.height-5;
    end;
    wsFormMiddle :
    begin
      x:=Tf.left+round(Tf.width/2)-2;y:=Tf.top+round(Tf.height/2)-2;
      w:=Tf.left+round(Tf.width/2)+2;h:=Tf.top+round(Tf.height/2)+2;
    end;
    wsScreenMiddle :
    begin
      x:=round(Screen.width/2)-2;y:=round(Screen.height/2)-2;
      w:=round(Screen.width/2)+2;h:=round(Screen.height/2)+2;
    end;
    wsCustompoint :
    begin
      x:=CustomLeft;y:=CustomTop;
      w:=Customright;h:=CustomBottom;
    end
  end;
  if assigned(FOnGetPoints) then FOnGetPoints(self,x,y,w,h);
end;

procedure TAHMFormExplode.SetShow( Value: TAHMShowType );
begin
  if Value <> FShowType then FShowType := Value;
end;

procedure TAHMFormExplode.MyOnShow(Sender: TObject);
begin
  if ShowType in [onAlways, onShow] then
  begin
    If Explode then
    begin
      Dc := GetDc(0);
      NewPen := GetStockObject( BLACK_PEN );
      NewBrush := GetStockObject( NULL_BRUSH );
      OldPen := SelectObject( Dc, NewPen );
      OldBrush := SelectObject( Dc, NewBrush );
      OldROP := SetROP2(Dc, R2_NOTXORPEN);
      ShowForm( Dc,Owner as TForm, FNoOfSteps );
      SelectObject( Dc, OldPen );
      SelectObject( Dc, OldBrush );
      SetRop2( Dc, OldRop );
      ReleaseDC(0, Dc);
      Explode := False;
      with Owner as TForm do
      begin
        OnShow := OwnerOnShow;
        if Assigned(OnShow) then OwnerOnShow(Sender);
      end;
    end;
  end;
  Application.ProcessMessages;
end;

procedure TAHMFormExplode.MyOnPaint(Sender: TObject);
begin
  Explode := True;
  with Owner as Tform do
  begin
    OnPaint := OwnerOnPaint;
    If Assigned(OnPaint) then OwnerOnPaint(sender);
    Application.ProcessMessages;
    OwnerOnPaint := OnPaint;
    OnPaint := MyOnPaint;
    OwnerOnShow := OnShow;
    OnShow := MyOnShow;
    OwnerOnHide := OnHide;
    OnHide := MyOnHide;
  end;
end;

procedure TAHMFormExplode.MyOnHide(Sender: TObject);
begin
  if ShowType in [onAlways, onHide] then
  begin
    if Explode then
    begin
      Dc := GetDc(0);
      NewPen := GetStockObject( BLACK_PEN );
      NewBrush := GetStockObject( NULL_BRUSH );
      OldPen := SelectObject( Dc, NewPen );
      OldBrush := SelectObject( Dc, NewBrush );
      OldROP := SetROP2(Dc, R2_NOTXORPEN);
      HideForm( Dc, Owner as TForm, FNoOfSteps );
      SelectObject( Dc, OldPen );
      SelectObject( Dc, OldBrush );
      SetRop2( Dc, OldRop );
      ReleaseDC(0, Dc);
      Explode := False;
      Application.ProcessMessages;
      with Owner as TForm do
      begin
        OnHide := OwnerOnHide;
        if Assigned(OnHide) then OwnerOnHide(Sender);
      end;
    end;
  end;
  Application.ProcessMessages;
  Explode :=True;
end;

procedure TAHMFormExplode.ShowForm( Dc: Hdc; Dest: TForm; Steps: Integer );
var
  XEnd, YEnd, WEnd, HEnd : Integer;
  IncX, IncY, IncW, IncH : Integer;
  X, Y, W, H,k : Integer;
  count : integer;
begin
  If Steps = 0 then Steps := 1;
  GetsRect(x,y,w,h,FOnShowType);
  XEnd := Dest.Left;
  YEnd := Dest.Top;
  WEnd := Dest.Width + Dest.Left;
  HEnd := Dest.Height + Dest.Top;
  IncX := Trunc( (XEnd - X) / steps );
  IncY := Trunc( (YEnd - Y) / steps );
  IncW := Trunc( (WEnd - W) / steps );
  IncH := Trunc( (HEnd - H) / steps );
  For count := 0 to steps do
  begin
    For K:=0 to FDelay*10000 do;
    DrawFocusRect(DC,Rect(X, Y, W, H));
    X := X + IncX;
    Y := Y + IncY;
    W := W + IncW;
    H := H + IncH;
    Application.ProcessMessages;
  end;
  GetsRect(x,y,w,h,FOnShowType);
  For count := 0 to steps do
  begin
    For K:=0 to FDelay*10000 do;
    DrawFocusRect(DC,Rect(X, Y, W, H));
    X := X + IncX;
    Y := Y + IncY;
    W := W + IncW;
    H := H + IncH;
    Application.ProcessMessages;
  end;
  for k:=0 to 1 do
  DrawFocusRect(DC,Rect(XEnd, YEnd, WEnd, HEnd ));
end;

procedure TAHMFormExplode.HideForm( Dc: Hdc; Dest: TForm; Steps: Integer );
var
  XEnd, YEnd, WEnd, HEnd : Integer;
  XTemp, YTemp, WTemp, HTemp : Integer;
  IncX, IncY, IncW, IncH : Integer;
  X, Y,k, W, H : Integer;
  count : integer;
begin
  If Steps = 0 then Steps := 1;
  GetsRect(x,y,w,h,FOnCloseType);
  XTemp := Dest.Left;
  YTemp := Dest.Top;
  WTemp := Dest.Width + Dest.Left;
  HTemp := Dest.Height + Dest.Top;
  XEnd := XTemp;
  YEnd := YTemp;
  WEnd := WTemp;
  HEnd := HTemp;
  IncX := Trunc( (XEnd - X) / steps );
  IncY := Trunc( (YEnd - Y) / steps );
  IncW := Trunc( (WEnd - W) / steps );
  IncH := Trunc( (HEnd - H) / steps );
  For count := 0 to steps do
  begin
    For K:=0 to FDelay*10000 do;
    DrawFocusRect(DC,Rect(XEnd, YEnd, WEnd, HEnd ));
    XEnd := XEnd - IncX;
    YEnd := YEnd - IncY;
    WEnd := WEnd - IncW;
    HEnd := HEnd - IncH;
    Application.ProcessMessages;
  end;
  XEnd := XTemp;
  YEnd := YTemp;
  WEnd := WTemp;
  HEnd := HTemp;
  For count := 0 to steps do
  begin
    For K:=0 to FDelay*10000 do;
    DrawFocusRect(DC,Rect(XEnd, YEnd, WEnd, HEnd ));
    XEnd := XEnd - IncX;
    YEnd := YEnd - IncY;
    WEnd := WEnd - IncW;
    HEnd := HEnd - IncH;
    Application.ProcessMessages;
  end;
  for k:=0 to 1 do
  DrawFocusRect(DC,Rect(X, Y, W, H ));
end;


end.
