Author: Tomas Rutkauskas
How to animate a window while opening a form
Answer:
This project uses two forms:
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
7
8 type
9 TForm1 = class(TForm)
10 procedure FormClick(Sender: TObject);
11 private
12 procedure FocusAnimation(DC: HDC; AnimRect: TRect; Steps, Speed, Direction:
13 Integer);
14 public
15 end;
16
17 const
18 FA_IN = 0;
19 FA_OUT = 1;
20
21 var
22 Form1: TForm1;
23
24 implementation
25
26 uses Unit2;
27
28 {$R *.DFM}
29
30 procedure TForm1.FormClick(Sender: TObject);
31 var
32 WRect: TRect;
33 begin
34 GetWindowRect(Form2.handle, WRect);
35 FocusAnimation(GetDC(0), WRect, 20, 10, FA_OUT);
36 {Open form2}
37 Form2.ShowModal;
38 end;
39
40 procedure TForm1.FocusAnimation(DC: HDC; AnimRect: TRect; Steps, Speed, Direction:
41 Integer);
42 var
43 cv, animx, animy, animwidth, animheight: Integer;
44 xp, yp: Double;
45 FRect: TRect;
46 cancel: Boolean;
47 begin
48 {Steps = number of steps during open/close operation,
49 Speed = time between the steps,
50 Direction = inner/outer direction}
51 animx := AnimRect.left + (AnimRect.right - AnimRect.left) div 2;
52 animy := AnimRect.top + (AnimRect.bottom - AnimRect.top) div 2;
53 animwidth := AnimRect.right - AnimRect.left;
54 animheight := AnimRect.bottom - AnimRect.top;
55 xp := animwidth div 2 / Steps; {horizontal}
56 yp := animheight div 2 / Steps; {vertical}
57 if Direction = FA_OUT then
58 cv := 0
59 else
60 cv := Steps;
61 while not cancel do
62 begin
63 FRect := Rect(Round(animx - cv * xp), Round(animy - cv * yp),
64 Round(animx + cv * xp), Round(animy + cv * yp));
65 DrawFocusRect(DC, FRect);
66 Sleep(Speed);
67 DrawFocusRect(DC, FRect);
68 if Direction = FA_OUT then
69 begin
70 Inc(cv);
71 if cv > Steps then
72 cancel := True;
73 end
74 else
75 begin
76 Dec(cv);
77 if cv < 0 then
78 cancel := True;
79 end;
80 end;
81 end;
82
83 end.
|
