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 Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
procedure aTraiterWH(sBitMap : TBitMap; dCanvas : TCanvas; aHeight,
aWidth : Integer; TraitG, TraitD, TraitH, TraitB : integer);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.aTraiterWH(sBitMap : TBitMap; dCanvas : TCanvas; aHeight,
aWidth : Integer; TraitG, TraitD, TraitH, TraitB : integer);
{Les TraitX sont comptés à partir des coins}
var
{Position des traits : Rappel HG -> (0,0)}
sPixG, sPixD, sPixH, sPixB : integer;
dPixG, dPixD, dPixH, dPixB : integer;
{Délimitations des rectangles}
sRectGH, sRectDH ,sRectGB, sRectDB, sRectH, sRectB, sRectG, sRectD, sRectC : TRect;
dRectGH, dRectDH ,dRectGB, dRectDB, dRectH, dRectB, dRectG, dRectD, dRectC : TRect;
{Variables Tmp}
sCanvas : TCanvas;
begin
{Le canevas source}
sCanvas := sBitMap.Canvas;
sPixG := TraitG -1;
sPixD := sCanvas.Width -TraitD;
sPixH := TraitH -1;
sPixB := sCanvas.height -TraitB;
{Les Rects}
with sCanvas do begin
{Les coins}
sRectGH := Rect(0, 0, sPixG , sPixH);
sRectDH := Rect(sPixD, 0, Width, sPixH);
sRectGB := Rect(0, sPixB, sPixG, Height);
sRectDB := Rect(sPixD, sPixB, Width, Height);
{Les bords}
sRectH := Rect(sPixG, 0, sPixD, sPixH);
sRectB := Rect(sPixG, sPixB, sPixD, Height);
sRectG := Rect(0, sPixH, sPixG, sPixB);
sRectD := Rect(sPixD, sPixH, Width, sPixB);
{Le centre}
sRectC := Rect(sPixG, sPixH, sPixD, sPixB);
end;
{Le canevas destination}
dCanvas.Rectangle(0, 0 , aWidth, aHeight);
dPixG := TraitG -1;
dPixD := dCanvas.Width -TraitD;
dpixH := TraitH -1;
dPixB := dCanvas.height -TraitB;
{Les Rects}
with dCanvas do begin
{Les coins}
dRectGH := Rect(0, 0, dPixG , dPixH);
dRectDH := Rect(dPixD, 0, Width, dPixH);
dRectGB := Rect(0, dPixB, dPixG, Height);
dRectDB := Rect(dPixD, dPixB, Width, Height);
{Les bords}
dRectH := Rect(dPixG, 0, dPixD, dPixH);
dRectB := Rect(dPixG, dPixB, dPixD, Height);
dRectG := Rect(0, dPixH, dPixG, dPixB);
dRectD := Rect(dPixD, dPixH, Width, dPixB);
{Le centre}
dRectC := Rect(dPixG, dPixH, dPixD, dPixB);
end;
{L'affectation au canevas de destination}
with dCanvas do begin
CopyRect(dRectGH, sCanvas, sRectGH );
CopyRect(dRectDH, sCanvas, sRectDH);
CopyRect(dRectGB, sCanvas, sRectGB);
CopyRect(dRectDB, sCanvas, sRectDB);
CopyRect(dRectH, sCanvas, sRectH);
CopyRect(dRectB, sCanvas, sRectB);
CopyRect(dRectG, sCanvas, sRectG);
CopyRect(dRectD, sCanvas, sRectD);
CopyRect(dRectC, sCanvas, sRectC);
end;
{2 problèmes :
Réaffectation obligatoire png ? Observation : il faut appeler plusieurs fois
la procedure si on utilise un png. Pourquoi ? Sinon la réaffectation utilisée
suffit. Autre méthode ?
Chevauchement des Rects ou copyRect. Normalement :
with sCanvas do begin
//Les coins
sRectGH := Rect(0, 0, sPixG , sPixH);
sRectDH := Rect(sPixD, 0, Width -1, sPixH);
sRectGB := Rect(0, sPixB, sPixB, Height -1);
sRectDB := Rect(sPixD, sPixB, Width -1, Height -1);
//Les bords
sRectH := Rect(sPixG +1, 0, sPixD -1, sPixH);
sRectB := Rect(sPixG +1, sPixH, spixD -1, Height-1);
sRectG := Rect(0, sPixH+1, sPixG, sPixB -1);
sRectD := Rect(sPixD, sPixH +1, Width -1, SPixB -1);
//Le centre
sRectC := Rect(sPixG +1, sPixH +1, sPixD -1, sPixB -1);
end;
Idem pou D or chevauchement incomplet. cause ? remède ?
}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
aTraiterWH(Image1.Picture.Bitmap, Image2.Canvas , Image2.Height, Image2.Width, 4, 4, 4, 4);
end;
end. |
