source: cprs/branches/tmg-cprs/TPNGGraphics/Example1/Showcase1Unit.pas@ 1742

Last change on this file since 1742 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 2.5 KB
Line 
1unit Showcase1Unit;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 pngimage, ExtCtrls;
8
9type
10 TForm1 = class(TForm)
11 Image1: TImage;
12 Explanation: TImage;
13 Image3: TImage;
14 Image6: TImage;
15 Image7: TImage;
16 Image8: TImage;
17 GoChangeColor: TImage;
18 moveball: TImage;
19 TimeCount: TTimer;
20 procedure GoChangeColorClick(Sender: TObject);
21 procedure TimeCountTimer(Sender: TObject);
22 private
23 { Private declarations }
24 public
25 constructor Create(AOwner: TComponent); override;
26 { Public declarations }
27 end;
28
29var
30 Form1: TForm1;
31
32implementation
33
34{$R *.DFM}
35
36constructor TForm1.Create(AOwner: TComponent);
37begin
38 inherited;
39 Randomize;
40 DoubleBuffered := TRUE;
41end;
42
43procedure TForm1.GoChangeColorClick(Sender: TObject);
44begin
45 {Don't map double-clicks}
46 TImage(Sender).ControlStyle := TImage(Sender).controlstyle - [csDoubleClicks];
47 {Change background color}
48 color := rgb(random(255), random(255), random(255));
49end;
50
51{Avaliable directions to the ball}
52const
53 LEFTTOP = 0;
54 LEFTBOTTOM = 1;
55 RIGHTTOP = 2;
56 RIGHTBOTTOM = 3;
57var
58 Direction: Integer = LEFTTOP;
59
60procedure TForm1.TimeCountTimer(Sender: TObject);
61const
62 MovePieces = 9;
63var
64 OldDirection, i: Integer;
65
66begin
67 {Move the ball this times}
68 FOR i := 1 TO MovePieces DO
69 with MoveBall do
70 begin
71 {Move according to the direction}
72 case Direction of
73 LEFTTOP: SetBounds(Left - 1, Top - 1, Width, Height);
74 LEFTBOTTOM: SetBounds(Left - 1, Top + 1, Width, Height);
75 RIGHTTOP: SetBounds(Left + 1, Top - 1, Width, Height);
76 RIGHTBOTTOM: SetBounds(Left + 1, Top + 1, Width, Height);
77 end {case Direction};
78
79 {Test for collision and if it happens, change direction}
80 OldDirection := Direction;
81 if Left <= 0 then
82 case Direction of
83 LEFTTOP: Direction := RIGHTTOP;
84 LEFTBOTTOM: Direction := RIGHTBOTTOM;
85 end
86 else if Top <= 0 then
87 case Direction of
88 LEFTTOP: Direction := LEFTBOTTOM;
89 RIGHTTOP: Direction := RIGHTBOTTOM;
90 end
91 else if Top + Height >= Self.ClientHeight then
92 case Direction of
93 LEFTBOTTOM: Direction := LEFTTOP;
94 RIGHTBOTTOM: Direction := RIGHTTOP;
95 end
96 else if Left + Width >= Self.ClientWidth then
97 case Direction of
98 RIGHTTOP: Direction := LEFTTOP;
99 RIGHTBOTTOM: Direction := LEFTBOTTOM;
100 end;
101 if OldDirection <> Direction then break;
102 end;
103
104end;
105
106end.
Note: See TracBrowser for help on using the repository browser.