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
140
141
142
143
144
145
146
147
148
149
150
151
|
unit Unit1;
{$mode objfpc}{$H+}
{Author: Mike Sapsard, 2015.
License: GPL3.
LCL demo of redraw event order for images, panels and forms. it should work
for all widget sets eg Windows, qt, OSX, GTK etc.
Repaint or Invalidate are not needed for resizing events.}
interface
uses
SysUtils, Forms, Graphics, ExtCtrls, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
CheckBoxImage: TCheckBox;
CheckBoxPanel: TCheckBox;
CheckBoxForm: TCheckBox;
Image1: TImage;
Memo1: TMemo;
Pnl1: TPanel;
Pnl2: TPanel;
PnlImage: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Image1Resize(Sender: TObject);
procedure PnlImageResize(Sender: TObject);
private
public
end;
var
Form1: TForm1;
Bitmap: TBitmap;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.DoubleBuffered := True; //Stop flickering on some widget sets
Bitmap := TBitmap.Create;
with Bitmap do
begin
// Use ClientWidth and ClientHeight so that code works across widget sets
// eg Windows, qt, OSX, GTK etc
// Height and Width do not allow for widget set and theme borders
Width := PnlImage.ClientWidth;
Height := PnlImage.ClientHeight;
Canvas.brush.color := clBlue;
Canvas.Rectangle(0, 0, Image1.ClientWidth, Image1.ClientHeight);
Canvas.Font.Size := 20;
Canvas.TextOut(15, 170, 'This is the Image');
end;
Image1.Picture.Graphic := Bitmap; //Assign the bitmap to Image1
Memo1.Clear;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
if CheckBoxForm.Checked then
begin
with Image1.Picture.Bitmap do
begin
// Bitmap has a height and width, but these do not change from default,
// because a copy is used by Image1.Picture.Bitmap
Image1.Picture.Bitmap.SetSize(Image1.ClientWidth, Image1.ClientHeight);
// If panel is green, this event was last
Canvas.Brush.Color := clGreen;
Canvas.Rectangle(0, 0, Image1.ClientWidth, Image1.ClientHeight);
Canvas.Font.Color := clYellow;
Canvas.Font.Size := 15;
Canvas.TextOut(10, 90, 'Form resized');
end;
Memo1.Lines.Add(IntToStr(Memo1.Lines.Count) + ' Form resized');
end;
if (Memo1.Lines.Count > 200) then
Memo1.Lines.Clear;
end;
procedure TForm1.Image1Resize(Sender: TObject);
begin
if CheckBoxImage.Checked then
begin
// Bitmap has a height and width, but these do not change from default,
// because a copy is used by Image1.Picture.Bitmap
Image1.Picture.Bitmap.SetSize(Image1.ClientWidth, Image1.ClientHeight);
with Image1.Picture.Bitmap do
begin
// If panel is white, this event was last
Canvas.Brush.Color := clWhite;
Canvas.Rectangle(0, 0, Image1.ClientWidth, Image1.ClientHeight);
Canvas.Font.Color := clGreen;
Canvas.Font.Size := 15;
Canvas.TextOut(10, 10, 'Image resized');
end;
Memo1.Lines.Add(IntToStr(Memo1.Lines.Count) + ' Image resize');
end;
if (Memo1.Lines.Count > 200) then
Memo1.Lines.Clear;
end;
procedure TForm1.PnlImageResize(Sender: TObject);
begin
if CheckBoxPanel.Checked then
begin
// Bitmap has a height and width, but these do not change from default,
// because a copy is used by Image1.Picture.Bitmap
Image1.Picture.Bitmap.SetSize(Image1.ClientWidth, Image1.ClientHeight);
with Image1.Picture.Bitmap do
begin
// If panel is red, this event was last
Canvas.Brush.Color := clRed;
Canvas.Rectangle(0, 0, Image1.ClientWidth, Image1.ClientHeight);
Canvas.Font.Color := clBlack;
Canvas.Font.Size := 15;
Canvas.TextOut(10, 50, 'Panel resized');
end;
Memo1.Lines.Add(IntToStr(Memo1.Lines.Count) + ' Panel resize');
end;
if (Memo1.Lines.Count > 200) then
Memo1.Lines.Clear;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction := caFree;
Bitmap.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
end;
end.
|
