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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
| unit ControlSize;
{Модуль для пропорциональной подстройки размеров компонентов при изменении
размеров формы или другого компонента.
Производится подстройка ширины, высоты компонента и размера шрифта.
Размер шрифта подстраивается относительно высоты компонента.
Модуль содержит как отдельные процедуры, так и класс, можно выбрать наиболее
подходящий способ.
Процедурный вариант уже содержит всё необходимое для работы. При необходимости
можно использовать дополнительные массивы и работать с двумя и более формами и т.д.
Использование модуля:
uses ... ControlSize ...
procedure TForm1.FormCreate(Sender: TObject);
begin
AddControl(Label1, ClientWidth , ClientHeight);
AddControl(Button1, ClientWidth , ClientHeight);
AddControl(Button2, ClientWidth , ClientHeight);
// Вместо ClientWidth и ClientHeight можно использовать любые другие размеры,
// относительно которых необходимо выравнивать компоненты.
end;
procedure TForm1.FormResize(Sender: TObject);
begin
// Подстройка размеров компонентов.
// Если вместо ClientWidth и ClientHeight использованы иные значения при
// добавлении, компонентов, то и здесь нужно использовтаь их же.
AdjustControls(ClientWidth, ClientHeight);
end;
Использование объекта TComponentSize происходит по такому же принципу.
}
interface
uses Windows, Classes, Controls;
type
TKoef = record
kx, ky, kw, kh, kf: single;
end;
TKoefArray = array of TKoef;
TControlArray = array of TControl;
type
TComponentSize = class
private
FCtrls: array of TControl;
FKoefs: TKoefArray;
FCtrlCnt: integer;
procedure GetControlSize(Control: TControl; var ControlKoef: TKoef; cw, ch: integer);
procedure SetControlSize(Control: TControl; ControlKoef: TKoef; cw, ch: integer);
public
constructor Create;
procedure AddControl(Control: TControl; cw, ch: integer);
function RemoveControlFromList(Control: TControl): boolean;
procedure Clear;
procedure CountNewKoefficients(cw, ch: integer);
procedure AdjustControls(cw, ch: integer);
end;
// Добавить элемент управления в список
procedure AddControl(Control: TControl; var Controls: TControlArray; var Koefs: TKoefArray; cw, ch: integer); overload;
procedure AddControl(Control: TControl; cw, ch: integer); overload;
// Удалить элемент управления из списка
function RemoveControlFromList(Control: TControl; var Controls: TControlArray; var Koefs: TKoefArray): boolean; overload;
function RemoveControlFromList(Control: TControl): boolean; overload;
// Очистить список элементов управления
procedure ClearControlList(Controls: TControlArray; Koefs: TKoefArray); overload;
procedure ClearControlList; overload;
// Вычислить новые коэффициенты размеров компонентов
procedure CountNewKoefficients(Controls: TControlArray; var Koefs: TKoefArray; cw, ch: integer); overload;
procedure CountNewKoefficients(cw, ch: integer); overload;
// Подстроить размеры компонентов
procedure AdjustControls(Controls: TControlArray; Koefs: TKoefArray; cw, ch: integer); overload;
procedure AdjustControls(cw, ch: integer); overload;
implementation
type
TMyControl = class(Controls.TControl)
published
property Font;
end;
var
KoefAr: TKoefArray;
CtrlAr: TControlArray;
procedure GetControlSize(Control: TControl; var ControlKoef: TKoef; cw, ch: integer);
var
r1: TRect;
begin
r1 := Control.BoundsRect;
ControlKoef.kx := r1.Left /cw;
ControlKoef.kw := r1.Right /cw;
ControlKoef.ky := r1.Top /ch;
ControlKoef.kh := r1.Bottom/ch;
ControlKoef.kf := TMyControl(Control).Font.Size/ch;
end;
procedure SetControlSize(Control: TControl; ControlKoef: TKoef; cw, ch: integer);
begin
Control.BoundsRect := Rect(Round(ControlKoef.kx * cw), Round(ControlKoef.ky * ch),
Round(ControlKoef.kw * cw), Round(ControlKoef.kh * ch));
TMyControl(Control).Font.Size := Round(ControlKoef.kf * ch);
end;
procedure AddControl(Control: TControl; var Controls: TControlArray; var Koefs: TKoefArray; cw, ch: integer); overload;
var
CtrlCnt: integer;
begin
CtrlCnt := Length(CtrlAr)+1;
SetLength(Controls, CtrlCnt);
SetLength(Koefs, CtrlCnt);
Controls[CtrlCnt-1] := Control;
GetControlSize(Controls[CtrlCnt-1], Koefs[CtrlCnt-1], cw, ch);
end;
procedure AddControl(Control: TControl; cw, ch: integer); overload;
begin
AddControl(Control, CtrlAr, KoefAr, cw, ch);
end;
function RemoveControlFromList(Control: TControl; var Controls: TControlArray; var Koefs: TKoefArray): boolean; overload;
var
i, i2: integer;
CtrlCnt: integer;
begin
Result := false;
CtrlCnt := Length(Controls);
for i := 0 to CtrlCnt - 1 do
if Control = Controls[i] then begin // Если контрол найден, то удалить его
Result := true;
if i < CtrlCnt - 1 then begin
for i2 := i to CtrlCnt - 2 do begin
Controls[i2] := Controls[i2+1];
Koefs[i2] := Koefs[i2+1];
end;
end;
Dec(CtrlCnt);
SetLength(Controls, CtrlCnt);
SetLength(Koefs, CtrlCnt);
Break;
end;
end;
function RemoveControlFromList(Control: TControl): boolean; overload;
begin
Result := RemoveControlFromList(Control, CtrlAr, KoefAr);
end;
procedure ClearControlList(Controls: TControlArray; Koefs: TKoefArray); overload;
begin
SetLength(Controls, 0);
SetLength(Koefs, 0);
end;
procedure ClearControlList; overload;
begin
SetLength(CtrlAr, 0);
SetLength(KoefAr, 0);
end;
// Запомнить размеры из внешнего списка
procedure CountNewKoefficients(Controls: TControlArray; var Koefs: TKoefArray; cw, ch: integer); overload;
var
i: integer;
begin
for i := 0 to High(Controls) do
GetControlSize(Controls[i], Koefs[i], cw, ch);
end;
// Запомнить размеры из внутренего списка
procedure CountNewKoefficients(cw, ch: integer); overload;
begin
CountNewKoefficients(CtrlAr, KoefAr, cw, ch);
end;
// Установка размеров из внешнего списка
procedure AdjustControls(Controls: TControlArray; Koefs: TKoefArray; cw, ch: integer); overload;
var
i: integer;
begin
for i := 0 to High(Controls) do
SetControlSize(Controls[i], Koefs[i], cw, ch);
end;
// Установка размеров из внутреннего массива
procedure AdjustControls(cw, ch: integer); overload;
begin
AdjustControls(CtrlAr, KoefAr, cw, ch);
end;
{ TComponentPosition }
constructor TComponentSize.Create;
begin
inherited Create;
FCtrlCnt := 0;
end;
procedure TComponentSize.GetControlSize(Control: TControl; var ControlKoef: TKoef; cw, ch: integer);
var
r1: TRect;
begin
r1 := Control.BoundsRect;
ControlKoef.kx := r1.Left /cw;
ControlKoef.kw := r1.Right /cw;
ControlKoef.ky := r1.Top /ch;
ControlKoef.kh := r1.Bottom/ch;
ControlKoef.kf := TMyControl(Control).Font.Size/ch;
end;
procedure TComponentSize.SetControlSize(Control: TControl; ControlKoef: TKoef; cw, ch: integer);
begin
Control.BoundsRect := Rect(Round(ControlKoef.kx * cw), Round(ControlKoef.ky * ch),
Round(ControlKoef.kw * cw), Round(ControlKoef.kh * ch));
TMyControl(Control).Font.Size := Round(ControlKoef.kf * ch);
end;
procedure TComponentSize.AddControl(Control: TControl; cw, ch: integer);
begin
Inc(FCtrlCnt);
SetLength(FKoefs, FCtrlCnt);
SetLength(FCtrls, FCtrlCnt);
FCtrls[FCtrlCnt - 1] := Control;
GetControlSize(FCtrls[FCtrlCnt - 1], FKoefs[FCtrlCnt - 1], cw, ch);
end;
function TComponentSize.RemoveControlFromList(Control: TControl): boolean;
var
i, i2: integer;
begin
Result := false;
for i := 0 to FCtrlCnt - 1 do
if Control = FCtrls[i] then begin // Если контрол найден, то удалить его
Result := true;
if i < FCtrlCnt - 1 then begin
for i2 := i to FCtrlCnt - 2 do begin
FCtrls[i2] := FCtrls[i2+1];
FKoefs[i2] := FKoefs[i2+1];
end;
end;
Dec(FCtrlCnt);
SetLength(FKoefs, FCtrlCnt);
SetLength(FCtrls, FCtrlCnt);
Break;
end;
end;
procedure TComponentSize.Clear;
begin
FCtrlCnt := 0;
SetLength(FKoefs, FCtrlCnt);
SetLength(FCtrls, FCtrlCnt);
end;
procedure TComponentSize.CountNewKoefficients(cw, ch: integer);
var
i: integer;
begin
for i := 0 to High(FCtrls) do
GetControlSize(FCtrls[i], FKoefs[i], cw, ch);
end;
procedure TComponentSize.AdjustControls(cw, ch: integer);
var
i: integer;
begin
for i := 0 to High(FCtrls) do
SetControlSize(FCtrls[i], FKoefs[i], cw, ch);
end;
end. |
(
