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
136
137
138
| unit Udraw;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1Paint(Sender: TObject);
private
procedure dessinecurseur;
end;
Tcurseur = record
drawing : boolean; // en cours de déplacement
rr : trect; // rectangle position courante
rro : trect; // rectangle ancienne position
RECsprite : Trect; // le rectangle correspondant a BMPSprite
end;
var
Form1: TForm1;
H, W : integer; // hauteur et largeur de la paintbox
BmpFond : Tbitmap; // bitmap de fond
BmpMemoire : Tbitmap; // bitmap memoire pour preparation dessin a afficher
BMPsprite : Tbitmap; // le bitmap que je veux deplacer avec la souris
// et qui comporte dans son milieu de la couleur noire
// que je voudrais rendre transparente
cc : Tcurseur; // pour la gestion du bitmap BMPSprite
implementation
{$R *.DFM}
//------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
H := paintbox1.height;
W := paintbox1.width;
cc.drawing := false;
cc.rr := rect(50, 50, 150, 150); // definition d'un premier emplacement
// pour le nouveau rectangle
cc.rro := cc.rr; // position courante du spprite devient
// l'ancienne position
BmpFond := Tbitmap.create; // bitmap de fond
BmpFond.width := W;
BmpFond.height := H;
BmpFond.LoadFromFile('fond.bmp');// fond.bmp=500x333 16 millions couleurs
BmpMemoire := tbitmap.create;
BmpMemoire.assign(BmpFond); // copie de BmpFond sur BmpMemoire
BMPsprite := Tbitmap.Create;
BMPsprite.LoadFromFile('bitmap.bmp'); // chargement de l'image du sprite
BMPsprite.PixelFormat := pf32bit;
// c'est là que je determine la transparence mais cela ne marche pas.
// je voudrais que tout le noir de mon sprite devienne transparent
// j'ai fabriqué ce sprite avec image éditeur de delphi :
// bitmap.bmp = 100x100 256 couleurs
BMPsprite.Transparent := true;
BMPsprite.TransparentColor := rgb(0,0,0); // couleur noire
cc.RECsprite.Left := 0;
cc.RECsprite.Top := 0;
cc.RECsprite.Right := BMPsprite.Width;
cc.RECsprite.Bottom := BMPsprite.Height;
dessinecurseur; // affichage du premier sprite à la position de départ
end;
//------------------------------------------------------------
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
form1.paintbox1.Canvas.Draw(0,0,BmpMemoire);
end;
//------------------------------------------------------------
Procedure Tform1.dessinecurseur;
var
Runion: Trect;
begin
BmpMemoire.canvas.copyrect(cc.rro, BmpFond.canvas,cc.rro);
BmpMemoire.Canvas.CopyRect(cc.rr,BMPsprite.canvas,cc.RECsprite);
Unionrect(Runion, cc.rro, cc.rr);
form1.paintbox1.canvas.copyrect(Runion, BmpMemoire.canvas, Runion);
cc.rro := cc.rr;
end;
//------------------------------------------------------------
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var
p : tpoint;
begin
p.x := X; p.y := Y;
if ptinrect(cc.rr, p) then
begin
cc.drawing := true;
cc.rr := rect(x, y, x+100, y+100); //100 = largeur et hauteur de BMPSprite
end;
dessinecurseur;
end;
//------------------------------------------------------------
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
IF cc.drawing then
begin
cc.rr := rect(x, y, x+100, y+100);
dessinecurseur;
end;
end;
//------------------------------------------------------------
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IF cc.drawing then
begin
cc.rr := rect(x, y, x+100, y+100);
dessinecurseur;
cc.drawing := false;
end;
end;
//------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
BmpFond.free;
BmpMemoire.free;
BMPSprite.Free;
end;
end. |
