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
139
|
unit paint1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Button1: TButton;
procedure PaintBox1Paint(Sender: TObject);
procedure DessineFlaf(Dest:Tcanvas;x,y:integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure DessineFont(Dest:Tcanvas);
procedure FormCreate(Sender: TObject);
Procedure CalibrePas(X1,Y1:integer;var X:integer; var Y:integer);
private
{ Déclarations privées }
bouge:boolean;
OldX,OldY:integer;
Asauve:array[1..10] of TBitMap;
Apos:array[1..10] of Trect;
Indice:integer;
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.PaintBox1Paint(Sender: TObject);
Var Arect:Trect;
begin
Arect:=Rect(0,0,height,width);
PaintBox1.Canvas.Brush.color:=clblack;
PaintBox1.Canvas.fillrect(Arect);
DessineFont(paintbox1.Canvas);
end;
//-------------------------------------------------------------------------
procedure TForm1.DessineFont(Dest:Tcanvas);
Var i:integer;
SourceRect,DestRect:Trect;
begin
with dest do
begin
pen.Color:=cllime;
Pen.Width:=1;
for i:=1 to 7 do
begin
moveto(0,50*i);lineto(height,50*i);
moveto(50*i,0);lineto(50*i,height);
end;
end;
for i:=1 to 10 do
begin
SourceRect:=Apos[i];
DestRect:=Rect(0,0,30,30);
Paintbox1.canvas.CopyRect(SourceRect,Asauve[i].canvas,DestRect);
end;
end;
//-------------------------------------------------------------------------
procedure TForm1.DessineFlaf(Dest:Tcanvas;x,y:integer);
begin
with dest do
begin
Brush.Style:=BsClear;
Pen.Width:=3;
pen.Color:=clblack;
rectangle(oldX-10,oldY-10,oldX+10,oldY+10);
pen.Color:=clred;
rectangle(X-10,Y-10,X+10,Y+10);
OldX:=X;
OldY:=Y;
end;
end;
//-------------------------------------------------------------------------
Procedure TForm1.CalibrePas(X1,Y1:integer;var X:integer; var Y:integer);
var Dx,Dy:integer;
begin
dx:= X1 div 50;
dy:= Y1 div 50;
X:= Dx * 50 ;
Y:= Dy * 50 ;
end;
//-------------------------------------------------------------------------
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if bouge then
begin
CalibrePas(X,Y,X,Y);
DessineFont(paintbox1.Canvas);
DessineFlaf(paintbox1.Canvas,X,Y);
end;
end;
//-------------------------------------------------------------------------
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
bouge:=true;
end;
//-------------------------------------------------------------------------
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var SourceRect,DestRect:Trect;
begin
bouge:=false;
CalibrePas(X,Y,X,Y);
SourceRect:=Rect(0,0,30,30);
DestRect:=Rect(X-15,Y-15,X+15,Y+15);
if indice<10 then
begin
inc(indice);
Asauve[indice].Canvas.CopyRect(SourceRect,paintbox1.canvas,DestRect);
Apos[indice]:=DestRect;
end;
end;
//-------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
Indice:=1;
For i:=1 to 10 do
begin
Asauve[i]:=TBitmap.Create;
Asauve[i].Width:=30;
Asauve[i].Height:=30;
end;
end;
end. |
