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. |
Partager