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
| private
{ private declarations }
tmpBmp: TBitmap;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
uses
LCLIntf, //GetTickCount
GraphUtil;
{$R *.lfm}
{ TForm1 }
const
ONE_OVER_MILLION = 1E-6; // micro
ONE_OVER_MILLIER = 1E-3; // milli
procedure TForm1.Button1Click(Sender: TObject);
var
StartTime, StopTime, Delta : QWord;
i: integer;
begin
DoubleBuffered := True;
StartTime := GetTickCount;
tmpBmp:= TBitmap.Create;
with tmpBmp do begin
PixelFormat := pf24bit;
SetSize(image1.Width, image1.Height);
end;
for i := 0 to 255 do begin
Application.ProcessMessages;
begin
GraphUtil.DrawVerticalGradient(tmpBmp.Canvas, image1.ClientRect, RGBtoColor(0,0,0), RGBtoColor(0,i,0));
image1.Canvas.Draw(0,0,tmpBmp);
Sleep(3);
end;
end;
StopTime := GetTickCount;
Delta := StopTime - StartTime;
Edit1.Text := FloatToStr(Delta * ONE_OVER_MILLIER) + ' microsecondes';
tmpBmp.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
StartTime, StopTime, Delta : QWord;
i: integer;
begin
// DoubleBuffered := True;
StartTime := GetTickCount;
tmpBmp:= TBitmap.Create;
with tmpBmp do begin
PixelFormat := pf24bit;
SetSize(PaintBox1.Width, PaintBox1.Height);
end;
for i := 0 to 255 do begin
Application.ProcessMessages;
begin / image1 gardé pour dimensions, paintbox1 ne connaît pas ClientRect
GraphUtil.DrawVerticalGradient(tmpBmp.Canvas, image1.ClientRect, RGBtoColor(0,0,0), RGBtoColor(0,i,0));
PaintBox1.Invalidate;
Sleep(3);
end;
end;
StopTime := GetTickCount;
Delta := StopTime - StartTime;
Edit2.Text := FloatToStr(Delta * ONE_OVER_MILLIER) + ' microsecondes';
// tmpBmp.Free; // AV garanti si décommenté malgré "if Assigned" plus loin...
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
try // protection inutile, AV quand même selon contexte...
// j'ai l'impression que ce if Assigned n'est pas fiable à 100 %
// déjà vécu des trucs tordus avec lui...
if Assigned(tmpBmp) then
PaintBox1.Canvas.Draw(0,0, tmpBmp);
finally
//
end;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if Assigned(tmpBmp) then
tmpBmp.Free;
end; |
Besoin d'éclaircissements sur le TImage (suite lecture Wiki)
Répondre avec citation
)
Envoyé par BeanzMaster
) et voilà un magnifique carré fuchsia. Alors le OnPaint... 
), et il me semblait que passer celle de la MainForm était suffisant (souvenir de Delphi ? Je la positionne systématiquement à partir du moment où j'utilise des images et des choses comme ça) mais non...
]) ; vous pouvez aller "espionner" avec un ColorPicker, il n'y a pas d'accroc ni de trou dans la map 
Partager