1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
| unit Unit1;
interface
{
Démonstration de collision par Paul TOTH <tothpaul@free.fr>
le 1er mai 2011 pour le forum Developpez.com
}
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormResize(Sender: TObject);
private
{ Déclarations privées }
FBitmap : TBitmap;
FCollide: TBitmap;
FTest : TBitmap;
FPos : TPoint;
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Image de fond
FBitmap := TBitmap.Create;
// Masque de collision
FCollide := TBitmap.Create;
FCollide.PixelFormat := pf1bit;
FCollide.Canvas.Brush.Color := clBlack;
// Utilisé pour tester les collisions
FTest := TBitmap.Create;
FTest.Canvas.Pen.Color := clWhite;
end;
procedure TForm1.FormResize(Sender: TObject);
var
i, x, y, r: Integer;
begin
// force un clear du Bitmap
FBitmap.Height := 0;
// en blanc
FBitmap.Canvas.Brush.Color := clWhite;
// à la taille de l'écran
FBitmap.Width := ClientWidth;
FBitmap.Height := ClientHeight;
// idem pour le masque
FCollide.Height := 0;
FCollide.Canvas.Brush.Color := clWhite;
FCollide.Width := ClientWidth;
FCollide.Height := ClientHeight;
FCollide.Canvas.Brush.Color := clBlack;
// ajout de disques aléatoires
Randomize;
for i := 0 to 5 do
begin
x := Random(ClientWidth);
y := Random(ClientHeight div 2);
r := 40 + Random(30);
// en couleur pour l'écran
FBitmap.Canvas.Brush.Color := RGB(127 + Random(127), 127 + Random(127), 127 + Random(127));
FBitmap.Canvas.Ellipse(x - r, y - r, x + r, y + r);
// en noir pour le masque
FCollide.Canvas.Ellipse(x - r, y - r, x + r, y + r);
end;
// position initiale
FPos.X := ClientWidth div 2;
FPos.Y := ClientHeight div 2;
Invalidate;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
Test: Boolean;
begin
// copie du masque
FTest.Assign(FCollide);
// y dessiner le rectangle en blanc
FTest.Canvas.Rectangle(FPos.X - 20, FPos.Y - 25, FPos.X + 20, FPos.Y + 25);
// comparer les deux images
Test := CompareMem(
FCollide.ScanLine[FCollide.Height - 1],
FTest.ScanLine[FTest.Height - 1],
FTest.Height * ((FTest.Width + 7) div 8)
);
// afficher l'image de fond
Canvas.Draw(0, 0, FBitmap);
// choix de la couleur du rectangle selon la collission
if Test then
Canvas.Brush.Color := clGreen
else
Canvas.Brush.Color := clRed;
// dessin du rectangle
Canvas.Rectangle(FPos.X - 20, FPos.Y - 25, FPos.X + 20, FPos.Y + 25);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
const
K = 10;
begin
// déplacement au clavier, de 10 pixels sinon ça se traine
case Key of
VK_LEFT : Dec(FPos.X, K);
VK_RIGHT: Inc(FPos.X, K);
VK_UP : Dec(FPos.Y, K);
VK_DOWN : Inc(FPos.Y, K);
else exit;
end;
InvalidateRect(Handle, nil, False);
end;
end. |
Détection des collisions.
Répondre avec citation
Envoyé par Catastrophe
Il faut utiliser quelquechose de spécial pour les utilises ?
Partager