1{%MainUnit ../controls.pp}
2
3{******************************************************************************
4                                  TSizeConstraints
5
6  Simple class to hold size constraints for a control.
7 ******************************************************************************
8
9 *****************************************************************************
10  This file is part of the Lazarus Component Library (LCL)
11
12  See the file COPYING.modifiedLGPL.txt, included in this distribution,
13  for details about the license.
14 *****************************************************************************
15}
16{------------------------------------------------------------------------------
17  Method: TSizeConstraints.Create
18  Params:  AControl: the owner of the class
19  Returns: Nothing
20
21  Constructor for the class.
22 ------------------------------------------------------------------------------}
23constructor TSizeConstraints.Create(AControl : TControl);
24begin
25  inherited Create;
26  FControl:= AControl;
27
28  FMaxWidth:= 0;
29  FMaxHeight:= 0;
30  FMinWidth:= 0;
31  FMinHeight:= 0;
32  UpdateInterfaceConstraints;
33end;
34
35{------------------------------------------------------------------------------
36  procedure TSizeConstraints.UpdateInterfaceConstraints;
37
38  Asks interface for constraints.
39 ------------------------------------------------------------------------------}
40procedure TSizeConstraints.UpdateInterfaceConstraints;
41begin
42  if (Control is TWinControl) and TWinControl(Control).HandleAllocated then
43    TWSControlClass(Control.WidgetSetClass).GetConstraints(Control, Self);
44end;
45
46{------------------------------------------------------------------------------
47  procedure TSizeConstraints.SetInterfaceConstraints(MinW, MinH,
48    MaxW, MaxH: integer);
49
50  Used by the interface to set the interface constraints.
51  Should only be used by custom components, not by applications.
52 ------------------------------------------------------------------------------}
53procedure TSizeConstraints.SetInterfaceConstraints(MinW, MinH,
54  MaxW, MaxH: integer);
55begin
56  if (FMinInterfaceWidth=MinW)
57  and (FMinInterfaceHeight=MinH)
58  and (FMaxInterfaceWidth=MaxW)
59  and (FMaxInterfaceHeight=MaxH) then exit;
60
61  FMinInterfaceWidth:=MinW;
62  FMinInterfaceHeight:=MinH;
63  FMaxInterfaceWidth:=MaxW;
64  FMaxInterfaceHeight:=MaxH;
65
66  if (FControl.Width<>MinMaxWidth(FControl.Width))
67  or (FControl.Height<>MinMaxHeight(FControl.Height)) then
68    FControl.RequestAlign;
69end;
70
71function TSizeConstraints.EffectiveMinWidth: integer;
72begin
73  if csLoading in Control.ComponentState then
74    exit(0);
75  if (MinWidth>MinInterfaceWidth) then begin
76    Result:=MinWidth;
77    if (MaxInterfaceWidth>0) and (MaxInterfaceWidth<MinWidth) then
78      Result:=MaxInterfaceWidth;
79  end else
80    Result:=MinInterfaceWidth;
81end;
82
83function TSizeConstraints.EffectiveMinHeight: integer;
84begin
85  if csLoading in Control.ComponentState then
86    exit(0);
87  if (MinHeight>MinInterfaceHeight) then begin
88    Result:=MinHeight;
89    if (MaxInterfaceHeight>0) and (Result>MaxInterfaceHeight) then
90      Result:=MaxInterfaceHeight;
91  end else
92    Result:=MinInterfaceHeight;
93end;
94
95// The EffectiveMaxWidth is the minumum of MaxWidth and MaxInterfaceWidth,
96// but it is at least MinInterfaceWidth.
97// A zero value is interpreted as unconstraint.
98function TSizeConstraints.EffectiveMaxWidth: integer;
99begin
100  if csLoading in Control.ComponentState then
101    exit(0);
102  if (MaxInterfaceWidth>0) and
103    ((MaxWidth=0) or (MaxInterfaceWidth<MaxWidth)) then
104    Result := MaxInterfaceWidth
105  else
106    Result:=MaxWidth;
107  if (Result>0) and (MinInterfaceWidth>0) and (Result<MinInterfaceWidth) then
108    Result:=MinInterfaceWidth;
109end;
110
111// The EffectiveMaxHeight is the minumum of MaxHeight and MaxInterfaceHeight,
112// but it is at least the MinInterfaceHeight.
113// A zero value is interpreted as unconstraint.
114function TSizeConstraints.EffectiveMaxHeight: integer;
115begin
116  if csLoading in Control.ComponentState then
117    exit(0);
118  if (MaxInterfaceHeight>0) and
119    ((MaxHeight=0) or (MaxInterfaceHeight<MaxHeight)) then
120    Result := MaxInterfaceHeight
121  else
122    Result:=MaxHeight;
123  if (Result>0) and (MinInterfaceHeight>0) and (Result<MinInterfaceHeight) then
124    Result:=MinInterfaceHeight;
125end;
126
127function TSizeConstraints.MinMaxWidth(Width: integer): integer;
128var
129  MinW: LongInt;
130  MaxW: LongInt;
131begin
132  Result:=Width;
133  MinW:=EffectiveMinWidth;
134  if (Result<MinW) then Result:=MinW;
135  MaxW:=EffectiveMaxWidth;
136  if (MaxW>0) and (Result>MaxW) then Result:=MaxW;
137  if (Control is TWinControl) and TWinControl(Control).HandleAllocated then
138    TWSControlClass(Control.WidgetSetClass).ConstraintWidth(Control, Self, Result);
139end;
140
141function TSizeConstraints.MinMaxHeight(Height: integer): integer;
142var
143  MinH: LongInt;
144  MaxH: LongInt;
145begin
146  Result:=Height;
147  MinH:=EffectiveMinHeight;
148  if (Result<MinH) then Result:=MinH;
149  MaxH:=EffectiveMaxHeight;
150  if (MaxH>0) and (Result>MaxH) then Result:=MaxH;
151  if (Control is TWinControl) and TWinControl(Control).HandleAllocated then
152    TWSControlClass(Control.WidgetSetClass).ConstraintHeight(Control, Self, Result);
153end;
154
155{------------------------------------------------------------------------------
156  Method:  TSizeConstraints.SetMaxWidth
157  Params:  Value: the new value of the property
158  Returns: Nothing
159
160  Sets a new value of its property.
161 ------------------------------------------------------------------------------}
162procedure TSizeConstraints.SetMaxWidth(Value: TConstraintSize);
163begin
164  if Value <> FMaxWidth then begin
165    FMaxWidth:= Value;
166    if (FMinWidth > 0) and (FMaxWidth>0) and (FMaxWidth < FMinWidth) then
167      FMinWidth:= FMaxWidth;
168    Change;
169  end;
170end;
171
172{------------------------------------------------------------------------------
173  Method:  TSizeConstraints.SetMaxHeight
174  Params:  Value: the new value of the property
175  Returns: Nothing
176
177  Sets a new value of its property.
178 ------------------------------------------------------------------------------}
179procedure TSizeConstraints.SetMaxHeight(Value: TConstraintSize);
180begin
181  if Value <> FMaxHeight then begin
182    FMaxHeight:= Value;
183    if (FMinHeight > 0) and (FMaxHeight>0) and (FMaxHeight < FMinHeight) then
184      FMinHeight:= FMaxHeight;
185    Change;
186  end;
187end;
188
189{------------------------------------------------------------------------------
190  Method:  TSizeConstraints.SetMinWidth
191  Params:  Value: the new value of the property
192  Returns: Nothing
193
194  Sets a new value of its property.
195 ------------------------------------------------------------------------------}
196procedure TSizeConstraints.SetMinWidth(Value: TConstraintSize);
197begin
198  if Value <> FMinWidth then begin
199    FMinWidth:= Value;
200    if (FMaxWidth > 0) and (FMinWidth > FMaxWidth) then FMaxWidth:= FMinWidth;
201    Change;
202  end;
203end;
204
205{------------------------------------------------------------------------------
206  Method:  TSizeConstraints.SetMinHeight
207  Params:  Value: the new value of the property
208  Returns: Nothing
209
210  Sets a new value of its property.
211 ------------------------------------------------------------------------------}
212procedure TSizeConstraints.SetMinHeight(Value: TConstraintSize);
213begin
214  if Value <> FMinHeight then begin
215    FMinHeight:= Value;
216    if (FMaxHeight > 0) and (FMinHeight > FMaxHeight) then FMaxHeight:= FMinHeight;
217    Change;
218  end;
219end;
220
221procedure TSizeConstraints.SetOptions(const AValue: TSizeConstraintsOptions);
222begin
223  if FOptions=AValue then exit;
224  FOptions:=AValue;
225end;
226
227{------------------------------------------------------------------------------
228  Method:  TSizeConstraints.Change
229  Params:  none
230  Returns: Nothing
231
232  Calls a change handler if assigned.
233 ------------------------------------------------------------------------------}
234procedure TSizeConstraints.Change;
235begin
236  FControl.DoConstraintsChange(Self);
237  if Assigned(FOnChange) then FOnChange(Self);
238end;
239
240{------------------------------------------------------------------------------
241  Method:  TSizeConstraints.AssignTo
242  Params:  Dest: Destination constraints to be assigned
243  Returns: Nothing
244
245  Calls a change handler if assigned.
246 ------------------------------------------------------------------------------}
247procedure TSizeConstraints.AssignTo(Dest: TPersistent);
248begin
249  if Dest is TSizeConstraints then begin
250    with TSizeConstraints(Dest) do begin
251      if (FMinWidth<>Self.FMinWidth)
252      or (FMaxWidth<>Self.FMaxWidth)
253      or (FMinHeight<>Self.FMinHeight)
254      or (FMaxHeight<>Self.FMaxHeight) then begin
255        FMinWidth:= Self.FMinWidth;
256        FMaxWidth:= Self.FMaxWidth;
257        FMinHeight:= Self.FMinHeight;
258        FMaxHeight:= Self.FMaxHeight;
259        Change;
260      end;
261    end;
262  end else begin
263    inherited AssignTo(Dest);
264  end;
265end;
266
267procedure TSizeConstraints.AutoAdjustLayout(const AXProportion,
268  AYProportion: Double);
269
270  procedure Scale(var Value: Integer; const Proportion: Double; var Changed: Boolean);
271  begin
272    if Value<>0 then
273    begin
274      Value := Round(Value * Proportion);
275      Changed := True;
276    end;
277  end;
278var
279  Changed: Boolean;
280begin
281  Changed := False;
282
283  Scale(FMaxWidth, AXProportion, Changed);
284  Scale(FMinWidth, AXProportion, Changed);
285  Scale(FMaxHeight, AYProportion, Changed);
286  Scale(FMinHeight, AYProportion, Changed);
287
288  if Changed then
289    Change;
290end;
291
292// included by controls.pp
293