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