How to animate a window while opening a form

Problem/Question/Abstract:

How to animate a window while opening a form

Answer:

This project uses two forms:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormClick(Sender: TObject);
  private
    procedure FocusAnimation(DC: HDC; AnimRect: TRect; Steps, Speed, Direction: Integer);
  public
  end;

const
  FA_IN = 0;
  FA_OUT = 1;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.FormClick(Sender: TObject);
var
  WRect: TRect;
begin
  GetWindowRect(Form2.handle, WRect);
  FocusAnimation(GetDC(0), WRect, 20, 10, FA_OUT);
  {Open form2}
  Form2.ShowModal;
end;

procedure TForm1.FocusAnimation(DC: HDC; AnimRect: TRect; Steps, Speed, Direction: Integer);
var
  cv, animx, animy, animwidth, animheight: Integer;
  xp, yp: Double;
  FRect: TRect;
  cancel: Boolean;
begin
  {Steps = number of steps during open/close operation,
  Speed = time between the steps,
  Direction = inner/outer direction}
  animx := AnimRect.left + (AnimRect.right - AnimRect.left) div 2;
  animy := AnimRect.top + (AnimRect.bottom - AnimRect.top) div 2;
  animwidth := AnimRect.right - AnimRect.left;
  animheight := AnimRect.bottom - AnimRect.top;
  xp := animwidth div 2 / Steps; {horizontal}
  yp := animheight div 2 / Steps; {vertical}
  if Direction = FA_OUT then
    cv := 0
  else
    cv := Steps;
  while not cancel do
  begin
    FRect := Rect(Round(animx - cv * xp), Round(animy - cv * yp),
      Round(animx + cv * xp), Round(animy + cv * yp));
    DrawFocusRect(DC, FRect);
    Sleep(Speed);
    DrawFocusRect(DC, FRect);
    if Direction = FA_OUT then
    begin
      Inc(cv);
      if cv > Steps then
        cancel := True;
    end
    else
    begin
      Dec(cv);
      if cv < 0 then
        cancel := True;
    end;
  end;
end;

end.