1{%MainUnit ../controls.pp} 2 3{****************************************************************************** 4 TWinControl 5 ****************************************************************************** 6 7 ***************************************************************************** 8 This file is part of the Lazarus Component Library (LCL) 9 10 See the file COPYING.modifiedLGPL.txt, included in this distribution, 11 for details about the license. 12 ***************************************************************************** 13} 14 15{$IFOPT C-} 16// Uncomment for local trace 17// {$C+} 18// {$DEFINE ASSERT_IS_ON} 19{$ENDIF} 20 21{off $DEFINE VerboseAutoSizeCtrlData} 22{off $DEFINE VerboseMouseBugfix} 23{off $DEFINE VerboseCanAutoSize} 24{off $DEFINE VerboseIntfSizing} 25{off $DEFINE VerboseClientRectBugFix} 26{$IFDEF VerboseClientRectBugFix} 27const CheckClientRectName = 'LCLInterfaceRadioGroup'; 28{$ENDIF} 29 30{off $DEFINE VerboseSizeMsg} 31{off $DEFINE CHECK_POSITION} 32{$IFDEF CHECK_POSITION} 33const CheckPostionClassName = 'xxxTBreakPropertyDlg'; 34const CheckPostionName = 'FakeStatusBar'; 35const CheckPostionParentName = 'xxxEnvVarsPage'; 36 37function CheckPosition(AControl: TControl): boolean; 38begin 39 Result:=(CompareText(AControl.ClassName,CheckPostionClassName)=0) 40 or (CompareText(AControl.Name,CheckPostionName)=0) 41 or ((AControl.Parent<>nil) 42 and (CompareText(AControl.Parent.Name,CheckPostionParentName)=0)); 43end; 44{$ENDIF} 45 46function IsNotAligned(AControl: TControl): boolean; 47begin 48 Result:=(AControl.Align=alNone) 49 and (AControl.Anchors=[akLeft,akTop]) 50 and (AControl.AnchorSide[akLeft].Control=nil) 51 and (AControl.AnchorSide[akTop].Control=nil); 52end; 53 54function IsNotAligned(AControl: TControl; ASide: TAnchorKind): boolean; 55begin 56 Result:=(AControl.Align=alNone); 57 if not Result then Exit; 58 if ASide in [akLeft, akRight] then 59 Result:=(AControl.Anchors*[akLeft, akRight]=[akLeft]) 60 and (AControl.AnchorSide[akLeft].Control=nil) 61 else 62 Result:=(AControl.Anchors*[akTop, akBottom]=[akTop]) 63 and (AControl.AnchorSide[akBottom].Control=nil); 64end; 65 66{------------------------------------------------------------------------------ 67 Autosizing Helper classes 68-------------------------------------------------------------------------------} 69type 70 TAutoSizeBoxOrientation = (asboHorizontal, asboVertical); 71 72 PAutoSizeBox = ^TAutoSizeBox; 73 74 { TAutoSizeBox 75 A TAutoSizeBox is a node in a tree. 76 A TAutoSizeBox can be a cell. Then it is a leaf in the tree and can have a 77 Control. 78 A TAutoSizeBox can be a row or column. Then it has only one Children array. 79 A TAutoSizeBox can be a table. Then it has both Children arrays. 80 } 81 82 TAutoSizeBox = class 83 public 84 Control: TControl; // the Control of a leaf node 85 MinimumSize: array[TAutoSizeBoxOrientation] of integer; 86 MaximumSize: array[TAutoSizeBoxOrientation] of integer; // 0 means inifinte 87 PreferredSize: array[TAutoSizeBoxOrientation] of integer;// without theme space 88 LeftTop: array[TAutoSizeBoxOrientation] of integer; 89 BorderLeftTop: array[TAutoSizeBoxOrientation] of integer; 90 BorderRightBottom: array[TAutoSizeBoxOrientation] of integer; 91 Parent: array[TAutoSizeBoxOrientation] of TAutoSizeBox; 92 Index: array[TAutoSizeBoxOrientation] of Integer; // index in parent or grandparent 93 ChildCount: array[TAutoSizeBoxOrientation] of Integer; 94 Children: array[TAutoSizeBoxOrientation] of PAutoSizeBox; 95 NewControlBounds: TRect; 96 97 // for nodes 98 destructor Destroy; override; 99 procedure Clear; 100 procedure SetControl(AControl: TControl); 101 procedure ApplyChildSizingBorders(ChildSizing: TControlChildSizing); 102 103 // for rows and columns 104 procedure AllocateChildsArray(Orientation: TAutoSizeBoxOrientation; 105 NewChildCount: Integer); 106 procedure InitSums; 107 procedure SumLine(Orientation: TAutoSizeBoxOrientation; 108 DoInit: boolean); 109 procedure ResizeChildren(ChildSizing: TControlChildSizing; 110 Orientation: TAutoSizeBoxOrientation; 111 TargetSize: integer); 112 procedure ComputeLeftTops(Orientation: TAutoSizeBoxOrientation); 113 114 // for tables 115 procedure AllocateTable(ColCount, RowCount: Integer); 116 procedure SetTableControls(ListOfControls: TFPList; 117 ChildSizing: TControlChildSizing; 118 BiDiMode: TBiDiMode); 119 procedure SumTable; 120 procedure ResizeTable(ChildSizing: TControlChildSizing; 121 TargetWidth, TargetHeight: integer); 122// Michl: Commented procedure AlignToRight because of issue #28483, afaics 123// it isn't needed, I'll remove code, if there are no regressions. 124// Commented in revision 55209 125// procedure AlignToRight(TargetWidth: integer); 126 procedure ComputeTableControlBounds(ChildSizing: TControlChildSizing; 127 BiDiMode: TBiDiMode); 128 function SetTableControlBounds(ChildSizing: TControlChildSizing 129 ): boolean;// true if changed 130 function AlignControlsInTable(ListOfControls: TFPList; 131 ChildSizing: TControlChildSizing; 132 BiDiMode: TBiDiMode; 133 TargetWidth, TargetHeight: integer; 134 Apply: boolean): boolean;// true if changed 135 136 // debugging 137 procedure WriteDebugReport(const Title: string); 138 end; 139 140 { TAutoSizeCtrlData 141 This class is used by the auto size algorithm, to compute the preferred 142 size of a control given the preferred sizes of its children. 143 Hints about the algorithm: 144 First it builds a graph of dependencies. That means, for every side 145 (Left,Top,Right,Bottom) of each child control the anchor control and 146 space is calculated. Anchor means here direct and indirect anchors. 147 Indirect anchors are defined by the Align property. 148 For example a control with Align=alTop is anchored left to the parent, 149 right to the parent and top to either the parent or another alTop control. 150 Then it searches for circles and other invalid combinations and repairs 151 them. 152 } 153 154 TAutoSizeCtrlData = class; 155 156 TAutoSizeSideDataState = ( 157 assdfInvalid, 158 assdfComputing, 159 assdfUncomputable,// e.g. if [akLeft,akRight]*Anchors = [] 160 assdfValid 161 ); 162 TAutoSizeSideDistDirection = ( 163 assddLeftTop, 164 assddRightBottom 165 ); 166 167 TAutoSizeSideData = record 168 CtrlData: TAutoSizeCtrlData; 169 Side: TAnchorSideReference; 170 Space: integer; 171 Distance: array[TAutoSizeSideDistDirection] of integer; 172 DistanceState: array[TAutoSizeSideDistDirection] of TAutoSizeSideDataState; 173 end; 174 175 TAutoSizeCtrlData = class 176 private 177 FChilds: TAvlTree;// tree of TAutoSizeCtrlData 178 function GetChildren(AControl: TControl): TAutoSizeCtrlData; 179 procedure DoMoveNonAlignedChildren(Side: TAnchorKind; 180 var MoveDiff: integer; FindMinimum: boolean); 181 procedure SetupNonAlignedChildren(MoveNonAlignedChildrenLeft, 182 MoveNonAlignedChildrenTop: boolean); 183 procedure AlignChildren; 184 procedure SetupSpace; 185 function ComputePositions: boolean;// false if recomputation is needed (a property changed) 186 public 187 Control: TControl; // the Control of a leaf node 188 WinControl: TWinControl;// the Control as TWinControl (else nil) 189 ChildCount: integer; 190 Visible: boolean;//= Control.IsControlVisible 191 PreferredSize: array[TAutoSizeBoxOrientation] of integer;// without theme space 192 Borders: array[TAnchorKind] of integer; 193 AdjustedClientBorders: array[TAnchorKind] of integer;// the borderspace created by WinControl.AdjustClientRect 194 Sides: array[TAnchorKind] of TAutoSizeSideData; 195 BaseBounds: TRect; 196 BaseParentClientSize: TSize; 197 constructor Create(AControl: TControl; IsParent: boolean = true); 198 destructor Destroy; override; 199 procedure Clear; 200 procedure ComputePreferredClientArea(MoveNonAlignedChildrenLeft, 201 MoveNonAlignedChildrenTop: boolean; 202 out MoveNonAlignedToLeft, MoveNonAlignedToTop, 203 PreferredClientWidth, PreferredClientHeight: integer); 204 procedure FixControlProperties(Child: TControl); 205 procedure ClearSides; 206 procedure SetFixedLeftTop(ChildData: TAutoSizeCtrlData; Side: TAnchorKind; 207 NewLeftTop: integer); 208 property Children[AControl: TControl]: TAutoSizeCtrlData read GetChildren; default; 209 procedure WriteDebugReport(const Title, Prefix: string; OnlyVisible: boolean = true); 210 end; 211 212const 213 SizeBoxOrthogonal: array[TAutoSizeBoxOrientation] of TAutoSizeBoxOrientation 214 = (asboVertical,asboHorizontal); 215 {AutoSizeSideDataStateNames: array[TAutoSizeSideDataState] of shortstring = ( 216 'assdfInvalid', 217 'assdfComputing', 218 'assdfUncomputable', 219 'assdfValid' 220 );} 221 {$IFNDEF DisableChecks} 222 AutoSizeSideDistDirectionNames: array[TAutoSizeSideDistDirection] of shortstring = ( 223 'assddLeftTop', 224 'assddRightBottom' 225 ); 226 {$ENDIF} 227 228function CompareAutoSizeCtrlDatas(Data1, Data2: Pointer): integer; 229var 230 Control1: TControl; 231 Control2: TControl; 232begin 233 Control1:=TAutoSizeCtrlData(Data1).Control; 234 Control2:=TAutoSizeCtrlData(Data2).Control; 235 if Pointer(Control1)>Pointer(Control2) then 236 Result:=1 237 else if Pointer(Control1)<Pointer(Control2) then 238 Result:=-1 239 else 240 Result:=0; 241end; 242 243function CompareControlWithAutoSizeCtrlData(AControl, AData: Pointer): integer; 244var 245 Control1: TControl; 246 Control2: TControl; 247begin 248 Control1:=TControl(AControl); 249 Control2:=TAutoSizeCtrlData(AData).Control; 250 if Pointer(Control1)>Pointer(Control2) then 251 Result:=1 252 else if Pointer(Control1)<Pointer(Control2) then 253 Result:=-1 254 else 255 Result:=0; 256end; 257 258 259{ TAutoSizeCtrlData } 260 261function TAutoSizeCtrlData.GetChildren(AControl: TControl): TAutoSizeCtrlData; 262var 263 AVLNode: TAvlTreeNode; 264begin 265 if AControl=nil then exit(nil); 266 if AControl=Control then RaiseGDBException('TAutoSizeCtrlData.GetChilds'); 267 if FChilds=nil then 268 FChilds:=TAvlTree.Create(@CompareAutoSizeCtrlDatas); 269 AVLNode:=FChilds.FindKey(AControl,@CompareControlWithAutoSizeCtrlData); 270 if AVLNode<>nil then 271 Result:=TAutoSizeCtrlData(AVLNode.Data) 272 else begin 273 Result:=TAutoSizeCtrlData.Create(AControl,false); 274 FChilds.Add(Result); 275 end; 276end; 277 278procedure TAutoSizeCtrlData.AlignChildren; 279var 280 AlignList: TFPList; 281 AlignBoundaryControls: array[TAnchorKind] of TAutoSizeCtrlData; 282 283 procedure DoAlign(TheAlign: TAlign); 284 var 285 Child: TControl; 286 i: Integer; 287 ChildData: TAutoSizeCtrlData; 288 a: TAnchorKind; 289 begin 290 WinControl.CreateControlAlignList(TheAlign, AlignList, nil); 291 for i := 0 to AlignList.Count - 1 do 292 begin 293 Child := TControl(AlignList[i]); 294 ChildData := Children[Child]; 295 //DebugLn('DoAlign ',DbgSName(Child),' ',dbgs(Child.Align)); 296 297 for a := Low(TAnchorKind) to High(TAnchorKind) do 298 if a in AnchorAlign[TheAlign] then 299 begin 300 ChildData.Sides[a].CtrlData := AlignBoundaryControls[a]; 301 if (a in [akLeft, akTop]) = (ChildData.Sides[a].CtrlData = Self) then 302 ChildData.Sides[a].Side := asrLeft 303 else 304 ChildData.Sides[a].Side := asrRight; 305 //DebugLn('DoAlign ',DbgSName(Child),' ',dbgs(a),' ',dbgs(a,ChildData.Sides[a].Side)); 306 end; 307 308 case TheAlign of 309 alTop: AlignBoundaryControls[akTop] := ChildData; 310 alBottom: AlignBoundaryControls[akBottom] := ChildData; 311 alLeft: AlignBoundaryControls[akLeft] := ChildData; 312 alRight: AlignBoundaryControls[akRight] := ChildData; 313 alClient: ; // Delphi compatibility: multiple alClient controls overlap 314 end; 315 {DebugLn(['DoAlign AlignBoundaryControls:', 316 ' Left=',DbgSName(AlignBoundaryControls[akLeft].Control), 317 ' Top=',DbgSName(AlignBoundaryControls[akTop].Control), 318 ' Right=',DbgSName(AlignBoundaryControls[akRight].Control), 319 ' Bottom=',DbgSName(AlignBoundaryControls[akBottom].Control) ]);} 320 end; 321 end; 322 323var 324 a: TAnchorKind; 325begin 326 if ChildCount = 0 then exit; 327 AlignList := TFPList.Create; 328 try 329 // align and anchor child controls 330 for a := Low(TAnchorKind) to High(TAnchorKind) do 331 AlignBoundaryControls[a] := Self; 332 DoAlign(alTop); 333 DoAlign(alBottom); 334 DoAlign(alLeft); 335 DoAlign(alRight); 336 DoAlign(alClient); 337 finally 338 AlignList.Free; 339 end; 340end; 341 342procedure TAutoSizeCtrlData.SetupSpace; 343var 344 i: Integer; 345 Child: TControl; 346 ChildData: TAutoSizeCtrlData; 347 a: TAnchorKind; 348 SiblingData: TAutoSizeCtrlData; 349 NewSpace: LongInt; 350begin 351 for i:=0 to ChildCount-1 do begin 352 Child:=WinControl.Controls[i]; 353 ChildData:=Children[Child]; 354 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 355 if ChildData.Sides[a].CtrlData=Self then begin 356 // aligned or anchored to parent 357 if a in [akLeft,akRight] then begin 358 ChildData.Sides[a].Space:=Max(WinControl.ChildSizing.LeftRightSpacing, 359 ChildData.Borders[a]); 360 end else begin 361 ChildData.Sides[a].Space:=Max(WinControl.ChildSizing.TopBottomSpacing, 362 ChildData.Borders[a]); 363 end; 364 inc(ChildData.Sides[a].Space,AdjustedClientBorders[a]); 365 end else if ChildData.Sides[a].CtrlData<>nil then begin 366 SiblingData:=ChildData.Sides[a].CtrlData; 367 // aligned or anchored to a sibling 368 if a in [akLeft,akTop] then begin 369 NewSpace:=ChildData.Borders[a]; 370 if ChildData.Sides[a].Side=asrRight then begin 371 NewSpace:=Max(NewSpace,WinControl.ChildSizing.HorizontalSpacing); 372 if a=akLeft then 373 NewSpace:=Max(NewSpace,SiblingData.Borders[akRight]) 374 else 375 NewSpace:=Max(NewSpace,SiblingData.Borders[akBottom]); 376 end else if ChildData.Sides[a].Side=asrLeft then 377 378 else if ChildData.Sides[a].Side=asrCenter then 379 NewSpace:=0; 380 ChildData.Sides[a].Space:=NewSpace; 381 end else begin 382 NewSpace:=ChildData.Borders[a]; 383 if ChildData.Sides[a].Side=asrTop then begin 384 NewSpace:=Max(NewSpace,WinControl.ChildSizing.VerticalSpacing); 385 if a=akRight then 386 NewSpace:=Max(NewSpace,SiblingData.Borders[akLeft]) 387 else 388 NewSpace:=Max(NewSpace,SiblingData.Borders[akTop]); 389 end else if ChildData.Sides[a].Side=asrBottom then 390 391 else if ChildData.Sides[a].Side=asrCenter then 392 NewSpace:=0; 393 ChildData.Sides[a].Space:=NewSpace; 394 end; 395 end else if a in Child.Anchors then begin 396 // anchored to parent via BaseBounds 397 if a in [akLeft,akTop] then begin 398 ChildData.Sides[a].Side:=asrRight; 399 end else begin 400 ChildData.Sides[a].Side:=asrLeft; 401 end; 402 case a of 403 akTop: ChildData.Sides[a].Space:=ChildData.BaseBounds.Top; 404 akLeft: ChildData.Sides[a].Space:=ChildData.BaseBounds.Left; 405 akRight: ChildData.Sides[a].Space:= 406 ChildData.BaseParentClientSize.cx-ChildData.BaseBounds.Right; 407 akBottom: ChildData.Sides[a].Space:= 408 ChildData.BaseParentClientSize.cy-ChildData.BaseBounds.Bottom; 409 end; 410 end else begin 411 // not anchored => use borderspacing 412 if a in [akLeft,akTop] then 413 ChildData.Sides[a].Side:=asrRight 414 else 415 ChildData.Sides[a].Side:=asrLeft; 416 if a in [akLeft,akRight] then begin 417 ChildData.Sides[a].Space:= 418 Max(WinControl.ChildSizing.LeftRightSpacing, 419 ChildData.Borders[a]); 420 end else begin 421 ChildData.Sides[a].Space:= 422 Max(WinControl.ChildSizing.TopBottomSpacing, 423 ChildData.Borders[a]); 424 end; 425 inc(ChildData.Sides[a].Space,AdjustedClientBorders[a]); 426 end; 427 end; 428 end; 429end; 430 431function TAutoSizeCtrlData.ComputePositions: boolean; 432type 433 TComputeResult = ( 434 crSuccess, 435 crCircle, 436 crFixedCircled 437 ); 438 439 function ComputePosition(ChildData: TAutoSizeCtrlData; Side: TAnchorKind; 440 Direction: TAutoSizeSideDistDirection): TComputeResult; 441 var 442 OppositeSide: TAnchorKind; 443 NewDist: LongInt; 444 SiblingData: TAutoSizeCtrlData; 445 NeededSiblingSides: TAnchors; 446 a: TAnchorKind; 447 Child: TControl; 448 IsSideLeftTop, IsOutwards, IsParentInwards: boolean; 449 CurAnchors: TAnchors; 450 CurSize: LongInt; 451 FoundSides: TAnchors; 452 AddPreferredSize: Boolean; 453 begin 454 if ChildData.Sides[Side].DistanceState[Direction] 455 in [assdfValid,assdfUncomputable] 456 then 457 exit(crSuccess); // already computed 458 if ChildData.Sides[Side].DistanceState[Direction]=assdfComputing then begin 459 {$IFNDEF DisableChecks} 460 DebugLn(['TAutoSizeCtrlData.ComputePositions.ComputePosition CIRCLE detected ',DbgSName(ChildData.Control),' ',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction]]); 461 {$ENDIF} 462 exit(crCircle); // there is a circle 463 end; 464 if ChildData.Sides[Side].DistanceState[Direction]<>assdfInvalid then 465 raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition <>assdfInvalid'); 466 467 // mark as computing 468 ChildData.Sides[Side].DistanceState[Direction]:=assdfComputing; 469 OppositeSide:=OppositeAnchor[Side]; 470 471 // try to find good distances to the client area for this side 472 Child:=ChildData.Control; 473 CurAnchors:=Child.Anchors; 474 if Child.Align in [alLeft,alTop,alRight,alBottom,alClient] then 475 CurAnchors:=CurAnchors+AnchorAlign[Child.Align]; 476 if (Side in CurAnchors) then begin 477 // this side is anchored 478 SiblingData:=ChildData.Sides[Side].CtrlData; 479 NewDist:=0; 480 if (SiblingData=nil) or (SiblingData=Self) then begin 481 // this side is anchored to parent 482 // Note: SiblingData=nil can happen, if the reference control 483 // is not visible => use parent as default anchor 484 case ChildData.Sides[Side].Side of 485 asrLeft,asrRight: // asrTop=asrLeft,asrBottom=asrRight 486 begin 487 IsSideLeftTop:=(Side in [akLeft,akTop]); 488 IsOutwards:=(Direction=assddLeftTop)=IsSideLeftTop; 489 IsParentInwards:=(SiblingData=nil) 490 or ((ChildData.Sides[Side].Side=asrLeft)=IsSideLeftTop); 491 if not IsParentInwards then begin 492 // for example: left side is anchored to right side of parent 493 //DebugLn(['ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' parent outside anchored, Direction=',AutoSizeSideDistDirectionNames[Direction],' => assdfUncomputable']); 494 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 495 end else if IsOutwards then begin 496 // for example: left side is anchored to left side of parent 497 // and left distance is needed 498 ChildData.Sides[Side].Distance[Direction]:=ChildData.Sides[Side].Space; 499 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 500 end else begin 501 // for example: left side is anchored to left side of parent, 502 // right distance is needed 503 AddPreferredSize:=true; 504 if OppositeSide in CurAnchors then begin 505 // compute opposite side first 506 Result:=ComputePosition(ChildData,OppositeSide,Direction); 507 if Result<>crSuccess then begin 508 {$IFNDEF DisableChecks} 509 DebugLn(['ComputePosition FAILED opposite side: ',DbgSName(Child),' ',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction]]); 510 {$ENDIF} 511 exit; 512 end; 513 if ChildData.Sides[OppositeSide].DistanceState[Direction]<>assdfValid 514 then begin 515 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 516 exit; 517 end; 518 NewDist:=ChildData.Sides[OppositeSide].Distance[Direction]; 519 if (ChildData.Sides[OppositeSide].CtrlData<>nil) 520 and (ChildData.Sides[OppositeSide].CtrlData<>Self) 521 then begin 522 // opposite side is anchored to a sibling 523 if ((OppositeSide in [akLeft,akTop]) 524 and (ChildData.Sides[OppositeSide].Side<>asrRight)) 525 or ((OppositeSide in [akRight,akBottom]) 526 and (ChildData.Sides[OppositeSide].Side<>asrLeft)) 527 then 528 AddPreferredSize:=false; 529 end; 530 end else begin 531 NewDist:=ChildData.Sides[OppositeSide].Space; 532 end; 533 if AddPreferredSize then begin 534 if Side in [akLeft,akRight] then 535 inc(NewDist,ChildData.PreferredSize[asboHorizontal]) 536 else 537 inc(NewDist,ChildData.PreferredSize[asboVertical]); 538 end; 539 ChildData.Sides[Side].Distance[Direction]:=NewDist; 540 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 541 end; 542 end; 543 asrCenter: 544 begin 545 //DebugLn(['ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' parent anchored, Direction=',AutoSizeSideDistDirectionNames[Direction],' => assdfUncomputable']); 546 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 547 end; 548 else 549 RaiseGDBException(''); 550 end; 551 end else begin 552 // this side is anchored to a sibling 553 // first compute needed sides of sibling 554 NeededSiblingSides:=[]; 555 case ChildData.Sides[Side].Side of 556 asrLeft: // Note: asrLeft=asrTop 557 if Side in [akLeft,akRight] then begin 558 Include(NeededSiblingSides,akLeft); 559 end else begin 560 Include(NeededSiblingSides,akTop); 561 end; 562 asrRight: // Note: asrRight=asrBottom 563 if Side in [akLeft,akRight] then begin 564 Include(NeededSiblingSides,akRight); 565 end else begin 566 Include(NeededSiblingSides,akBottom); 567 end; 568 asrCenter: 569 if Side in [akLeft,akRight] then begin 570 NeededSiblingSides:=NeededSiblingSides+[akLeft,akRight]; 571 end else begin 572 NeededSiblingSides:=NeededSiblingSides+[akTop,akBottom]; 573 end; 574 end; 575 FoundSides:=[]; 576 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 577 if a in NeededSiblingSides then begin 578 Result:=ComputePosition(SiblingData,a,Direction); 579 if (Result=crCircle) 580 and ((Child.Align in [alNone,alCustom]) 581 or (not (Side in AnchorAlign[Child.Align]))) then 582 begin 583 // there is a circle and it can be broken => break it 584 {$IFNDEF DisableChecks} 585 DebugLn(['ComputePosition breaking CIRCLE ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' ',dbgs(a),' ',AutoSizeSideDistDirectionNames[Direction]]); 586 {$ENDIF} 587 Child.Anchors:=Child.Anchors-[Side]; 588 Result:=crFixedCircled; 589 end; 590 if Result<>crSuccess then begin 591 {$IFNDEF DisableChecks} 592 DebugLn(['ComputePosition FAILED sibling dependency: ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' a=',dbgs(a),' ',AutoSizeSideDistDirectionNames[Direction]]); 593 {$ENDIF} 594 exit; 595 end; 596 if SiblingData.Sides[a].DistanceState[Direction]=assdfValid then 597 Include(FoundSides,a); 598 end; 599 end; 600 if FoundSides=[] then begin 601 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 602 exit(crSuccess); 603 end; 604 605 // this side is anchored to a sibling and some needed sibling sides are valid 606 case ChildData.Sides[Side].Side of 607 asrLeft,asrRight: // asrLeft=asrTop,asrRight=asrBottom 608 begin 609 if ChildData.Sides[Side].Side=asrLeft then begin 610 if Side in [akLeft,akRight] then 611 NewDist:=SiblingData.Sides[akLeft].Distance[Direction] 612 else 613 NewDist:=SiblingData.Sides[akTop].Distance[Direction]; 614 end else begin 615 if Side in [akLeft,akRight] then 616 NewDist:=SiblingData.Sides[akRight].Distance[Direction] 617 else 618 NewDist:=SiblingData.Sides[akBottom].Distance[Direction]; 619 end; 620 if (Direction=assddLeftTop)=(Side in [akLeft,akTop]) then 621 inc(NewDist,ChildData.Sides[Side].Space) 622 else 623 dec(NewDist,ChildData.Sides[Side].Space); 624 //DebugLn(['ComputePosition ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction],' NewDist=',NewDist]); 625 end; 626 asrCenter: 627 if Side in [akLeft,akRight] then begin 628 if FoundSides=[akLeft,akRight] then begin 629 NewDist:=((SiblingData.Sides[akLeft].Distance[Direction] 630 +SiblingData.Sides[akRight].Distance[Direction]) div 2); 631 end else if (FoundSides=[akLeft]) then begin 632 NewDist:=SiblingData.Sides[akLeft].Distance[Direction] 633 +(SiblingData.PreferredSize[asboHorizontal] div 2); 634 end else begin 635 NewDist:=SiblingData.Sides[akRight].Distance[Direction] 636 -(SiblingData.PreferredSize[asboHorizontal] div 2); 637 end; 638 //DebugLn(['ComputePosition BEFORE ',DbgSName(Child),' center to ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' FoundSides=',dbgs(FoundSides),' NewDist=',NewDist,' Direction=',AutoSizeSideDistDirectionNames[Direction],' PreferredSize=',ChildData.PreferredSize[asboHorizontal]]); 639 dec(NewDist,ChildData.PreferredSize[asboHorizontal] div 2); 640 // use at least the size of the child 641 if (Side=akLeft)=(Direction=assddRightBottom) then 642 NewDist:=Max(NewDist,ChildData.PreferredSize[asboHorizontal]); 643 //DebugLn(['ComputePosition AFTER ',DbgSName(Child),' center to ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' FoundSides=',dbgs(FoundSides),' NewDist=',NewDist,' Direction=',AutoSizeSideDistDirectionNames[Direction],' PreferredSize=',ChildData.PreferredSize[asboHorizontal]]); 644 end else begin 645 if FoundSides=[akTop,akBottom] then begin 646 NewDist:=((SiblingData.Sides[akTop].Distance[Direction] 647 +SiblingData.Sides[akBottom].Distance[Direction]) div 2); 648 end else if (FoundSides=[akTop]) then begin 649 NewDist:=SiblingData.Sides[akTop].Distance[Direction] 650 +(SiblingData.PreferredSize[asboVertical] div 2); 651 end else begin 652 NewDist:=SiblingData.Sides[akBottom].Distance[Direction] 653 -(SiblingData.PreferredSize[asboVertical] div 2); 654 end; 655 dec(NewDist,ChildData.PreferredSize[asboVertical] div 2); 656 // use at least the size of the child 657 if (Side=akTop)=(Direction=assddRightBottom) then 658 NewDist:=Max(NewDist,ChildData.PreferredSize[asboVertical]); 659 end; 660 end; 661 ChildData.Sides[Side].Distance[Direction]:=NewDist; 662 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 663 664 if (OppositeSide in CurAnchors) 665 and ((Direction=assddLeftTop) <> (Side in [akLeft,akTop])) then begin 666 // the opposite side is anchored too 667 // use the maximum of both anchors 668 Result:=ComputePosition(ChildData,OppositeSide,Direction); 669 if Result<>crSuccess then begin 670 //DebugLn(['ComputePosition (side anchored) FAILED computing opposite side: ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction]]); 671 exit; 672 end; 673 case ChildData.Sides[OppositeSide].DistanceState[Direction] of 674 assdfValid: 675 begin 676 // opposite side +- preferred size 677 NewDist:=ChildData.Sides[OppositeSide].Distance[Direction]; 678 CurSize:=0; 679 if ((OppositeSide in [akLeft,akTop]) 680 and (ChildData.Sides[OppositeSide].Side=asrRight)) 681 or ((OppositeSide in [akRight,akBottom]) 682 and (ChildData.Sides[OppositeSide].Side=asrLeft)) 683 then begin 684 if Side in [akLeft,akRight] then 685 CurSize:=ChildData.PreferredSize[asboHorizontal] 686 else 687 CurSize:=ChildData.PreferredSize[asboVertical]; 688 end; 689 inc(NewDist,CurSize); 690 // check if opposite side needs a bigger distance 691 if ChildData.Sides[Side].Distance[Direction]<NewDist then 692 ChildData.Sides[Side].Distance[Direction]:=NewDist; 693 end; 694 assdfUncomputable: ; // no problem, there is already a value 695 else 696 raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable'); 697 end; 698 end; 699 end; 700 end else if (OppositeSide in CurAnchors) 701 and ((Direction=assddLeftTop) <> (Side in [akLeft,akTop])) then begin 702 // this side is not anchored, but the opposite is 703 // e.g. control is anchored to the right 704 // => compute the opposite side first 705 Result:=ComputePosition(ChildData,OppositeSide,Direction); 706 if Result<>crSuccess then begin 707 //DebugLn(['ComputePosition (side not anchored) FAILED computing opposite side: ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction]]); 708 exit; 709 end; 710 case ChildData.Sides[OppositeSide].DistanceState[Direction] of 711 assdfValid: 712 begin 713 // opposite side +- preferred size 714 NewDist:=ChildData.Sides[OppositeSide].Distance[Direction]; 715 if Side in [akLeft,akRight] then 716 CurSize:=ChildData.PreferredSize[asboHorizontal] 717 else 718 CurSize:=ChildData.PreferredSize[asboVertical]; 719 inc(NewDist,CurSize); 720 ChildData.Sides[Side].Distance[Direction]:=NewDist; 721 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 722 end; 723 assdfUncomputable: 724 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 725 else 726 raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable'); 727 end; 728 end else begin 729 // not anchored 730 if (Direction=assddLeftTop) = (Side in [akLeft,akTop]) then begin 731 NewDist:=ChildData.Sides[Side].Space; 732 ChildData.Sides[Side].Distance[Direction]:=NewDist; 733 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 734 end else begin 735 //DebugLn(['ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' not anchored, Direction=',AutoSizeSideDistDirectionNames[Direction],' => assdfUncomputable']); 736 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 737 end; 738 end; 739 if not (ChildData.Sides[Side].DistanceState[Direction] 740 in [assdfUncomputable,assdfValid]) 741 then begin 742 {$IFNDEF DisableChecks} 743 DebugLn(['TAutoSizeCtrlData.ComputePositions.ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' Direction=',AutoSizeSideDistDirectionNames[Direction]]); 744 {$ENDIF} 745 raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable'); 746 end; 747 Result:=crSuccess; 748 end; 749 750var 751 i: Integer; 752 Child: TControl; 753 ChildData: TAutoSizeCtrlData; 754 a: TAnchorKind; 755begin 756 Result:=false; 757 // for every side try to find a good distance to the client area 758 for i:=0 to ChildCount-1 do begin 759 Child:=WinControl.Controls[i]; 760 ChildData:=Children[Child]; 761 if not ChildData.Visible then continue; 762 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 763 if ComputePosition(ChildData,a,assddLeftTop)<>crSuccess then begin 764 {$IFNDEF DisableChecks} 765 DebugLn(['TAutoSizeCtrlData.ComputePositions Failed to compute LeftTop ',DbgSName(Child),' ',dbgs(a)]); 766 {$ENDIF} 767 exit; 768 end; 769 if ComputePosition(ChildData,a,assddRightBottom)<>crSuccess then begin 770 {$IFNDEF DisableChecks} 771 DebugLn(['TAutoSizeCtrlData.ComputePositions Failed to compute RightBottom ',DbgSName(Child),' ',dbgs(a)]); 772 {$ENDIF} 773 exit; 774 end; 775 end; 776 end; 777 //WriteDebugReport('ComputePositons',' '); 778 Result:=true; 779end; 780 781constructor TAutoSizeCtrlData.Create(AControl: TControl; IsParent: boolean); 782const 783 BigInteger = High(Integer) div 4; 784var 785 CurBorders: TRect; 786 a: TAnchorKind; 787 AdjustedClientRect: TRect; 788 r: TRect; 789begin 790 //DebugLn(['TAutoSizeCtrlData.Create ',DbgSName(AControl)]); 791 Control:=AControl; 792 if Control is TWinControl then begin 793 WinControl:=TWinControl(Control); 794 ChildCount:=WinControl.ControlCount; 795 end else 796 ChildCount:=0; 797 Visible:=Control.IsControlVisible; 798 Control.BorderSpacing.GetSpaceAround(CurBorders); 799 Borders[akLeft]:=CurBorders.Left; 800 Borders[akTop]:=CurBorders.Top; 801 Borders[akRight]:=CurBorders.Right; 802 Borders[akBottom]:=CurBorders.Bottom; 803 BaseBounds:=Control.BaseBounds; 804 if (BaseBounds.Left=BaseBounds.Right) 805 and (BaseBounds.Top=BaseBounds.Bottom) then 806 BaseBounds:=Control.BoundsRect; 807 BaseParentClientSize:=Control.BaseParentClientSize; 808 809 if (WinControl<>nil) and IsParent then begin 810 AdjustedClientRect:=Rect(0,0,BigInteger,BigInteger); 811 WinControl.AdjustClientRect(AdjustedClientRect); 812 AdjustedClientBorders[akLeft]:=AdjustedClientRect.Left; 813 AdjustedClientBorders[akTop]:=AdjustedClientRect.Top; 814 AdjustedClientBorders[akRight]:=BigInteger-AdjustedClientRect.Right; 815 AdjustedClientBorders[akBottom]:=BigInteger-AdjustedClientRect.Bottom; 816 end else begin 817 for a:=low(TAnchorKind) to high(TAnchorKind) do 818 AdjustedClientBorders[a]:=0; 819 if (BaseParentClientSize.cx=0) and (BaseParentClientSize.cy=0) then begin 820 r:=Control.Parent.GetLogicalClientRect; 821 BaseParentClientSize.cx:=r.Right; 822 BaseParentClientSize.cy:=r.Bottom; 823 end; 824 end; 825end; 826 827destructor TAutoSizeCtrlData.Destroy; 828begin 829 Clear; 830 FreeAndNil(FChilds); 831 inherited Destroy; 832end; 833 834procedure TAutoSizeCtrlData.Clear; 835begin 836 ClearSides; 837 if FChilds<>nil then 838 FChilds.FreeAndClear; 839end; 840 841procedure TAutoSizeCtrlData.DoMoveNonAlignedChildren(Side: TAnchorKind; 842 var MoveDiff: integer; FindMinimum: boolean); 843var 844 i: Integer; 845 Child: TControl; 846 MoveDiffValid: Boolean; 847 ChildData: TAutoSizeCtrlData; 848 AddSpace: LongInt; 849 Position: Integer; 850begin 851 MoveDiffValid:=false; 852 for i:=0 to ChildCount-1 do begin 853 Child:=WinControl.Controls[i]; 854 ChildData:=Children[Child]; 855 if not ChildData.Visible then continue; 856 if IsNotAligned(Child, Side) then begin 857 // this is a non aligned control 858 //DebugLn(['TAutoSizeCtrlData.DoMoveNonAlignedChilds Child=',DbgSName(Child),' Side=',dbgs(Side)]); 859 if FindMinimum then begin 860 AddSpace:=Child.BorderSpacing.GetSideSpace(Side); 861 if Side=akLeft then 862 AddSpace:=Max(AddSpace,WinControl.ChildSizing.LeftRightSpacing) 863 else 864 AddSpace:=Max(AddSpace,WinControl.ChildSizing.TopBottomSpacing); 865 Position:=Child.GetSidePosition(Side) 866 -AddSpace 867 -AdjustedClientBorders[Side]; 868 if (not MoveDiffValid) or (MoveDiff>Position) then 869 begin 870 MoveDiff:=Position; 871 MoveDiffValid:=true; 872 end; 873 end else begin 874 SetFixedLeftTop(ChildData,Side,Child.GetSidePosition(Side)-MoveDiff); 875 end; 876 end else if (Child.Align=alCustom) 877 and (Side in AnchorAlign[alCustom]) then begin 878 if FindMinimum then begin 879 // no auto move 880 end else begin 881 // don't move alCustom, but use them for bounds computation 882 SetFixedLeftTop(ChildData,Side,Child.GetSidePosition(Side)); 883 end; 884 end; 885 end; 886end; 887 888procedure TAutoSizeCtrlData.SetupNonAlignedChildren(MoveNonAlignedChildrenLeft, 889 MoveNonAlignedChildrenTop: boolean); 890var 891 ChildSizing: TControlChildSizing; 892 Box: TAutoSizeBox; 893 y: Integer; 894 RowBox: TAutoSizeBox; 895 x: Integer; 896 ControlBox: TAutoSizeBox; 897 Child: TControl; 898 NewBounds: TRect; 899 ChildData: TAutoSizeCtrlData; 900 MoveDiff: Integer; 901 AlignList: TFPList; 902 r: TRect; 903 i: Integer; 904begin 905 if ChildCount=0 then exit; 906 if WinControl.ChildSizing.Layout=cclNone then begin 907 // move the non-aligned controls (i.e. not aligned or fixed anchored) 908 // Find the leftmost and topmost of those controls 909 MoveDiff:=0; 910 DoMoveNonAlignedChildren(akLeft,MoveDiff,true); 911 //DebugLn(['TAutoSizeCtrlData.ComputePreferredClientArea akLeft MoveDiff=',MoveDiff]); 912 if not MoveNonAlignedChildrenLeft then MoveDiff:=0; 913 DoMoveNonAlignedChildren(akLeft,MoveDiff,false); 914 MoveDiff:=0; 915 DoMoveNonAlignedChildren(akTop,MoveDiff,true); 916 //DebugLn(['TAutoSizeCtrlData.ComputePreferredClientArea akTop MoveDiff=',MoveDiff]); 917 if not MoveNonAlignedChildrenTop then MoveDiff:=0; 918 DoMoveNonAlignedChildren(akTop,MoveDiff,false); 919 end else begin 920 // there is an automatic layout for non aligned children 921 // use the layout engine, but with static values 922 ChildSizing:=nil; 923 Box:=nil; 924 AlignList:=TFPList.Create; 925 try 926 for i:=0 to WinControl.ControlCount-1 do begin 927 Child:=WinControl.Controls[i]; 928 if Child.IsControlVisible and IsNotAligned(Child) then 929 AlignList.Add(Child); 930 end; 931 if AlignList.Count=0 then exit; 932 ChildSizing:=TControlChildSizing.Create(nil); 933 Box:=TAutoSizeBox.Create; 934 // copy current ChildSizing ... 935 ChildSizing.Assign(WinControl.ChildSizing); 936 // ... and change it to static layout (i.e. independent of parent size) 937 ChildSizing.ShrinkHorizontal:=crsAnchorAligning; 938 ChildSizing.EnlargeHorizontal:=crsAnchorAligning; 939 ChildSizing.ShrinkVertical:=crsAnchorAligning; 940 ChildSizing.EnlargeVertical:=crsAnchorAligning; 941 // compute static layout 942 r:=WinControl.GetLogicalClientRect; 943 Box.AlignControlsInTable(AlignList,ChildSizing,WinControl.BiDiMode, 944 r.Right,r.Bottom,false); 945 //Box.WriteDebugReport('TAutoSizeCtrlData.SetupNonAlignedChilds'); 946 // transfer the coords of the layout 947 for y:=0 to Box.ChildCount[asboVertical]-1 do begin 948 RowBox:=Box.Children[asboVertical][y]; 949 for x:=0 to RowBox.ChildCount[asboHorizontal]-1 do begin 950 ControlBox:=RowBox.Children[asboHorizontal][x]; 951 Child:=ControlBox.Control; 952 if Child=nil then continue; 953 NewBounds:=ControlBox.NewControlBounds; 954 //DebugLn(['TAutoSizeCtrlData.SetupNonAlignedChilds ',DbgSName(Child),' ',dbgs(NewBounds)]); 955 ChildData:=Children[Child]; 956 // set left 957 SetFixedLeftTop(ChildData,akLeft,NewBounds.Left); 958 // set width 959 ChildData.PreferredSize[asboHorizontal]:=NewBounds.Right-NewBounds.Left; 960 // set top 961 SetFixedLeftTop(ChildData,akTop,NewBounds.Top); 962 // set height 963 ChildData.PreferredSize[asboVertical]:=NewBounds.Bottom-NewBounds.Top; 964 end; 965 end; 966 finally 967 ChildSizing.Free; 968 Box.Free; 969 AlignList.Free; 970 end; 971 end; 972end; 973 974procedure TAutoSizeCtrlData.ComputePreferredClientArea( 975 MoveNonAlignedChildrenLeft, MoveNonAlignedChildrenTop: boolean; out 976 MoveNonAlignedToLeft, MoveNonAlignedToTop, PreferredClientWidth, 977 PreferredClientHeight: integer); 978{ if MoveNonAlignedChilds=true then all non-aligned children will be moved in 979 parallel, so that at least one child is positioned left most and one child 980 is positioned top most. 981 982 Type of controls: 983 1. layout: the left and top side of the control has only designed position 984 and Parent.ChildSizing.Layout <> cclNone. 985 That means: Align=alNone, Anchors=[akLeft,akTop], 986 AnchorSide[akLeft/akTop].Control=nil, Parent.ChildSizing.Layout <> cclNone 987 2. non-aligned: the left+top side of the control has only a designed position. 988 That means: Align=alNone, akLeft is set, AnchorSide[akLeft].Control=nil 989 and Parent.ChildSizing.Layout=cclNone 990 Same for akTop. 991 3. Aligned: Align<>alNone 992 These are put consecutively into the remaining space. 993 BorderSpacing and AdjustClientRect defines the space. 994 The aligned sides automatically set the Anchors and the AnchorSide.Control 995 to nil. 996 alLeft,alRight,alTop,alBottom have one free side, which can be anchored. 997 4. centered: akLeft and akRight are not set 998 5. one side anchored: akLeft is set and akRight is not 999 OR akRight is set and akLeft is not 1000 5.1 anchored to a side (asrLeft,asrRight) 1001 5.2 anchored to a center (asrCenter) 1002 6. both sides anchored: akLeft and akRight not 1003 Note: asrCenter is not allowed here 1004 1005 Circles and invalid combinations will be automatically fixed. 1006} 1007 1008 procedure InitPreferredSizes; 1009 var 1010 i: Integer; 1011 Child: TControl; 1012 ChildData: TAutoSizeCtrlData; 1013 CurAnchors: TAnchors; 1014 CurPreferredWidth: integer; 1015 CurPreferredHeight: integer; 1016 UseCurrentWidth: Boolean; 1017 UseCurrentHeight: Boolean; 1018 NewWidth: LongInt; 1019 NewHeight: LongInt; 1020 begin 1021 for i:=0 to ChildCount-1 do begin 1022 Child:=WinControl.Controls[i]; 1023 ChildData:=Children[Child]; 1024 if ChildData.Visible then begin 1025 CurAnchors:=Child.Anchors; 1026 if Child.Align in [alLeft,alRight,alTop,alBottom,alClient] then 1027 CurAnchors:=CurAnchors+AnchorAlign[Child.Align]; 1028 // check if the current Width and/or Height of the Child control can be 1029 // used. For example: The current Width can be used, if it is independent 1030 // of the parent's width. 1031 UseCurrentWidth:=true; 1032 if Child.AutoSize 1033 or ([akLeft,akRight]*CurAnchors=[akLeft,akRight]) then 1034 UseCurrentWidth:=false; 1035 UseCurrentHeight:=true; 1036 if Child.AutoSize 1037 or ([akTop,akBottom]*CurAnchors=[akTop,akBottom]) then 1038 UseCurrentHeight:=false; 1039 1040 if (not UseCurrentWidth) or (not UseCurrentHeight) then 1041 Child.GetPreferredSize(CurPreferredWidth,CurPreferredHeight,true,true); 1042 1043 //if Child.Name='OtherInfoGroupBox' then debugln(['InitPreferredSizes ',DbgSName(Child),' Bounds=',dbgs(Child.BoundsRect),' Anchors=',dbgs(Child.Anchors),' CurAnchors=',dbgs(CurAnchors),' UseW=',UseCurrentWidth,' UseH=',UseCurrentHeight,' Pref=',CurPreferredWidth,'x',CurPreferredHeight]); 1044 if UseCurrentWidth then 1045 NewWidth:=Child.Width 1046 else if (CurPreferredWidth>0) 1047 or ((CurPreferredWidth=0) and (csAutoSize0x0 in Child.ControlStyle)) then 1048 NewWidth:=CurPreferredWidth 1049 else 1050 NewWidth:=Max(1,Child.GetDefaultWidth); 1051 NewWidth:=Child.Constraints.MinMaxWidth(NewWidth); 1052 1053 if UseCurrentHeight then 1054 NewHeight:=Child.Height 1055 else if (CurPreferredHeight>0) 1056 or ((CurPreferredHeight=0) and (csAutoSize0x0 in Child.ControlStyle)) then 1057 NewHeight:=CurPreferredHeight 1058 else 1059 NewHeight:=Max(1,Child.GetDefaultHeight); 1060 NewHeight:=Child.Constraints.MinMaxHeight(NewHeight); 1061 end else begin 1062 NewWidth:=0; 1063 NewHeight:=0; 1064 end; 1065 1066 ChildData.PreferredSize[asboHorizontal]:=NewWidth; 1067 ChildData.PreferredSize[asboVertical]:=NewHeight; 1068 //DebugLn(['InitPreferredSizes Child=',DbgSName(Child),' PrefSize=',NewWidth,',',NewHeight]); 1069 end; 1070 end; 1071 1072 procedure GetSideAnchor(ChildData: TAutoSizeCtrlData; a: TAnchorKind); 1073 var 1074 Child: TControl; 1075 ReferenceControl: TControl; 1076 ReferenceSide: TAnchorSideReference; 1077 Position: Integer; 1078 begin 1079 Child:=ChildData.Control; 1080 Child.AnchorSide[a].GetSidePosition(ReferenceControl,ReferenceSide,Position); 1081 //DebugLn(['GetSideAnchor Child=',DbgSName(Child),', a=',dbgs(a),' ReferenceControl=',DbgSName(ReferenceControl),' ReferenceSide=',dbgs(a,ReferenceSide)]); 1082 if ReferenceControl=nil then begin 1083 // invalid anchor 1084 // => anchor to parent 1085 ChildData.Sides[a].CtrlData:=Self; 1086 if a in [akLeft,akTop] then 1087 ChildData.Sides[a].Side:=asrLeft 1088 else 1089 ChildData.Sides[a].Side:=asrRight; 1090 exit; 1091 end; 1092 if ReferenceControl=Control then 1093 ChildData.Sides[a].CtrlData:=Self 1094 else if (ReferenceControl<>nil) and (ReferenceControl.Parent=Control) then 1095 ChildData.Sides[a].CtrlData:=Children[ReferenceControl]; 1096 ChildData.Sides[a].Side:=ReferenceSide; 1097 //if ChildData.Sides[a].CtrlData<>nil then DebugLn(['GetSideAnchor Child=',DbgSName(Child),', a=',dbgs(a),' ReferenceControl=',DbgSName(ChildData.Sides[a].CtrlData.Control),' ReferenceSide=',dbgs(a,ChildData.Sides[a].Side)]); 1098 end; 1099 1100var 1101 i: Integer; 1102 VisibleCount: Integer; 1103 Child: TControl; 1104 ChildData: TAutoSizeCtrlData; 1105 a: TAnchorKind; 1106 CurNeededClientWH: Integer; 1107begin 1108 PreferredClientWidth:=0; 1109 PreferredClientHeight:=0; 1110 MoveNonAlignedToLeft:=0; 1111 MoveNonAlignedToTop:=0; 1112 1113 if ChildCount=0 then exit; 1114 1115 // fix control properties 1116 // check if there are visible children 1117 VisibleCount:=0; 1118 for i:=0 to ChildCount-1 do begin 1119 Child:=WinControl.Controls[i]; 1120 FixControlProperties(Child); 1121 ChildData:=Children[Child]; 1122 if ChildData.Visible then 1123 inc(VisibleCount); 1124 end; 1125 //DebugLn(['TAutoSizeCtrlData.ComputePreferredClientArea ',DbgSName(Control),' VisibleCount=',VisibleCount]); 1126 if VisibleCount=0 then begin 1127 // nothing to do 1128 exit; 1129 end; 1130 1131 InitPreferredSizes; 1132 1133 repeat 1134 // init dependencies 1135 for i:=0 to ChildCount-1 do begin 1136 Child:=WinControl.Controls[i]; 1137 ChildData:=Children[Child]; 1138 ChildData.ClearSides; 1139 if not ChildData.Visible then continue; 1140 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1141 ChildData.Sides[a].Side:=asrLeft; 1142 if (Child.Align in [alLeft,alRight,alTop,alBottom,alClient]) 1143 and (a in AnchorAlign[Child.Align]) then begin 1144 // this is an aligned side 1145 // => the dependencies will be setup later in AlignChilds 1146 end else if a in Child.Anchors then begin 1147 // this is an anchored side 1148 GetSideAnchor(ChildData,a); 1149 end else begin 1150 // this is a dangling side 1151 end; 1152 end; 1153 end; 1154 //WriteDebugReport('anchored',''); 1155 1156 SetupNonAlignedChildren(MoveNonAlignedChildrenLeft,MoveNonAlignedChildrenTop); 1157 //WriteDebugReport('nonaligned',''); 1158 // setup the dependencies for Aligned controls 1159 AlignChildren; 1160 //WriteDebugReport('aligned',''); 1161 1162 // setup space for dependencies 1163 SetupSpace; 1164 {$IFDEF VerboseAutoSizeCtrlData} 1165 WriteDebugReport('Space completed',''); 1166 {$ENDIF} 1167 1168 // calculate the needed positions for all children 1169 until ComputePositions; 1170 1171 {$IFDEF VerboseAutoSizeCtrlData} 1172 if WinControl.ClassName='TScrollBox' then 1173 WriteDebugReport('Positions completed',''); 1174 {$ENDIF} 1175 1176 // compute needed clientwidth/clientheight 1177 for i:=0 to ChildCount-1 do begin 1178 Child:=WinControl.Controls[i]; 1179 ChildData:=Children[Child]; 1180 if not ChildData.Visible then continue; 1181 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1182 if (ChildData.Sides[a].DistanceState[assddLeftTop]=assdfValid) 1183 and (ChildData.Sides[a].DistanceState[assddRightBottom]=assdfValid) 1184 then begin 1185 CurNeededClientWH:=ChildData.Sides[a].Distance[assddLeftTop] 1186 +ChildData.Sides[a].Distance[assddRightBottom]; 1187 if a in [akLeft,akRight] then begin 1188 if PreferredClientWidth<CurNeededClientWH then 1189 PreferredClientWidth:=CurNeededClientWH; 1190 end else begin 1191 if PreferredClientHeight<CurNeededClientWH then 1192 PreferredClientHeight:=CurNeededClientWH; 1193 end; 1194 end; 1195 end; 1196 end; 1197 1198 // compute needed MoveNonAlignedToLeft,MoveNonAlignedToTop 1199 if MoveNonAlignedChildrenLeft or MoveNonAlignedChildrenTop then 1200 begin 1201 MoveNonAlignedToLeft:=Low(integer); 1202 MoveNonAlignedToTop:=Low(integer); 1203 for i:=0 to ChildCount-1 do 1204 begin 1205 Child:=WinControl.Controls[i]; 1206 ChildData:=Children[Child]; 1207 if not Child.IsControlVisible then continue; 1208 if IsNotAligned(Child, akLeft) then 1209 begin 1210 if MoveNonAlignedChildrenLeft 1211 and (ChildData.Sides[akLeft].DistanceState[assddLeftTop]=assdfValid) then 1212 MoveNonAlignedToLeft:=Max(MoveNonAlignedToLeft, 1213 Child.Left-ChildData.Sides[akLeft].Distance[assddLeftTop]); 1214 { the below is only correct, if PreferredClientWidth is realized. 1215 if (ChildData.Sides[akLeft].DistanceState[assddRightBottom]=assdfValid) then 1216 MoveNonAlignedToLeft:=Min(MoveNonAlignedToLeft, 1217 Child.Left 1218 -(PreferredClientWidth 1219 -ChildData.Sides[akLeft].Distance[assddRightBottom]));} 1220 end; 1221 if IsNotAligned(Child, akTop) then 1222 begin 1223 if MoveNonAlignedChildrenTop 1224 and (ChildData.Sides[akTop].DistanceState[assddLeftTop]=assdfValid) then 1225 MoveNonAlignedToTop:=Max(MoveNonAlignedToTop, 1226 Child.Top-ChildData.Sides[akTop].Distance[assddLeftTop]); 1227 { the below is only correct, if PreferredClientWidth is realized. 1228 if (ChildData.Sides[akTop].DistanceState[assddRightBottom]=assdfValid) then 1229 MoveNonAlignedToTop:=Min(MoveNonAlignedToTop, 1230 Child.Top 1231 -(PreferredClientHeight 1232 -ChildData.Sides[akTop].Distance[assddRightBottom]));} 1233 end; 1234 end; 1235 if MoveNonAlignedToLeft=Low(integer) then MoveNonAlignedToLeft:=0; 1236 if MoveNonAlignedToTop=Low(integer) then MoveNonAlignedToTop:=0; 1237 end; 1238 1239 {$IFDEF VerboseAutoSizeCtrlData} 1240 //if WinControl.ClassName='TProjectVersionInfoOptionsFrame' then 1241 DebugLn(['TAutoSizeCtrlData.ComputePreferredClientArea END ',DbgSName(Control),' PreferredClientWidth/height=',PreferredClientWidth,',',PreferredClientHeight]); 1242 {$ENDIF} 1243end; 1244 1245procedure TAutoSizeCtrlData.FixControlProperties(Child: TControl); 1246var 1247 a: TAnchorKind; 1248begin 1249 // check that all anchor-controls are siblings or the parent 1250 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1251 if Child.AnchorSide[a].Control=nil then continue; 1252 if Child.AnchorSide[a].Control=Control then continue; 1253 if (Child.AnchorSide[a].Control=Child) 1254 or (Child.AnchorSide[a].Control.Parent<>Control) then begin 1255 {$IFNDEF DisableChecks} 1256 DebugLn(['TAutoSizeCtrlData.FixControlProperties ',DbgSName(Child),' a=',dbgs(a),' old=',DbgSName(Child.AnchorSide[a].Control),' new=nil']); 1257 {$ENDIF} 1258 Child.AnchorSide[a].Control:=nil; 1259 end; 1260 end; 1261 1262 if Child.Align in [alLeft,alRight,alTop,alBottom,alClient] then begin 1263 // the aligned sides must be anchored 1264 Child.Anchors:=Child.Anchors+AnchorAlign[Child.Align]; 1265 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1266 if a in AnchorAlign[Child.Align] then begin 1267 // the aligned sides can not be anchored to a control 1268 {$IFNDEF DisableChecks} 1269 if Child.AnchorSide[a].Control<>nil then 1270 DebugLn(['TAutoSizeCtrlData.FixControlProperties aligned sides can not be anchored ',DbgSName(Child),' a=',dbgs(a),' old=',DbgSName(Child.AnchorSide[a].Control),' new=nil']); 1271 {$ENDIF} 1272 Child.AnchorSide[a].Control:=nil; 1273 end; 1274 if Child.AnchorSide[a].Side=asrCenter then begin 1275 // an aligned control can not be centered 1276 {$IFNDEF DisableChecks} 1277 DebugLn(['TAutoSizeCtrlData.FixControlProperties aligned control can not be centered ',DbgSName(Child),' a=',dbgs(a)]); 1278 {$ENDIF} 1279 Child.AnchorSide[a].Side:=asrLeft; 1280 if not (a in AnchorAlign[Child.Align]) then begin 1281 Child.Anchors:=Child.Anchors-[a]; 1282 Child.AnchorSide[a].Control:=nil; 1283 end; 1284 end; 1285 end; 1286 end else begin 1287 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1288 if (a in Child.Anchors) 1289 and (Child.AnchorSide[a].Side=asrCenter) then begin 1290 if Child.AnchorSide[a].Control<>nil then begin 1291 // the control should be centered relative to another control 1292 if a in [akLeft,akTop] then begin 1293 // un-anchor the other side 1294 {$IFNDEF DisableChecks} 1295 if OppositeAnchor[a] in Child.Anchors then 1296 DebugLn(['TAutoSizeCtrlData.FixControlProperties control is center-anchored -> unanchor opposite side: ',DbgSName(Child),' a=',dbgs(a)]); 1297 {$ENDIF} 1298 Child.Anchors:=Child.Anchors-[OppositeAnchor[a]]; 1299 Child.AnchorSide[OppositeAnchor[a]].Control:=nil; 1300 end else begin 1301 // the centering was setup via the right,bottom 1302 // => normalize it to center via the Left,Top 1303 DebugLn(['TAutoSizeCtrlData.FixControlProperties control is center-anchored -> normalize it to use Left,Top instead of Bottom,Right: ',DbgSName(Child),' a=',dbgs(a)]); 1304 Child.AnchorSide[OppositeAnchor[a]].Control:=Child.AnchorSide[a].Control; 1305 Child.AnchorSide[OppositeAnchor[a]].Side:=asrCenter; 1306 Child.AnchorSide[a].Control:=nil; 1307 Child.AnchorSide[a].Side:=asrLeft; 1308 Child.Anchors:=Child.Anchors+[OppositeAnchor[a]]-[a]; 1309 end; 1310 end else begin 1311 // the asrCenter is not active => ok 1312 end; 1313 end; 1314 end; 1315 end; 1316end; 1317 1318procedure TAutoSizeCtrlData.ClearSides; 1319var 1320 a: TAnchorKind; 1321 d: TAutoSizeSideDistDirection; 1322begin 1323 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1324 FillChar(Sides[a],SizeOf(TAutoSizeSideData),0); 1325 for d:=Low(TAutoSizeSideDistDirection) to High(TAutoSizeSideDistDirection) do 1326 Sides[a].DistanceState[d]:=assdfInvalid; 1327 end; 1328end; 1329 1330procedure TAutoSizeCtrlData.SetFixedLeftTop(ChildData: TAutoSizeCtrlData; 1331 Side: TAnchorKind; NewLeftTop: integer); 1332begin 1333 ChildData.Sides[Side].CtrlData:=Self; 1334 ChildData.Sides[Side].Side:=asrLeft; 1335 ChildData.Sides[Side].Space:=NewLeftTop; 1336 ChildData.Sides[Side].Distance[assddLeftTop]:=NewLeftTop; 1337 ChildData.Sides[Side].DistanceState[assddLeftTop]:=assdfValid; 1338end; 1339 1340procedure TAutoSizeCtrlData.WriteDebugReport(const Title, Prefix: string; 1341 OnlyVisible: boolean); 1342 1343 function GetDistance(a: TAnchorKind; d: TAutoSizeSideDistDirection): string; 1344 begin 1345 case Sides[a].DistanceState[d] of 1346 assdfInvalid: Result:='invalid'; 1347 assdfComputing: Result:='computing'; 1348 assdfUncomputable: Result:='uncomputable'; 1349 assdfValid: Result:=dbgs(Sides[a].Distance[d]); 1350 else Result:='???'; 1351 end; 1352 end; 1353 1354 function GetSideControl(a: TAnchorKind): string; 1355 begin 1356 if Sides[a].CtrlData<>nil then 1357 Result:=DbgSName(Sides[a].CtrlData.Control) 1358 else 1359 Result:='nil'; 1360 end; 1361 1362var 1363 a: TAnchorKind; 1364 i: Integer; 1365begin 1366 if Title<>'' then 1367 DebugLn([Prefix,'TAutoSizeCtrlData.WriteDebugReport ',Title]); 1368 DebugLn([Prefix,' Control=',DbgSName(Control),' ChildCount=',ChildCount,' Visible=',Visible,' Anchors=',dbgs(Control.Anchors),' Align=',dbgs(Control.Align)]); 1369 Debugln([Prefix,' PreferredSize=',PreferredSize[asboHorizontal],',',PreferredSize[asboVertical]]); 1370 DebugLn([Prefix,' Borders=l=',Borders[akLeft],',t=',Borders[akTop],',r=',Borders[akRight],',b=',Borders[akBottom]]); 1371 DebugLn([Prefix,' AdjustedClientBorders=l=',AdjustedClientBorders[akLeft],',t=',AdjustedClientBorders[akTop],',r=',AdjustedClientBorders[akRight],',b=',AdjustedClientBorders[akBottom]]); 1372 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1373 DebugLn([Prefix,' Side ',dbgs(a),' Control=',GetSideControl(a), 1374 ' RefSide=',dbgs(a,Sides[a].Side), 1375 ' Space=',Sides[a].Space, 1376 ' DistLT=',GetDistance(a,assddLeftTop), 1377 ' DistBR=',GetDistance(a,assddRightBottom)]); 1378 end; 1379 for i:=0 to ChildCount-1 do 1380 if WinControl.Controls[i].Visible or (not OnlyVisible) then 1381 Children[WinControl.Controls[i]].WriteDebugReport('',Prefix+dbgs(i)+': '); 1382end; 1383 1384{ TAutoSizeBox } 1385 1386procedure TAutoSizeBox.SetControl(AControl: TControl); 1387var 1388 Border: TRect; 1389 AutoSize0x0: Boolean; 1390 IsPrefWidthValid: Boolean; 1391 IsPrefHeightValid: Boolean; 1392begin 1393 Control:=AControl; 1394 MinimumSize[asboHorizontal]:=Control.Constraints.EffectiveMinWidth; 1395 MinimumSize[asboVertical]:=Control.Constraints.EffectiveMinHeight; 1396 MaximumSize[asboHorizontal]:=Control.Constraints.EffectiveMaxWidth; 1397 MaximumSize[asboVertical]:=Control.Constraints.EffectiveMaxHeight; 1398 Control.GetPreferredSize(PreferredSize[asboHorizontal], 1399 PreferredSize[asboVertical], 1400 true, // without constraints 1401 true // with theme space 1402 ); 1403 //DebugLn(['TAutoSizeBox.SetControl ',DbgSName(Control),' ',PreferredSize[asboHorizontal]]); 1404 AutoSize0x0:=csAutoSize0x0 in Control.ControlStyle; 1405 IsPrefWidthValid:=(PreferredSize[asboHorizontal]>0) 1406 or (AutoSize0x0 and (PreferredSize[asboHorizontal]=0)); 1407 IsPrefHeightValid:=(PreferredSize[asboVertical]>0) 1408 or (AutoSize0x0 and (PreferredSize[asboVertical]=0)); 1409 1410 // apply constraints 1411 if IsPrefWidthValid then 1412 PreferredSize[asboHorizontal]:= 1413 Control.Constraints.MinMaxWidth(PreferredSize[asboHorizontal]); 1414 if IsPrefHeightValid then 1415 PreferredSize[asboVertical]:= 1416 Control.Constraints.MinMaxHeight(PreferredSize[asboVertical]); 1417 1418 if IsPrefWidthValid 1419 and (Control.AutoSize or (Control.BorderSpacing.CellAlignHorizontal<>ccaFill)) 1420 then begin 1421 // the control.width is fixed to its preferred width 1422 MaximumSize[asboHorizontal]:=PreferredSize[asboHorizontal]; 1423 end; 1424 if IsPrefHeightValid 1425 and (Control.AutoSize or (Control.BorderSpacing.CellAlignVertical<>ccaFill)) 1426 then begin 1427 // the control.height is fixed to its preferred height 1428 MaximumSize[asboVertical]:=PreferredSize[asboVertical]; 1429 end; 1430 1431 // if no preferred size is valid use the class defaults 1432 if not IsPrefWidthValid then 1433 PreferredSize[asboHorizontal]:= 1434 Control.Constraints.MinMaxWidth(Control.Scale96ToFont(Control.GetControlClassDefaultSize.CX)); 1435 if not IsPrefHeightValid then 1436 PreferredSize[asboVertical]:= 1437 Control.Constraints.MinMaxHeight(Control.Scale96ToFont(Control.GetControlClassDefaultSize.CY)); 1438 1439 //DebugLn(['TAutoSizeBox.SetControl ',DbgSName(Control),' ',PreferredSize[asboHorizontal]]); 1440 Control.BorderSpacing.GetSpaceAround(Border); 1441 BorderLeftTop[asboHorizontal]:=Border.Left; 1442 BorderLeftTop[asboVertical]:=Border.Top; 1443 BorderRightBottom[asboHorizontal]:=Border.Right; 1444 BorderRightBottom[asboVertical]:=Border.Bottom; 1445end; 1446 1447procedure TAutoSizeBox.AllocateChildsArray(Orientation: TAutoSizeBoxOrientation; 1448 NewChildCount: Integer); 1449var 1450 Size: Integer; 1451begin 1452 Size:=NewChildCount*SizeOf(Pointer); 1453 ReallocMem(Children[Orientation],Size); 1454 if Size>0 then 1455 FillChar(Children[Orientation][0],Size,0); 1456 ChildCount[Orientation]:=NewChildCount; 1457end; 1458 1459procedure TAutoSizeBox.AllocateTable(ColCount, RowCount: Integer); 1460{ This creates a ColCount x RowCount number of cells, 1461 and a Row of Columns and a Column of Rows. 1462 1463 +-++-++-++-+ +----------+ 1464 | || || || | | | 1465 | || || || | +----------+ 1466 | || || || | +----------+ 1467 | || || || | | | 1468 | || || || | +----------+ 1469 | || || || | +----------+ 1470 | || || || | | | 1471 +-++-++-++-+ +----------+ 1472 1473} 1474var 1475 x, y: Integer; 1476 RowBox: TAutoSizeBox; 1477 ColBox: TAutoSizeBox; 1478 CellBox: TAutoSizeBox; 1479begin 1480 AllocateChildsArray(asboHorizontal,ColCount); 1481 AllocateChildsArray(asboVertical,RowCount); 1482 // create columns 1483 for x:=0 to ColCount-1 do begin 1484 ColBox:=TAutoSizeBox.Create; 1485 Children[asboHorizontal][x]:=ColBox; 1486 ColBox.AllocateChildsArray(asboVertical,RowCount); 1487 ColBox.Parent[asboHorizontal]:=Self; 1488 ColBox.Index[asboHorizontal]:=x; 1489 ColBox.Index[asboVertical]:=-1; 1490 end; 1491 // create rows 1492 for y:=0 to RowCount-1 do begin 1493 RowBox:=TAutoSizeBox.Create; 1494 Children[asboVertical][y]:=RowBox; 1495 RowBox.AllocateChildsArray(asboHorizontal,ColCount); 1496 RowBox.Parent[asboVertical]:=Self; 1497 RowBox.Index[asboHorizontal]:=-1; 1498 RowBox.Index[asboVertical]:=y; 1499 end; 1500 // create cells 1501 for y:=0 to RowCount-1 do begin 1502 RowBox:=Children[asboVertical][y]; 1503 for x:=0 to ColCount-1 do begin 1504 ColBox:=Children[asboHorizontal][x]; 1505 CellBox:=TAutoSizeBox.Create; 1506 RowBox.Children[asboHorizontal][x]:=CellBox; 1507 ColBox.Children[asboVertical][y]:=CellBox; 1508 CellBox.Parent[asboHorizontal]:=RowBox; 1509 CellBox.Parent[asboVertical]:=ColBox; 1510 CellBox.Index[asboHorizontal]:=x; 1511 CellBox.Index[asboVertical]:=y; 1512 end; 1513 end; 1514end; 1515 1516procedure TAutoSizeBox.SetTableControls(ListOfControls: TFPList; 1517 ChildSizing: TControlChildSizing; BiDiMode: TBiDiMode); 1518var 1519 i: Integer; 1520 Row: LongInt; 1521 Col: LongInt; 1522 ChildControl: TControl; 1523 ChildBox: TAutoSizeBox; 1524 RowCount: LongInt; 1525 ColCount: Integer; 1526 LineMax: LongInt; 1527begin 1528 // allocate table 1529 case ChildSizing.Layout of 1530 cclLeftToRightThenTopToBottom: 1531 begin 1532 ColCount:=Max(1,Min(ChildSizing.ControlsPerLine,ListOfControls.Count)); 1533 RowCount:=((ListOfControls.Count-1) div ColCount)+1; 1534 end; 1535 cclTopToBottomThenLeftToRight: 1536 begin 1537 RowCount:=Max(1,min(ChildSizing.ControlsPerLine,ListOfControls.Count)); 1538 ColCount:=((ListOfControls.Count-1) div RowCount)+1; 1539 end; 1540 else 1541 raise Exception.Create('TAutoSizeBox.SetTableControls TODO'); 1542 end; 1543 AllocateTable(ColCount,RowCount); 1544 1545 // set controls 1546 for i:=0 to ListOfControls.Count-1 do begin 1547 ChildControl:=TControl(ListOfControls[i]); 1548 case ChildSizing.Layout of 1549 cclLeftToRightThenTopToBottom: 1550 begin 1551 LineMax:=ChildCount[asboHorizontal]; 1552 Row:=i div LineMax; 1553 Col:=i mod LineMax; 1554 if (BiDiMode=bdRightToLeft) then 1555 Col:=LineMax-Col-1; 1556 ChildBox:=Children[asboHorizontal][Col].Children[asboVertical][Row]; 1557 ChildBox.SetControl(ChildControl); 1558 ChildBox.ApplyChildsizingBorders(ChildSizing); 1559 end; 1560 cclTopToBottomThenLeftToRight: 1561 begin 1562 LineMax:=ChildCount[asboVertical]; 1563 Col:=i div LineMax; 1564 Row:=i mod LineMax; 1565 if (BiDiMode=bdRightToLeft) then 1566 Col:=ChildCount[asboHorizontal]-Col-1; 1567 ChildBox:=Children[asboVertical][Row].Children[asboHorizontal][Col]; 1568 ChildBox.SetControl(ChildControl); 1569 ChildBox.ApplyChildsizingBorders(ChildSizing); 1570 end; 1571 end; 1572 end; 1573end; 1574 1575procedure TAutoSizeBox.ApplyChildSizingBorders(ChildSizing: TControlChildSizing); 1576var 1577 MinBorder: LongInt; 1578begin 1579 // left border 1580 if (Parent[asboHorizontal]=nil) or (Index[asboHorizontal]=0) then 1581 MinBorder:=ChildSizing.LeftRightSpacing 1582 else 1583 MinBorder:=ChildSizing.HorizontalSpacing; 1584 BorderLeftTop[asboHorizontal]:=Max(BorderLeftTop[asboHorizontal],MinBorder); 1585 1586 // right border 1587 if (Parent[asboHorizontal]=nil) 1588 or (Index[asboHorizontal]=Parent[asboHorizontal].ChildCount[asboHorizontal]-1) 1589 then 1590 MinBorder:=ChildSizing.LeftRightSpacing 1591 else 1592 MinBorder:=ChildSizing.HorizontalSpacing; 1593 BorderRightBottom[asboHorizontal]:=Max(BorderRightBottom[asboHorizontal], 1594 MinBorder); 1595 1596 // top border 1597 if (Parent[asboVertical]=nil) or (Index[asboVertical]=0) then 1598 MinBorder:=ChildSizing.TopBottomSpacing 1599 else 1600 MinBorder:=ChildSizing.VerticalSpacing; 1601 BorderLeftTop[asboVertical]:=Max(BorderLeftTop[asboVertical],MinBorder); 1602 1603 // bottom border 1604 if (Parent[asboVertical]=nil) 1605 or (Index[asboVertical]=Parent[asboVertical].ChildCount[asboVertical]-1) 1606 then 1607 MinBorder:=ChildSizing.TopBottomSpacing 1608 else 1609 MinBorder:=ChildSizing.VerticalSpacing; 1610 BorderRightBottom[asboVertical]:=Max(BorderRightBottom[asboVertical], 1611 MinBorder); 1612end; 1613 1614procedure TAutoSizeBox.InitSums; 1615 1616 procedure Init(o: TAutoSizeBoxOrientation); 1617 var 1618 FirstChild: TAutoSizeBox; 1619 begin 1620 if ChildCount[o]>0 then begin 1621 FirstChild:=Children[o][0]; 1622 MaximumSize[o]:=FirstChild.MaximumSize[o]; 1623 MinimumSize[o]:=FirstChild.MinimumSize[o]; 1624 PreferredSize[o]:=FirstChild.PreferredSize[o]; 1625 BorderLeftTop[o]:=FirstChild.BorderLeftTop[o]; 1626 BorderRightBottom[o]:=FirstChild.BorderRightBottom[o]; 1627 end else begin 1628 MaximumSize[o]:=0; 1629 MinimumSize[o]:=0; 1630 PreferredSize[o]:=0; 1631 BorderLeftTop[o]:=0; 1632 BorderRightBottom[o]:=0; 1633 end; 1634 end; 1635 1636begin 1637 Init(asboHorizontal); 1638 Init(asboVertical); 1639end; 1640 1641procedure TAutoSizeBox.SumLine(Orientation: TAutoSizeBoxOrientation; 1642 DoInit: boolean); 1643// total orientated minimum is the sum of all minimums plus borders 1644// total orientated maximum is the sum of all maximums plus borders 1645// total orientated preferred is the sum of all preferred plus borders 1646// total orthogonal minimum is the maximum of all minimums 1647// total orthogonal maximum is the minimum of all maximums 1648// total orthogonal preferred is the maximum of all preferred 1649var 1650 i: Integer; 1651 Orthogonal: TAutoSizeBoxOrientation; 1652 CurChild: TAutoSizeBox; 1653 CurBorder: integer; 1654 LastChild: TAutoSizeBox; 1655begin 1656 if DoInit then InitSums; 1657 Orthogonal:=SizeBoxOrthogonal[Orientation]; 1658 if ChildCount[Orientation]>0 then begin 1659 for i:=0 to ChildCount[Orientation]-1 do begin 1660 CurChild:=Children[Orientation][i]; 1661 1662 // add border in Orientation 1663 CurBorder:=CurChild.BorderLeftTop[Orientation]; 1664 if i>0 then 1665 CurBorder:=Max(Children[Orientation][i-1].BorderRightBottom[Orientation], 1666 CurBorder); 1667 if MaximumSize[Orientation]>0 then begin 1668 inc(MaximumSize[Orientation],CurBorder); 1669 end; 1670 inc(MinimumSize[Orientation],CurBorder); 1671 inc(PreferredSize[Orientation],CurBorder); 1672 // add item size in Orientation 1673 if MaximumSize[Orientation]>0 then begin 1674 if CurChild.MaximumSize[Orientation]>0 then 1675 inc(MaximumSize[Orientation],CurChild.MaximumSize[Orientation]) 1676 else 1677 MaximumSize[Orientation]:=0; 1678 end; 1679 inc(MinimumSize[Orientation],CurChild.MinimumSize[Orientation]); 1680 inc(PreferredSize[Orientation],CurChild.PreferredSize[Orientation]); 1681 1682 // maximize in Orthogonal 1683 if MaximumSize[Orthogonal]>0 then begin 1684 if CurChild.MaximumSize[Orthogonal]>0 then 1685 MaximumSize[Orthogonal]:=Max(MaximumSize[Orthogonal], 1686 CurChild.MaximumSize[Orthogonal]) 1687 else 1688 MaximumSize[Orthogonal]:=0; 1689 end; 1690 MinimumSize[Orthogonal]:=Max(MinimumSize[Orthogonal], 1691 CurChild.MinimumSize[Orthogonal]); 1692 PreferredSize[Orthogonal]:=Max(PreferredSize[Orthogonal], 1693 CurChild.PreferredSize[Orthogonal]); 1694 BorderLeftTop[Orthogonal]:=Max(BorderLeftTop[Orthogonal], 1695 CurChild.BorderLeftTop[Orthogonal]); 1696 BorderRightBottom[Orthogonal]:=Max(BorderRightBottom[Orthogonal], 1697 CurChild.BorderRightBottom[Orthogonal]); 1698 end; 1699 1700 // last border 1701 LastChild:=Children[Orientation][ChildCount[Orientation]-1]; 1702 BorderRightBottom[Orientation]:=LastChild.BorderRightBottom[Orientation]; 1703 end; 1704end; 1705 1706procedure TAutoSizeBox.SumTable; 1707var 1708 x: Integer; 1709 ColBox: TAutoSizeBox; 1710 y: Integer; 1711 RowBox: TAutoSizeBox; 1712begin 1713 // sum items in rows 1714 for y:=0 to ChildCount[asboVertical]-1 do begin 1715 RowBox:=Children[asboVertical][y]; 1716 RowBox.SumLine(asboHorizontal,true); 1717 end; 1718 // sum items in columns 1719 for x:=0 to ChildCount[asboHorizontal]-1 do begin 1720 ColBox:=Children[asboHorizontal][x]; 1721 ColBox.SumLine(asboVertical,true); 1722 end; 1723 // sum rows 1724 SumLine(asboVertical,true); 1725 // sum columns 1726 SumLine(asboHorizontal,false); 1727end; 1728 1729procedure TAutoSizeBox.ComputeLeftTops(Orientation: TAutoSizeBoxOrientation); 1730var 1731 i: Integer; 1732 Child: TAutoSizeBox; 1733 CurLeftTop: Integer; 1734 s: LongInt; 1735begin 1736 CurLeftTop:=0; 1737 for i:=0 to ChildCount[Orientation]-1 do begin 1738 Child:=Children[Orientation][i]; 1739 if i=0 then 1740 inc(CurLeftTop,Child.BorderLeftTop[Orientation]); 1741 Child.LeftTop[Orientation]:=CurLeftTop; 1742 inc(CurLeftTop,Child.PreferredSize[Orientation]); 1743 s:=Child.BorderRightBottom[Orientation]; 1744 if i<ChildCount[Orientation]-1 then 1745 s:=Max(s,Children[Orientation][i+1].BorderLeftTop[Orientation]); 1746 inc(CurLeftTop,s); 1747 end; 1748end; 1749 1750procedure TAutoSizeBox.ResizeChildren(ChildSizing: TControlChildSizing; 1751 Orientation: TAutoSizeBoxOrientation; TargetSize: integer); 1752type 1753 TResizeFactor = record 1754 Scale: double; 1755 Offset: integer; 1756 end; 1757var 1758 EnlargeStyle: TChildControlResizeStyle; 1759 ShrinkStyle: TChildControlResizeStyle; 1760 CurSize: LongInt; 1761 1762 function GetChildTotalSize: integer; 1763 // computes the total preferred size of all children of this Orientation 1764 var 1765 i: Integer; 1766 Child: TAutoSizeBox; 1767 s: LongInt; 1768 begin 1769 Result:=0; 1770 for i:=0 to ChildCount[Orientation]-1 do begin 1771 Child:=Children[Orientation][i]; 1772 if i=0 then 1773 inc(Result,Child.BorderLeftTop[Orientation]); 1774 if Child.PreferredSize[Orientation]<1 then 1775 Child.PreferredSize[Orientation]:=1; 1776 inc(Result,Child.PreferredSize[Orientation]); 1777 s:=Child.BorderRightBottom[Orientation]; 1778 if i<ChildCount[Orientation]-1 then 1779 s:=Max(s,Children[Orientation][i+1].BorderLeftTop[Orientation]); 1780 inc(Result,s); 1781 end; 1782 end; 1783 1784 procedure GetChildMaxResize(out Factor: TResizeFactor; 1785 out ResizeableCount: integer); 1786 // returns the number of children/gaps, that can grow (ResizeableCount) 1787 // and the maximum factor, by which the children/gaps can grow (TResizeFactor) 1788 var 1789 i: Integer; 1790 CurScale: Double; 1791 CurOffset: LongInt; 1792 Child: TAutoSizeBox; 1793 begin 1794 Factor.Scale:=0; 1795 Factor.Offset:=0; 1796 ResizeableCount:=0; 1797 case EnlargeStyle of 1798 1799 crsAnchorAligning: 1800 exit; // no resizing 1801 1802 crsScaleChilds,crsHomogenousChildResize: 1803 1804 for i:=0 to ChildCount[Orientation]-1 do begin 1805 Child:=Children[Orientation][i]; 1806 if (Child.MaximumSize[Orientation]>0) 1807 and (Child.PreferredSize[Orientation]>=Child.MaximumSize[Orientation]) 1808 then begin 1809 // this child can not be further enlarged 1810 continue; 1811 end; 1812 inc(ResizeableCount); 1813 1814 case EnlargeStyle of 1815 1816 crsScaleChilds, crsHomogenousChildResize: 1817 begin 1818 if Child.MaximumSize[Orientation]=0 then begin 1819 CurScale:=double(TargetSize); 1820 CurOffset:=TargetSize; 1821 end else begin 1822 CurScale:=double(Child.MaximumSize[Orientation]) 1823 /Child.PreferredSize[Orientation]; 1824 CurOffset:=Child.MaximumSize[Orientation] 1825 -Child.PreferredSize[Orientation]; 1826 end; 1827 if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin 1828 Factor.Scale:=CurScale; 1829 Factor.Offset:=CurOffset; 1830 end; 1831 end; 1832 1833 end; 1834 end; 1835 1836 crsHomogenousSpaceResize: 1837 if ChildCount[Orientation]>0 then begin 1838 Factor.Scale:=double(TargetSize); 1839 Factor.Offset:=TargetSize; 1840 ResizeableCount:=ChildCount[Orientation]+1; 1841 end; 1842 1843 else 1844 raise Exception.Create('TAutoSizeBox.ResizeChilds'); 1845 1846 end; 1847 end; 1848 1849 procedure EnlargeChilds(const Factor: TResizeFactor); 1850 var 1851 i: Integer; 1852 Child: TAutoSizeBox; 1853 DiffSize: Integer; 1854 NewSize: LongInt; 1855 OldSize: LongInt; 1856 begin 1857 for i:=0 to ChildCount[Orientation]-1 do begin 1858 if TargetSize=CurSize then break; 1859 1860 Child:=Children[Orientation][i]; 1861 if (Child.MaximumSize[Orientation]<0) 1862 and (Child.PreferredSize[Orientation]>=Child.MaximumSize[Orientation]) 1863 then begin 1864 // this child can not be further enlarged 1865 continue; 1866 end; 1867 1868 case EnlargeStyle of 1869 1870 crsScaleChilds: 1871 begin 1872 // scale PreferredSize 1873 DiffSize:=TargetSize-CurSize; 1874 OldSize:=Child.PreferredSize[Orientation]; 1875 NewSize:=round(double(OldSize)*Factor.Scale); 1876 NewSize:=Min(OldSize+DiffSize,Max(OldSize+1,NewSize)); 1877 inc(CurSize,NewSize-OldSize); 1878 Child.PreferredSize[Orientation]:=NewSize; 1879 end; 1880 1881 crsHomogenousChildResize: 1882 begin 1883 // add to PreferredSize 1884 DiffSize:=TargetSize-CurSize; 1885 OldSize:=Child.PreferredSize[Orientation]; 1886 NewSize:=Min(OldSize+Factor.Offset,OldSize+DiffSize); 1887 inc(CurSize,NewSize-OldSize); 1888 Child.PreferredSize[Orientation]:=NewSize; 1889 end; 1890 1891 crsHomogenousSpaceResize: 1892 begin 1893 if i=0 then begin 1894 // add to left/top border 1895 DiffSize:=TargetSize-CurSize; 1896 OldSize:=Child.BorderLeftTop[Orientation]; 1897 NewSize:=Min(OldSize+Factor.Offset,OldSize+DiffSize); 1898 inc(CurSize,NewSize-OldSize); 1899 Child.BorderLeftTop[Orientation]:=NewSize; 1900 end; 1901 // add to right/bottom border 1902 DiffSize:=TargetSize-CurSize; 1903 OldSize:=Child.BorderRightBottom[Orientation]; 1904 NewSize:=Min(OldSize+Factor.Offset,OldSize+DiffSize); 1905 inc(CurSize,NewSize-OldSize); 1906 Child.BorderRightBottom[Orientation]:=NewSize; 1907 if i<ChildCount[Orientation]-1 then 1908 Child.BorderLeftTop[Orientation]:=NewSize; 1909 end; 1910 1911 end; 1912 end; 1913 end; 1914 1915 procedure GetChildMinResize(out Factor: TResizeFactor; 1916 out ResizeableCount: integer); 1917 // returns the number of children/gaps, that can shrink (ResizeableCount) 1918 // and the maximum factor, by which the children/gaps can shrink (TResizeFactor) 1919 var 1920 i: Integer; 1921 CurScale: Double; 1922 CurOffset: LongInt; 1923 Child: TAutoSizeBox; 1924 begin 1925 Factor.Scale:=0; 1926 Factor.Offset:=0; 1927 ResizeableCount:=0; 1928 case ShrinkStyle of 1929 1930 crsAnchorAligning: 1931 exit; // no resizing 1932 1933 crsScaleChilds,crsHomogenousChildResize: 1934 for i:=0 to ChildCount[Orientation]-1 do begin 1935 Child:=Children[Orientation][i]; 1936 if (Child.PreferredSize[Orientation]<=Child.MinimumSize[Orientation]) 1937 or (Child.PreferredSize[Orientation]<=1) 1938 then begin 1939 // this child can not be further shrinked 1940 continue; 1941 end; 1942 inc(ResizeableCount); 1943 1944 case ShrinkStyle of 1945 1946 crsScaleChilds: 1947 begin 1948 CurScale:=double(Child.MinimumSize[Orientation]) 1949 /Child.PreferredSize[Orientation]; 1950 CurOffset:=Child.PreferredSize[Orientation] 1951 -Child.MinimumSize[Orientation]; 1952 if (Factor.Offset=0) or (Factor.Scale<CurScale) then begin 1953 Factor.Scale:=CurScale; 1954 Factor.Offset:=CurOffset; 1955 end; 1956 end; 1957 1958 crsHomogenousChildResize: 1959 begin 1960 CurScale:=double(Child.MinimumSize[Orientation]) 1961 /Child.PreferredSize[Orientation]; 1962 CurOffset:=Child.PreferredSize[Orientation] 1963 -Child.MinimumSize[Orientation]; 1964 if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin 1965 Factor.Scale:=CurScale; 1966 Factor.Offset:=CurOffset; 1967 end; 1968 end; 1969 1970 end; 1971 end; 1972 1973 crsHomogenousSpaceResize: 1974 for i:=0 to ChildCount[Orientation]-1 do begin 1975 Child:=Children[Orientation][i]; 1976 if i=0 then begin 1977 CurScale:=double(TargetSize); 1978 CurOffset:=Child.BorderLeftTop[Orientation]; 1979 if CurOffset>0 then begin 1980 inc(ResizeableCount); 1981 if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin 1982 Factor.Scale:=CurScale; 1983 Factor.Offset:=CurOffset; 1984 end; 1985 end; 1986 end; 1987 CurScale:=double(TargetSize); 1988 CurOffset:=Child.BorderRightBottom[Orientation]; 1989 if CurOffset>0 then begin 1990 inc(ResizeableCount); 1991 if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin 1992 Factor.Scale:=CurScale; 1993 Factor.Offset:=CurOffset; 1994 end; 1995 end; 1996 end; 1997 1998 else 1999 raise Exception.Create('TAutoSizeBox.ResizeChilds'); 2000 2001 end; 2002 end; 2003 2004 procedure ShrinkChilds(const Factor: TResizeFactor); 2005 var 2006 i: Integer; 2007 Child: TAutoSizeBox; 2008 DiffSize: Integer; 2009 NewSize: LongInt; 2010 OldSize: LongInt; 2011 begin 2012 for i:=0 to ChildCount[Orientation]-1 do begin 2013 Child:=Children[Orientation][i]; 2014 if (Child.PreferredSize[Orientation]<=1) 2015 or (Child.PreferredSize[Orientation]<=Child.MinimumSize[Orientation]) 2016 then begin 2017 // this child can not be further shrinked 2018 continue; 2019 end; 2020 2021 case ShrinkStyle of 2022 2023 crsScaleChilds: 2024 begin 2025 // scale PreferredSize 2026 DiffSize:=CurSize-TargetSize; 2027 OldSize:=Child.PreferredSize[Orientation]; 2028 NewSize:=Min(round(OldSize*Factor.Scale),OldSize-1); 2029 NewSize:=Max(Max(1,NewSize),OldSize-DiffSize); 2030 dec(CurSize,OldSize-NewSize); 2031 Child.PreferredSize[Orientation]:=NewSize; 2032 end; 2033 2034 crsHomogenousChildResize: 2035 begin 2036 // add to PreferredSize 2037 DiffSize:=CurSize-TargetSize; 2038 OldSize:=Child.PreferredSize[Orientation]; 2039 NewSize:=OldSize-Factor.Offset; 2040 NewSize:=Max(Max(NewSize,1),OldSize-DiffSize); 2041 dec(CurSize,OldSize-NewSize); 2042 Child.PreferredSize[Orientation]:=NewSize; 2043 end; 2044 2045 crsHomogenousSpaceResize: 2046 begin 2047 if i=0 then begin 2048 // add to left/top border 2049 DiffSize:=CurSize-TargetSize; 2050 OldSize:=Child.BorderLeftTop[Orientation]; 2051 NewSize:=Max(Max(0,OldSize-Factor.Offset),OldSize-DiffSize); 2052 dec(CurSize,OldSize-NewSize); 2053 Child.BorderLeftTop[Orientation]:=NewSize; 2054 end; 2055 // add to right/bottom border 2056 DiffSize:=CurSize-TargetSize; 2057 OldSize:=Child.BorderRightBottom[Orientation]; 2058 NewSize:=Max(Max(0,OldSize-Factor.Offset),OldSize-DiffSize); 2059 dec(CurSize,OldSize-NewSize); 2060 Child.BorderRightBottom[Orientation]:=NewSize; 2061 if i<ChildCount[Orientation]-1 then 2062 Child.BorderLeftTop[Orientation]:=NewSize; 2063 end; 2064 2065 end; 2066 end; 2067 end; 2068 2069var 2070 MaxResizeFactorPerItem, MinResizeFactorPerItem, CurScale: TResizeFactor; 2071 ResizeableCount: integer; 2072 i: Integer; 2073begin 2074 CurSize:=GetChildTotalSize; 2075 //DebugLn('TAutoSizeBox.ResizeChilds CurSize=',dbgs(CurSize),' TargetSize=',dbgs(TargetSize)); 2076 EnlargeStyle:=crsAnchorAligning; 2077 ShrinkStyle:=crsAnchorAligning; 2078 i:=0; 2079 if TargetSize>CurSize then begin 2080 // enlarge 2081 if Orientation=asboHorizontal then 2082 EnlargeStyle:=ChildSizing.EnlargeHorizontal 2083 else 2084 EnlargeStyle:=ChildSizing.EnlargeVertical; 2085 while TargetSize>CurSize do begin 2086 // shrink children 2087 GetChildMaxResize(MaxResizeFactorPerItem,ResizeableCount); 2088 if (ResizeableCount=0) or (MaxResizeFactorPerItem.Offset=0) then break; 2089 2090 CurScale.Scale:=(double(TargetSize)/CurSize); 2091 if (MaxResizeFactorPerItem.Scale>0) 2092 and (MaxResizeFactorPerItem.Scale<CurScale.Scale) then 2093 CurScale.Scale:=MaxResizeFactorPerItem.Scale; 2094 2095 CurScale.Offset:=((TargetSize-CurSize-1) div ResizeableCount)+1; 2096 // note: the above formula makes sure, that Offset>0 2097 if (MaxResizeFactorPerItem.Offset>0) 2098 and (MaxResizeFactorPerItem.Offset<CurScale.Offset) then 2099 CurScale.Offset:=MaxResizeFactorPerItem.Offset; 2100 2101 EnlargeChilds(CurScale); 2102 inc(i); 2103 if i>1000 then RaiseGDBException('TAutoSizeBox.ResizeChilds consistency error'); 2104 end; 2105 end else if TargetSize<CurSize then begin 2106 // shrink 2107 if Orientation=asboHorizontal then 2108 ShrinkStyle:=ChildSizing.ShrinkHorizontal 2109 else 2110 ShrinkStyle:=ChildSizing.ShrinkVertical; 2111 while TargetSize<CurSize do begin 2112 GetChildMinResize(MinResizeFactorPerItem,ResizeableCount); 2113 if (ResizeableCount=0) or (MinResizeFactorPerItem.Offset=0) then break; 2114 2115 CurScale.Scale:=(double(TargetSize)/CurSize); 2116 if (MinResizeFactorPerItem.Scale>0) 2117 and (MinResizeFactorPerItem.Scale>CurScale.Scale) then 2118 CurScale.Scale:=MinResizeFactorPerItem.Scale; 2119 2120 CurScale.Offset:=((CurSize-TargetSize-1) div ResizeableCount)+1; 2121 // note: the above formula makes sure, that Offset>0 2122 if (MinResizeFactorPerItem.Offset>0) 2123 and (MinResizeFactorPerItem.Offset>CurScale.Offset) then 2124 CurScale.Offset:=MinResizeFactorPerItem.Offset; 2125 2126 ShrinkChilds(CurScale); 2127 inc(i); 2128 if i>1000 then RaiseGDBException('TAutoSizeBox.ResizeChilds consistency error'); 2129 end; 2130 end; 2131end; 2132 2133procedure TAutoSizeBox.ResizeTable(ChildSizing: TControlChildSizing; 2134 TargetWidth, TargetHeight: integer); 2135begin 2136 // resize rows and columns 2137 ResizeChildren(ChildSizing,asboHorizontal,TargetWidth); 2138 ComputeLeftTops(asboHorizontal); 2139 ResizeChildren(ChildSizing,asboVertical,TargetHeight); 2140 ComputeLeftTops(asboVertical); 2141end; 2142 2143{procedure TAutoSizeBox.AlignToRight(TargetWidth: integer); 2144 2145 function GetChildTotalSize(Orientation: TAutoSizeBoxOrientation): integer; 2146 // computes the total preferred size of all children of this Orientation 2147 var 2148 i: Integer; 2149 Child: TAutoSizeBox; 2150 begin 2151 Result:=0; 2152 for i:=0 to ChildCount[Orientation]-1 do begin 2153 Child:=Children[Orientation][i]; 2154 if i=0 then 2155 inc(Result,Child.BorderLeftTop[Orientation]); 2156 if Child.PreferredSize[Orientation]<1 then 2157 Child.PreferredSize[Orientation]:=1; 2158 inc(Result,Child.PreferredSize[Orientation]); 2159 inc(Result,Child.BorderRightBottom[Orientation]); 2160 end; 2161 end; 2162 2163var 2164 Orientation: TAutoSizeBoxOrientation; 2165 i: Integer; 2166 Child: TAutoSizeBox; 2167 dx: Integer; 2168begin 2169 Orientation:=asboHorizontal; 2170 dx:=TargetWidth-GetChildTotalSize(Orientation); 2171 2172 for i:=ChildCount[Orientation]-1 downto 0 do begin 2173 Child:=Children[Orientation][i]; 2174 inc(Child.LeftTop[Orientation],dx); 2175 end; 2176end; 2177} 2178procedure TAutoSizeBox.ComputeTableControlBounds( 2179 ChildSizing: TControlChildSizing; BiDiMode: TBiDiMode); 2180var 2181 y: Integer; 2182 RowBox: TAutoSizeBox; 2183 x: Integer; 2184 ColBox: TAutoSizeBox; 2185 ControlBox: TAutoSizeBox; 2186 CurControl: TControl; 2187 NewBounds: TRect; 2188 CellBounds: TRect; 2189 NewWidth: LongInt; 2190 NewHeight: LongInt; 2191begin 2192 //WriteDebugReport; 2193 for y:=0 to ChildCount[asboVertical]-1 do begin 2194 RowBox:=Children[asboVertical][y]; 2195 for x:=0 to RowBox.ChildCount[asboHorizontal]-1 do begin 2196 ControlBox:=RowBox.Children[asboHorizontal][x]; 2197 ColBox:=ControlBox.Parent[asboVertical]; 2198 CurControl:=ControlBox.Control; 2199 if CurControl=nil then continue; 2200 CellBounds:=Bounds(ColBox.LeftTop[asboHorizontal], 2201 RowBox.LeftTop[asboVertical], 2202 ColBox.PreferredSize[asboHorizontal], 2203 RowBox.PreferredSize[asboVertical]); 2204 NewBounds.Left:=CellBounds.Left; 2205 NewBounds.Top:=CellBounds.Top; 2206 NewWidth:=ControlBox.PreferredSize[asboHorizontal]; 2207 NewHeight:=ControlBox.PreferredSize[asboVertical]; 2208 if (NewWidth<ColBox.PreferredSize[asboHorizontal]) then begin 2209 // column is bigger than preferred width of the control 2210 //DebugLn('TAutoSizeBox.SetTableControlBounds ',DbgSName(CurControl),' ',dbgs(ord(CurControl.BorderSpacing.CellAlignHorizontal))); 2211 case CurControl.BorderSpacing.CellAlignHorizontal of 2212 ccaFill: NewWidth:=CellBounds.Right-CellBounds.Left; 2213 ccaLeftTop,ccaRightBottom: 2214 if (CurControl.BorderSpacing.CellAlignHorizontal=ccaRightBottom) 2215 =(BidiMode=bdLeftToRight) 2216 then 2217 NewBounds.Left:=CellBounds.Right-NewWidth; 2218 ccaCenter: NewBounds.Left:=NewBounds.Left 2219 +(CellBounds.Right-CellBounds.Left-NewWidth) div 2; 2220 end; 2221 end else if (NewWidth>ColBox.PreferredSize[asboHorizontal]) then begin 2222 // column is smaller than preferred width of the control 2223 if ChildSizing.ShrinkHorizontal 2224 in [crsScaleChilds,crsHomogenousChildResize] 2225 then 2226 NewWidth:=CellBounds.Right-CellBounds.Left; 2227 end; 2228 if (NewHeight<ColBox.PreferredSize[asboVertical]) then begin 2229 // column is bigger than preferred height of the control 2230 case CurControl.BorderSpacing.CellAlignVertical of 2231 ccaFill: NewHeight:=CellBounds.Bottom-CellBounds.Top; 2232 ccaLeftTop: ; 2233 ccaRightBottom: NewBounds.Top:=CellBounds.Bottom-NewHeight; 2234 ccaCenter: NewBounds.Top:=NewBounds.Top 2235 +(CellBounds.Bottom-CellBounds.Top-NewHeight) div 2; 2236 end; 2237 end else if (NewHeight>ColBox.PreferredSize[asboVertical]) then begin 2238 // column is smaller than preferred height of the control 2239 if ChildSizing.ShrinkVertical 2240 in [crsScaleChilds,crsHomogenousChildResize] 2241 then 2242 NewHeight:=CellBounds.Bottom-CellBounds.Top; 2243 end; 2244 2245 NewBounds.Right:=NewBounds.Left+NewWidth; 2246 NewBounds.Bottom:=NewBounds.Top+NewHeight; 2247 ControlBox.NewControlBounds:=NewBounds; 2248 {$IFDEF CHECK_POSITION} 2249 if CheckPosition(CurControl) then 2250 DebugLn(['TAutoSizeBox.ComputeTableControlBounds ',DbgSName(CurControl), 2251 ' CellBounds=',dbgs(CellBounds), 2252 ' Preferred=',ControlBox.PreferredSize[asboHorizontal],'x',ControlBox.PreferredSize[asboVertical], 2253 ' NewBounds=',dbgs(NewBounds)]); 2254 {$ENDIF} 2255 end; 2256 end; 2257end; 2258 2259function TAutoSizeBox.SetTableControlBounds(ChildSizing: TControlChildSizing 2260 ): boolean; 2261var 2262 y: Integer; 2263 RowBox: TAutoSizeBox; 2264 x: Integer; 2265 ControlBox: TAutoSizeBox; 2266 CurControl: TControl; 2267 NewBounds: TRect; 2268 OldBounds: TRect; 2269begin 2270 Result:=false; 2271 //WriteDebugReport; 2272 for y:=0 to ChildCount[asboVertical]-1 do begin 2273 RowBox:=Children[asboVertical][y]; 2274 for x:=0 to RowBox.ChildCount[asboHorizontal]-1 do begin 2275 ControlBox:=RowBox.Children[asboHorizontal][x]; 2276 CurControl:=ControlBox.Control; 2277 if CurControl=nil then continue; 2278 NewBounds:=ControlBox.NewControlBounds; 2279 OldBounds:=CurControl.BoundsRect; 2280 if not CompareRect(@NewBounds,@OldBounds) then begin 2281 Result:=true; 2282 CurControl.SetBoundsKeepBase(NewBounds.Left, 2283 NewBounds.Top, 2284 NewBounds.Right-NewBounds.Left, 2285 NewBounds.Bottom-NewBounds.Top); 2286 end; 2287 end; 2288 end; 2289end; 2290 2291function TAutoSizeBox.AlignControlsInTable(ListOfControls: TFPList; 2292 ChildSizing: TControlChildSizing; BiDiMode: TBiDiMode; 2293 TargetWidth, TargetHeight: integer; 2294 Apply: boolean): boolean; 2295// true if a control was modified 2296begin 2297 SetTableControls(ListOfControls,ChildSizing,BiDiMode); 2298 //WriteDebugReport('after SetTableControls'); 2299 SumTable; 2300 //WriteDebugReport('after SumTable'); 2301 ResizeTable(ChildSizing,TargetWidth,TargetHeight); 2302 //WriteDebugReport('after ResizeTable'); 2303 2304// Michl: Commented procedure AlignToRight because of issue #28483, afaics 2305// it isn't needed, I'll remove code, if there are no regressions. 2306// Commented in revision 55209 2307// if BiDiMode=bdRightToLeft then 2308// AlignToRight(TargetWidth); 2309 2310 //WriteDebugReport('after AlignToRight'); 2311 ComputeTableControlBounds(ChildSizing,BiDiMode); 2312 //WriteDebugReport('after ComputeTableControlBounds'); 2313 Result:=Apply and SetTableControlBounds(ChildSizing); 2314end; 2315 2316procedure TAutoSizeBox.WriteDebugReport(const Title: string); 2317var 2318 y: Integer; 2319 RowBox: TAutoSizeBox; 2320 x: Integer; 2321 CellBox: TAutoSizeBox; 2322 ColBox: TAutoSizeBox; 2323begin 2324 DebugLn('TAutoSizeBox.WriteDebugReport '+Title 2325 +' ChildCounts=',dbgs(ChildCount[asboHorizontal]),'x',dbgs(ChildCount[asboVertical])); 2326 for y:=0 to ChildCount[asboVertical]-1 do begin 2327 RowBox:=Children[asboVertical][y]; 2328 DbgOut(' Row='+dbgs(y), 2329 ' MinY='+dbgs(RowBox.MinimumSize[asboVertical]), 2330 ' MaxY='+dbgs(RowBox.MaximumSize[asboVertical]), 2331 ' PrefY='+dbgs(RowBox.PreferredSize[asboVertical]), 2332 ' BorderTop=',dbgs(RowBox.BorderLeftTop[asboVertical]), 2333 ' #Col='+dbgs(RowBox.ChildCount[asboHorizontal])); 2334 for x:=0 to RowBox.ChildCount[asboHorizontal]-1 do begin 2335 CellBox:=RowBox.Children[asboHorizontal][x]; 2336 DbgOut(' CellControl=',DbgSName(CellBox.Control), 2337 ' Min='+dbgs(CellBox.MinimumSize[asboHorizontal])+'x'+dbgs(CellBox.MinimumSize[asboVertical]), 2338 ' Max='+dbgs(CellBox.MaximumSize[asboHorizontal])+'x'+dbgs(CellBox.MaximumSize[asboVertical]), 2339 ' BorderLeft=',dbgs(CellBox.BorderLeftTop[asboHorizontal]), 2340 ' Pref='+dbgs(CellBox.PreferredSize[asboHorizontal])+'x'+dbgs(CellBox.PreferredSize[asboVertical]), 2341 ''); 2342 end; 2343 DebugLn; 2344 end; 2345 DbgOut(' Columns: '); 2346 for x:=0 to ChildCount[asboHorizontal]-1 do begin 2347 ColBox:=Children[asboHorizontal][x]; 2348 DbgOut(' Col='+dbgs(ColBox.Index[asboHorizontal]), 2349 ' Min='+dbgs(ColBox.MinimumSize[asboHorizontal]), 2350 ' Max='+dbgs(ColBox.MaximumSize[asboHorizontal]), 2351 ' Pref='+dbgs(ColBox.PreferredSize[asboHorizontal]), 2352 ''); 2353 end; 2354 DebugLn; 2355end; 2356 2357destructor TAutoSizeBox.Destroy; 2358var 2359 o: TAutoSizeBoxOrientation; 2360begin 2361 // unlink from parent 2362 for o:=Low(TAutoSizeBoxOrientation) to high(TAutoSizeBoxOrientation) do 2363 if Parent[o]<>nil then 2364 Parent[o].Children[o][Index[o]]:=nil; 2365 Clear; 2366 inherited Destroy; 2367end; 2368 2369procedure TAutoSizeBox.Clear; 2370var 2371 o: TAutoSizeBoxOrientation; 2372 i: Integer; 2373begin 2374 // free all children 2375 for o:=Low(TAutoSizeBoxOrientation) to high(TAutoSizeBoxOrientation) do 2376 for i:=0 to ChildCount[o]-1 do 2377 Children[o][i].Free; 2378 // free children arrays 2379 for o:=Low(TAutoSizeBoxOrientation) to high(TAutoSizeBoxOrientation) do 2380 ReallocMem(Children[o],0); 2381end; 2382 2383{------------------------------------------------------------------------------ 2384 function TWinControl.AutoSizePhases: TControlAutoSizePhases; 2385------------------------------------------------------------------------------} 2386function TWinControl.AutoSizePhases: TControlAutoSizePhases; 2387begin 2388 if Parent<>nil then 2389 Result:=Parent.AutoSizePhases 2390 else begin 2391 Result:=[]; 2392 if ([wcfCreatingHandle,wcfCreatingChildHandles]*FWinControlFlags<>[]) then 2393 Include(Result,caspCreatingHandles); 2394 if fAutoSizingAll then 2395 Include(Result,caspComputingBounds); 2396 if wcfRealizingBounds in FWinControlFlags then 2397 Include(Result,caspRealizingBounds); 2398 if wcfUpdateShowing in FWinControlFlags then 2399 Include(Result,caspShowing); 2400 if FAutoSizingLockCount>0 then 2401 Include(Result,caspChangingProperties); 2402 end; 2403end; 2404 2405{------------------------------------------------------------------------------ 2406 function TWinControl.AutoSizeDelayed: boolean; 2407------------------------------------------------------------------------------} 2408function TWinControl.AutoSizeDelayed: boolean; 2409begin 2410 Result:=(csDestroyingHandle in ControlState) 2411 or (inherited AutoSizeDelayed); 2412 //if Result then debugln('TWinControl.AutoSizeDelayed A ',DbgSName(Self),' wcfCreatingChildHandles=',dbgs(wcfCreatingChildHandles in FWinControlFlags),' csLoading=',dbgs(csLoading in ComponentState)); 2413 {$IFDEF VerboseCanAutoSize} 2414 if Result {and AutoSize} then begin 2415 if not HandleAllocated then 2416 debugln('TWinControl.AutoSizeDelayed Self='+DbgSName(Self)+' not HandleAllocated'); 2417 end; 2418 {$ENDIF} 2419end; 2420 2421function TWinControl.AutoSizeDelayedReport: string; 2422begin 2423 if csDestroyingHandle in ControlState then 2424 Result:='csDestroyingHandle' 2425 else 2426 Result:=inherited AutoSizeDelayedReport; 2427end; 2428 2429{------------------------------------------------------------------------------ 2430 TWinControl AutoSizeDelayedHandle 2431 2432 Returns true if AutoSize should be skipped / delayed because of its handle. 2433 A TWinControl needs a parent handle. 2434------------------------------------------------------------------------------} 2435function TWinControl.AutoSizeDelayedHandle: Boolean; 2436begin 2437 Result := (Parent = nil) and (ParentWindow = 0); 2438end; 2439 2440{------------------------------------------------------------------------------ 2441 TWinControl AdjustClientRect 2442------------------------------------------------------------------------------} 2443procedure TWinControl.AdjustClientRect(var ARect: TRect); 2444begin 2445 // Can be overriden. 2446 // It's called often, so don't put expensive code here, or cache the result 2447end; 2448 2449procedure TWinControl.GetAdjustedLogicalClientRect(out ARect: TRect); 2450begin 2451 if not (wcfAdjustedLogicalClientRectValid in FWinControlFlags) then begin 2452 FAdjustClientRect:=GetLogicalClientRect; 2453 AdjustClientRect(FAdjustClientRect); 2454 Include(FWinControlFlags,wcfAdjustedLogicalClientRectValid); 2455 end; 2456 ARect:=FAdjustClientRect; 2457end; 2458 2459{------------------------------------------------------------------------------ 2460 TWinControl CreateControlAlignList 2461 2462 Creates a list of controls that need to be aligned via TheAlign. 2463------------------------------------------------------------------------------} 2464procedure TWinControl.CreateControlAlignList(TheAlign: TAlign; 2465 AlignList: TFPList; StartControl: TControl); 2466 2467 function InsertBefore(Control1, Control2: TControl; AAlign: TAlign): Boolean; 2468 begin 2469 case AAlign of 2470 alTop: begin 2471 Result := (Control1.Top < Control2.Top) 2472 or ( (Control1.Top = Control2.Top) 2473 and (Control1.FBaseBounds.Top < Control2.FBaseBounds.Top)); 2474 end; 2475 alLeft: begin 2476 Result := (Control1.Left < Control2.Left) 2477 or ( (Control1.Left = Control2.Left) 2478 and (Control1.FBaseBounds.Left < Control2.FBaseBounds.Left)); 2479 end; 2480 // contrary to VCL, LCL uses > for alBottom, alRight 2481 // Maybe it is a bug in the VCL. 2482 // This results in first control is put rightmost/bottommost 2483 alBottom: begin 2484 Result := ((Control1.Top + Control1.Height) > (Control2.Top + Control2.Height)) 2485 or ( ((Control1.Top + Control1.Height) = (Control2.Top + Control2.Height)) 2486 and (Control1.FBaseBounds.Bottom > Control2.FBaseBounds.Bottom)); 2487 end; 2488 alRight: begin 2489 Result := ((Control1.Left + Control1.Width) > (Control2.Left + Control2.Width)) 2490 or ( ((Control1.Left + Control1.Width) = (Control2.Left + Control2.Width)) 2491 and (Control1.FBaseBounds.Right > Control2.FBaseBounds.Right)); 2492 end; 2493 alCustom: begin 2494 // CustomAlignInsertBefore returns true when Control2 is inserted before Control1 2495 // We return true when Control1 is inserted before Control2 2496 // So swap controls 2497 Result := CustomAlignInsertBefore(Control2, Control1); 2498 end; 2499 else 2500 Result := False; 2501 end; 2502 end; 2503 2504var 2505 I, X: Integer; 2506 Control: TControl; 2507begin 2508 AlignList.Clear; 2509 2510 // first add the current control 2511 if (StartControl <> nil) and (StartControl.Align = TheAlign) and 2512 ((TheAlign = alNone) or StartControl.IsControlVisible) then 2513 AlignList.Add(StartControl); 2514 2515 // then add all other 2516 for I := 0 to FAlignOrder.Count - 1 do 2517 begin 2518 Control := TControl(FAlignOrder[I]); 2519 2520 if (Control.Align = TheAlign) and Control.IsControlVisible then 2521 begin 2522 if Control = StartControl then Continue; 2523 2524 X := 0; 2525 while (X < AlignList.Count) and 2526 not InsertBefore(Control, TControl(AlignList[X]), TheAlign) do 2527 Inc(X); 2528 AlignList.Insert(X, Control); 2529 end; 2530 end; 2531end; 2532 2533procedure TWinControl.UpdateAlignIndex(aChild: TControl); 2534// Move child control to position 0 of FAlignOrder 2535var 2536 i: Integer; 2537begin 2538 if FAlignOrder=nil then 2539 FAlignOrder:=TFPList.Create; 2540 i:=FAlignOrder.IndexOf(aChild); 2541 if i<0 then 2542 FAlignOrder.Insert(0,aChild) 2543 else 2544 FAlignOrder.Move(i,0); 2545end; 2546 2547{------------------------------------------------------------------------------ 2548 TWinControl AlignControls 2549 2550 Align child controls 2551------------------------------------------------------------------------------} 2552procedure TWinControl.AlignControls(AControl: TControl; 2553 var RemainingClientRect: TRect); 2554{ $DEFINE CHECK_POSITION} 2555var 2556 AlignList: TFPList; 2557 BoundsMutated: boolean; 2558 LastBoundsMutated: TControl; 2559 LastBoundsMutatedOld: TRect; 2560 ParentClientWidth: integer; 2561 ParentClientHeight: integer; 2562 RemainingBorderSpace: TRect; // borderspace around RemainingClientRect 2563 // e.g. Right=3 means borderspace of 3 2564 2565 function NeedAlignWork: Boolean; 2566 var 2567 I: Integer; 2568 CurControl: TControl; 2569 begin 2570 Result := True; 2571 for I := ControlCount - 1 downto 0 do 2572 begin 2573 CurControl:=Controls[I]; 2574 if (CurControl.Align <> alNone) 2575 or (CurControl.Anchors <> [akLeft, akTop]) 2576 or (CurControl.AnchorSide[akLeft].Control<>nil) 2577 or (CurControl.AnchorSide[akTop].Control<>nil) 2578 or (cfAutoSizeNeeded in CurControl.FControlFlags) 2579 or (ChildSizing.Layout<>cclNone) 2580 then Exit; 2581 end; 2582 Result := False; 2583 end; 2584 2585 function Anchored(Align: TAlign; Anchors: TAnchors): Boolean; 2586 begin 2587 case Align of 2588 alLeft: Result := akLeft in Anchors; 2589 alTop: Result := akTop in Anchors; 2590 alRight: Result := akRight in Anchors; 2591 alBottom: Result := akBottom in Anchors; 2592 alClient: Result := Anchors = [akLeft, akTop, akRight, akBottom]; 2593 else 2594 Result := False; 2595 end; 2596 end; 2597 2598 procedure DoPosition(Control: TControl; AAlign: TAlign; AControlIndex: Integer); 2599 var 2600 NewLeft, NewTop, NewWidth, NewHeight: Integer; 2601 ParentBaseClientSize: TSize; 2602 CurBaseBounds: TRect; 2603 NewRight: Integer;// temp variable, not always valid, use with care ! 2604 NewBottom: Integer;// temp variable, not always valid, use with care ! 2605 2606 MinWidth: Integer; 2607 MaxWidth: Integer; 2608 MinHeight: Integer; 2609 MaxHeight: Integer; 2610 CurRemainingClientRect: TRect; 2611 CurRemainingBorderSpace: TRect; // borderspace around RemainingClientRect 2612 // e.g. Right=3 means borderspace of 3 2613 ChildAroundSpace: TRect; 2614 AnchorSideCacheValid: array[TAnchorKind] of boolean; 2615 AnchorSideCache: array[TAnchorKind] of integer; 2616 CurAnchors: TAnchors; 2617 CurAlignAnchors: TAnchors; 2618 OldBounds: TRect; 2619 NewBounds: TRect; 2620 2621 AlignInfo: TAlignInfo; // alCustom 2622 PrefWidth: integer; 2623 PrefHeight: integer; 2624 2625 function ConstraintWidth(NewWidth: integer): Integer; 2626 begin 2627 Result:=NewWidth; 2628 if (MaxWidth>=MinWidth) and (Result>MaxWidth) and (MaxWidth>0) then 2629 Result:=MaxWidth; 2630 if Result<MinWidth then Result:=MinWidth; 2631 end; 2632 2633 procedure ConstraintWidth(var NewLeft, NewWidth: integer); 2634 var 2635 ConWidth: LongInt; 2636 begin 2637 ConWidth:=ConstraintWidth(NewWidth); 2638 if ConWidth<>NewWidth then begin 2639 if [akLeft,akRight]*CurAnchors=[akRight] then 2640 // move left side, keep right 2641 inc(NewLeft,NewWidth-ConWidth); 2642 NewWidth:=ConWidth; 2643 end; 2644 end; 2645 2646 function ConstraintHeight(NewHeight: integer): Integer; 2647 begin 2648 Result:=NewHeight; 2649 if (MaxHeight>=MinHeight) and (Result>MaxHeight) and (MaxHeight>0) then 2650 Result:=MaxHeight; 2651 if Result<MinHeight then Result:=MinHeight; 2652 end; 2653 2654 procedure ConstraintHeight(var NewTop, NewHeight: integer); 2655 var 2656 ConHeight: LongInt; 2657 begin 2658 ConHeight:=ConstraintHeight(NewHeight); 2659 if ConHeight<>NewHeight then begin 2660 if [akTop,akBottom]*CurAnchors=[akBottom] then 2661 // move top side, keep bottom 2662 inc(NewTop,NewHeight-ConHeight); 2663 NewHeight:=ConHeight; 2664 end; 2665 end; 2666 2667 procedure InitAnchorSideCache; 2668 var 2669 a: TAnchorKind; 2670 begin 2671 for a:=Low(TAnchorKind) to High(TAnchorKind) do 2672 AnchorSideCacheValid[a]:=false; 2673 end; 2674 2675 function GetAnchorSidePosition(Kind: TAnchorKind; 2676 DefaultPosition: Integer): integer; 2677 // calculates the position in pixels of a side due to anchors 2678 // For example: if akLeft is set, it returns the coordinate for the left anchor 2679 var 2680 CurAnchorSide: TAnchorSide; 2681 ReferenceControl: TControl; 2682 ReferenceSide: TAnchorSideReference; 2683 Position: Integer; 2684 begin 2685 if AnchorSideCacheValid[Kind] then begin 2686 Result:=AnchorSideCache[Kind]; 2687 exit; 2688 end; 2689 Result:=DefaultPosition; 2690 CurAnchorSide:=Control.AnchorSide[Kind]; 2691 //if CheckPosition(Control) and (Kind=akLeft) then debugln(['GetAnchorSidePosition A Self=',DbgSName(Self),' Control=',DbgSName(Control),' CurAnchorSide.Control=',DbgSName(CurAnchorSide.Control),' Spacing=',Control.BorderSpacing.GetSpace(Kind)]); 2692 CurAnchorSide.GetSidePosition(ReferenceControl,ReferenceSide,Position); 2693 if ReferenceControl<>nil then begin 2694 //DebugLn(['GetAnchorSidePosition ',DbgSName(Control),' ReferenceControl=',DbgSName(ReferenceControl)]); 2695 Result:=Position; 2696 end; 2697 //if CheckPosition(Control) and (Kind=akRight) then begin 2698 // debugln('GetAnchorSidePosition B Self=',DbgSName(Self),' Control=',DbgSName(Control),' Result=',dbgs(Result),' ReferenceControl=',dbgsName(ReferenceControl)); 2699 // if ReferenceControl<>nil then DebugLn(['GetAnchorSidePosition ReferenceControl.BoundsRect=',dbgs(ReferenceControl.BoundsRect)]); 2700 //end; 2701 AnchorSideCacheValid[Kind]:=true; 2702 AnchorSideCache[Kind]:=Result; 2703 if ReferenceSide=asrTop then ; 2704 end; 2705 2706 begin 2707 {$IFDEF CHECK_POSITION} 2708 if CheckPosition(Control) then 2709 with Control do 2710 DebugLn('[TWinControl.AlignControls.DoPosition] A Control=',dbgsName(Control),' ', 2711 dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height), 2712 ' recalculate the anchors=',dbgs(Control.Anchors <> AnchorAlign[AAlign]), 2713 ' Align=',DbgS(AAlign)); 2714 {$ENDIF} 2715 2716 with Control do begin 2717 // get constraints 2718 MinWidth:=Constraints.EffectiveMinWidth; 2719 if MinWidth<0 then MinWidth:=0; 2720 MaxWidth:=Constraints.EffectiveMaxWidth; 2721 MinHeight:=Constraints.EffectiveMinHeight; 2722 if MinHeight<0 then MinHeight:=0; 2723 MaxHeight:=Constraints.EffectiveMaxHeight; 2724 2725 // get anchors set by Align 2726 CurAlignAnchors:=[]; 2727 if Align in [alLeft,alRight,alBottom,alTop,alClient] then 2728 CurAlignAnchors:=AnchorAlign[Align]; 2729 CurAnchors:=Anchors+CurAlignAnchors; 2730 2731 // get default bounds 2732 NewLeft:=Left; 2733 NewTop:=Top; 2734 NewWidth:=Width; 2735 NewHeight:=Height; 2736 if AutoSize then begin 2737 GetPreferredSize(PrefWidth,PrefHeight); 2738 if PrefWidth>0 then NewWidth:=PrefWidth; 2739 if PrefHeight>0 then NewHeight:=PrefHeight; 2740 end; 2741 ConstraintWidth(NewLeft,NewWidth); 2742 ConstraintHeight(NewTop,NewHeight); 2743 end; 2744 2745 InitAnchorSideCache; 2746 2747 { Recalculate the anchors 2748 2749 Use Anchors to ensure that a control maintains its current position 2750 relative to an edge of its parent or another sibling. 2751 This is controlled with the AnchorSide properties. 2752 2753 1. If AnchorSide[].Control is not set, the distance is kept relative to 2754 the edges of the client area of its parent. 2755 When its parent is resized, the control holds its position relative to the 2756 edges to which it is anchored. 2757 If a control is anchored to opposite edges of its parent, the control 2758 stretches when its parent is resized. For example, if a control has its 2759 Anchors property set to [akLeft,akRight], the control stretches when the 2760 width of its parent changes. 2761 Anchors is enforced only when the parent is resized. Thus, for example, 2762 if a control is anchored to opposite edges of a form at design time and 2763 the form is created in a maximized state, the control is not stretched 2764 because the form is not resized after the control is created. 2765 2766 2. If AnchorSide[].Control is set, the BorderSpace properties defines the 2767 distance to another sibling (i.e. AnchorSide[].Control). 2768 } 2769 if (AAlign = alNone) or (Control.Anchors <> CurAlignAnchors) 2770 then begin 2771 // at least one side is anchored without align 2772 2773 // Get the base bounds. The base bounds are the user defined bounds 2774 // without automatic aligning and/or anchoring 2775 2776 // get base size of parents client area 2777 ParentBaseClientSize:=Control.FBaseParentClientSize; 2778 if (ParentBaseClientSize.cx=0) 2779 and (ParentBaseClientSize.cy=0) then 2780 ParentBaseClientSize:=Size(ParentClientWidth,ParentClientHeight); 2781 2782 // get base bounds of Control 2783 CurBaseBounds:=Control.FBaseBounds; 2784 if not (cfBaseBoundsValid in FControlFlags) then 2785 CurBaseBounds:=Control.BoundsRect; 2786 2787 {$IFDEF CHECK_POSITION} 2788 //if csDesigning in ComponentState then 2789 if CheckPosition(Control) then 2790 DebugLn('[TWinControl.AlignControls.DoPosition] Before Anchoring ', 2791 ' Self='+DbgSName(Self),' Control='+DbgSName(Control), 2792 ' CurBaseBounds='+dbgs(CurBaseBounds.Left)+','+dbgs(CurBaseBounds.Top)+','+dbgs(CurBaseBounds.Right-CurBaseBounds.Left)+','+dbgs(CurBaseBounds.Bottom-CurBaseBounds.Top), 2793 ' ParentBaseClientSize='+dbgs(ParentBaseClientSize.cx)+','+dbgs(ParentBaseClientSize.cy), 2794 ' ControlParent.Client='+dbgs(ParentClientWidth)+','+dbgs(ParentClientHeight), 2795 ' NewBounds='+dbgs(NewLeft)+','+dbgs(NewTop)+','+dbgs(NewWidth)+','+dbgs(NewHeight), 2796 ''); 2797 {$ENDIF} 2798 2799 if akLeft in CurAnchors then begin 2800 // keep distance to left side of parent or another sibling 2801 NewLeft:=GetAnchorSidePosition(akLeft,CurBaseBounds.Left); 2802 if akRight in CurAnchors then begin 2803 // keep distance to right side of parent or another sibling 2804 // -> change the width 2805 NewRight:=ParentClientWidth 2806 -(ParentBaseClientSize.cx-CurBaseBounds.Right); 2807 if (not (akRight in CurAlignAnchors)) 2808 and (akRight in Control.Anchors) then 2809 NewRight:=GetAnchorSidePosition(akRight,NewRight); 2810 NewWidth:=ConstraintWidth(NewRight-NewLeft); 2811 end else begin 2812 // do not anchor to the right 2813 // -> keep new width 2814 end; 2815 end else begin 2816 // do not anchor to the left 2817 if akRight in CurAnchors then begin 2818 // keep distance to right side of parent 2819 // and keep new width 2820 NewRight:=ParentClientWidth 2821 -(ParentBaseClientSize.cx-CurBaseBounds.Right); 2822 if (not (akRight in CurAlignAnchors)) 2823 and (akRight in Control.Anchors) then 2824 NewRight:=GetAnchorSidePosition(akRight,NewRight); 2825 NewLeft:=NewRight-NewWidth; 2826 end else begin 2827 // do not anchor to the right 2828 // -> keep new width and scale center position. 2829 NewLeft:=MulDiv(ParentClientWidth, 2830 (CurBaseBounds.Left+CurBaseBounds.Right) div 2, 2831 ParentBaseClientSize.cx) 2832 -(NewWidth div 2); 2833 end; 2834 end; 2835 2836 if akTop in CurAnchors then begin 2837 // keep distance to top side of parent 2838 NewTop:=GetAnchorSidePosition(akTop,CurBaseBounds.Top); 2839 if akBottom in CurAnchors then begin 2840 // keep distance to bottom side of parent 2841 // -> change the height 2842 NewBottom:=ParentClientHeight 2843 -(ParentBaseClientSize.cy-CurBaseBounds.Bottom); 2844 if (not (akBottom in CurAlignAnchors)) 2845 and (akBottom in Control.Anchors) then 2846 NewBottom:=GetAnchorSidePosition(akBottom,NewBottom); 2847 NewHeight:=ConstraintHeight(NewBottom-NewTop); 2848 end else begin 2849 // do not anchor to the bottom 2850 // -> keep new height 2851 end; 2852 end else begin 2853 // do not anchor to the top 2854 if akBottom in CurAnchors then begin 2855 // keep distance to bottom side of parent 2856 // and keep new height 2857 NewBottom:=ParentClientHeight 2858 -(ParentBaseClientSize.cy-CurBaseBounds.Bottom); 2859 if (not (akBottom in CurAlignAnchors)) 2860 and (akBottom in Control.Anchors) then 2861 NewBottom:=GetAnchorSidePosition(akBottom,NewBottom); 2862 NewTop:=NewBottom-NewHeight; 2863 end else begin 2864 // do not anchor to the bottom 2865 // -> keep new height and scale center position. 2866 NewTop:=MulDiv(ParentClientHeight, 2867 (CurBaseBounds.Top+CurBaseBounds.Bottom) div 2, 2868 ParentBaseClientSize.cy) 2869 -(NewHeight div 2); 2870 end; 2871 end; 2872 {$IFDEF CHECK_POSITION} 2873 //if csDesigning in ComponentState then 2874 if CheckPosition(Control) then 2875 with Control do begin 2876 DebugLn(['[TWinControl.AlignControls.DoPosition] After Anchoring', 2877 ' Self=',DbgSName(Self), 2878 ' Align=',DbgS(AAlign), 2879 ' Control=',dbgsName(Control), 2880 ' Old= l=',Left,',t=',Top,',w=',Width,',h=',Height, 2881 ' New= l=',NewLeft,',t=',NewTop,',w=',NewWidth,',h=',NewHeight, 2882 '']); 2883 DebugLn(['DoPosition akRight=',akRight in CurAnchors,' ',GetAnchorSidePosition(akRight,NewLeft+NewWidth)]); 2884 end; 2885 {$ENDIF} 2886 end; 2887 2888 // set min size to stop cycling (this should not be needed. But if someone 2889 // plays/fixes the above code, new bugs can enter and there are far too many 2890 // combinations to test, and so the LCL can loop for some applications. 2891 // Prevent this, so users can at least report a bug.) 2892 if NewWidth<0 then NewWidth:=0; 2893 if NewHeight<0 then NewHeight:=0; 2894 2895 case AAlign of 2896 alLeft,alTop,alRight,alBottom,alClient: begin 2897 { Realign 2898 2899 Use Align to align a control to the top, bottom, left, right of a 2900 form or panel and have it remain there even if the size of the form, 2901 panel, or component that contains the control changes. When the parent 2902 is resized, an aligned control also resizes so that it continues to span 2903 the top, bottom, left, or right edge of the parent (more exact: 2904 span the remaining client area of its parent). 2905 } 2906 NewRight:=NewLeft+NewWidth; 2907 NewBottom:=NewTop+NewHeight; 2908 2909 // calculate current RemainingClientRect for the current Control 2910 CurRemainingClientRect:=RemainingClientRect; 2911 CurRemainingBorderSpace:=RemainingBorderSpace; 2912 Control.BorderSpacing.GetSpaceAround(ChildAroundSpace); 2913 AdjustBorderSpace(CurRemainingClientRect,CurRemainingBorderSpace, 2914 ChildAroundSpace); 2915 {$IFDEF CHECK_POSITION} 2916 if CheckPosition(Control) then 2917 DebugLn('DoPosition Before aligning ',dbgsName(Control),' akRight in AnchorAlign[AAlign]=',DbgS(akRight in AnchorAlign[AAlign]), 2918 ' akLeft in Control.Anchors=',DbgS(akLeft in Control.Anchors), 2919 //' ARect=',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom, 2920 ' New=',DbgS(NewLeft,NewTop,NewRight,NewBottom)); 2921 {$ENDIF} 2922 2923 if akLeft in AnchorAlign[AAlign] 2924 then begin 2925 if (akRight in CurAnchors) 2926 then begin 2927 // left align and keep right border 2928 NewLeft:=CurRemainingClientRect.Left; 2929 NewRight:=NewLeft+ConstraintWidth(NewRight-NewLeft); 2930 end 2931 else begin 2932 // left align and right border free to move (-> keep width) 2933 dec(NewRight,NewLeft-CurRemainingClientRect.Left); 2934 NewLeft:=CurRemainingClientRect.Left; 2935 end; 2936 end; 2937 2938 if akTop in AnchorAlign[AAlign] 2939 then begin 2940 if (akBottom in CurAnchors) 2941 then begin 2942 // top align and keep bottom border 2943 NewTop:=CurRemainingClientRect.Top; 2944 NewBottom:=NewTop+ConstraintHeight(NewBottom-NewTop); 2945 end 2946 else begin 2947 // top align and bottom border is free to move (-> keep height) 2948 dec(NewBottom,NewTop-CurRemainingClientRect.Top); 2949 NewTop:=CurRemainingClientRect.Top; 2950 end; 2951 end; 2952 2953 if akRight in AnchorAlign[AAlign] 2954 then begin 2955 if (akLeft in CurAnchors) 2956 then begin 2957 // right align and keep left border 2958 NewWidth:=ConstraintWidth(CurRemainingClientRect.Right-NewLeft); 2959 if Align=alRight 2960 then begin 2961 // align to right (this overrides the keeping of left border) 2962 NewRight:=CurRemainingClientRect.Right; 2963 NewLeft:=NewRight-NewWidth; 2964 end 2965 else begin 2966 // keep left border overrides keeping right border 2967 NewRight:=NewLeft+NewWidth; 2968 end; 2969 end 2970 else begin 2971 // right align and left border free to move (-> keep width) 2972 inc(NewLeft,CurRemainingClientRect.Right-NewRight); 2973 NewRight:=CurRemainingClientRect.Right; 2974 end; 2975 end; 2976 2977 if akBottom in AnchorAlign[AAlign] 2978 then begin 2979 if (akTop in CurAnchors) 2980 then begin 2981 // bottom align and keep top border 2982 NewHeight:=ConstraintHeight(CurRemainingClientRect.Bottom-NewTop); 2983 if AAlign=alBottom 2984 then begin 2985 // align to bottom (this overrides the keeping of top border) 2986 NewBottom:=CurRemainingClientRect.Bottom; 2987 NewTop:=NewBottom-NewHeight; 2988 end 2989 else begin 2990 // keeping top border overrides keeping bottom border 2991 NewBottom:=NewTop+NewHeight; 2992 end; 2993 end 2994 else begin 2995 // bottom align and top border free to move (-> keep height) 2996 inc(NewTop,CurRemainingClientRect.Bottom-NewBottom); 2997 NewBottom:=CurRemainingClientRect.Bottom; 2998 end; 2999 end; 3000 3001 NewWidth:=Max(0,NewRight-NewLeft); 3002 NewHeight:=Max(0,NewBottom-NewTop); 3003 3004 {$IFDEF CHECK_POSITION} 3005 //if csDesigning in Control.ComponentState then 3006 if CheckPosition(Control) then 3007 with Control do 3008 DebugLn('[TWinControl.AlignControls.DoPosition] After Aligning', 3009 ' ',Name,':',ClassName, 3010 ' Align=',DbgS(AAlign), 3011 ' Control=',Name,':',ClassName, 3012 ' Old=',DbgS(Left,Top,Width,Height), 3013 ' New=',DbgS(NewLeft,NewTop,NewWidth,NewHeight), 3014 //' ARect=',ARect.Left,',',ARect.Top,',',ARect.Right-ARect.Left,',',ARect.Bottom-ARect.Top, 3015 ''); 3016 {$ENDIF} 3017 end; 3018 alCustom: begin 3019 AlignInfo.AlignList := AlignList; 3020 AlignInfo.Align := alCustom; 3021 AlignInfo.ControlIndex := AControlIndex; 3022 CustomAlignPosition(Control, NewLeft, NewTop, NewWidth, NewHeight, RemainingClientRect, AlignInfo); 3023 end; 3024 end; 3025 3026 // apply the constraints 3027 NewWidth:=ConstraintWidth(NewWidth); 3028 NewHeight:=ConstraintHeight(NewHeight); 3029 NewRight:=NewLeft+NewWidth; 3030 NewBottom:=NewTop+NewHeight; 3031 3032 // set the new bounds 3033 if (Control.Left <> NewLeft) or (Control.Top <> NewTop) 3034 or (Control.Width <> NewWidth) or (Control.Height <> NewHeight) then begin 3035 {$IFDEF CHECK_POSITION} 3036 //if csDesigning in Control.ComponentState then 3037 if CheckPosition(Control) then 3038 with Control do 3039 DebugLn('[TWinControl.AlignControls.DoPosition] NEW BOUNDS Control=',DbgSName(Control), 3040 ' New=l=',dbgs(NewLeft)+',t='+dbgs(NewTop)+',w='+dbgs(NewWidth)+',h='+dbgs(NewHeight)); 3041 {$ENDIF} 3042 // lock the base bounds, so that the new automatic bounds do not override 3043 // the user settings 3044 OldBounds:=Control.BoundsRect; 3045 Control.SetBoundsKeepBase(NewLeft, NewTop, NewWidth, NewHeight); 3046 //DebugLn(['DoPosition ',DbgSName(Control),' ',cfAutoSizeNeeded in Control.FControlFlags]); 3047 NewBounds:=Control.BoundsRect; 3048 BoundsMutated:=not CompareRect(@OldBounds,@NewBounds); 3049 if BoundsMutated then begin 3050 LastBoundsMutated:=Control; 3051 LastBoundsMutatedOld:=OldBounds; 3052 end; 3053 // Sometimes SetBounds change the bounds. For example due to constraints. 3054 // update the new bounds 3055 with Control do 3056 begin 3057 NewLeft:=Left; 3058 NewTop:=Top; 3059 NewWidth:=Width; 3060 NewHeight:=Height; 3061 end; 3062 {$IFDEF CHECK_POSITION} 3063 //if csDesigning in Control.ComponentState then 3064 if CheckPosition(Control) then 3065 with Control do 3066 DebugLn('[TWinControl.AlignControls.DoPosition] AFTER SETBOUND Control=',DbgSName(Control),' Bounds=',DbgS(Control.BoundsRect)); 3067 {$ENDIF} 3068 end; 3069 3070 // adjust the remaining client area 3071 case AAlign of 3072 alTop: 3073 begin 3074 RemainingClientRect.Top:=Min(NewTop+NewHeight,RemainingClientRect.Bottom); 3075 RemainingBorderSpace.Top:=0; 3076 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3077 0,Max(ChildSizing.VerticalSpacing,ChildAroundSpace.Bottom),0,0); 3078 end; 3079 alBottom: 3080 begin 3081 RemainingClientRect.Bottom:=Max(NewTop,RemainingClientRect.Top); 3082 RemainingBorderSpace.Bottom:=0; 3083 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3084 0,0,0,Max(ChildSizing.VerticalSpacing,ChildAroundSpace.Top)); 3085 end; 3086 alLeft: 3087 begin 3088 RemainingClientRect.Left:=Min(NewLeft+NewWidth,RemainingClientRect.Right); 3089 RemainingBorderSpace.Left:=0; 3090 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3091 Max(ChildSizing.HorizontalSpacing,ChildAroundSpace.Right),0,0,0); 3092 end; 3093 alRight: 3094 begin 3095 RemainingClientRect.Right:=Max(NewLeft,RemainingClientRect.Left); 3096 RemainingBorderSpace.Right:=0; 3097 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3098 0,0,Max(ChildSizing.HorizontalSpacing,ChildAroundSpace.Left),0); 3099 end; 3100 alClient: 3101 begin 3102 // For VCL compatibility alClient should *not* reduce the free space, 3103 // so that several alClient controls can overlap. This can be used 3104 // for example to simulate a two page control and edit both pages 3105 // at designtime with SendToBack. 3106 // At runtime programs should use Visible instead of BringToFront to 3107 // reduce overhead. 3108 // See bug 10380. 3109 end; 3110 end; 3111 3112 {$IFDEF CHECK_POSITION} 3113 if CheckPosition(Control) then 3114 with Control do 3115 DebugLn('[TWinControl.AlignControls.DoPosition] END Control=', 3116 Name,':',ClassName, 3117 ' ',DbgS(Left,Top,Width,Height), 3118 ' Align=',DbgS(AAlign), 3119 //' ARect=',ARect.Left,',',ARect.Top,',',ARect.Right-ARect.Left,',',ARect.Bottom-ARect.Top, 3120 ''); 3121 {$ENDIF} 3122 end; 3123 3124 procedure DoAlign(AAlign: TAlign); 3125 var 3126 I: Integer; 3127 Control: TControl; 3128 begin 3129 //DebugLn(['DoAlign ',DbgSName(Self),' ',dbgs(AALign),' ClientRect=',dbgs(ClientRect),' ControlCount=',ControlCount]); 3130 CreateControlAlignList(AAlign,AlignList,AControl); 3131 {$IFDEF CHECK_POSITION} 3132 if CheckPosition(Self) then 3133 if AlignList.Count>0 then 3134 begin 3135 DbgOut('[TWinControl.AlignControls.DoAlign] Self=',DbgSName(Self),' Control=',dbgsName(AControl), 3136 ' current align=',DbgS(AAlign),' AlignList=['); 3137 for i:=0 to AlignList.Count-1 do 3138 begin 3139 if i>0 then DbgOut(','); 3140 DbgOut(DbgSName(TObject(AlignList[i]))); 3141 end; 3142 DebugLn(']'); 3143 end; 3144 {$ENDIF} 3145 3146 // let override handle them 3147 if DoAlignChildControls(AAlign, AControl, AlignList, RemainingClientRect) then 3148 exit; 3149 // remove controls that are positioned by other means 3150 if (AAlign = alNone) and (AutoSize or (ChildSizing.Layout <> cclNone)) then 3151 for I := AlignList.Count - 1 downto 0 do 3152 begin 3153 Control := TControl(AlignList[I]); 3154 if IsNotAligned(Control) then AlignList.Delete(I); 3155 end; 3156 // anchor/align control 3157 for I := 0 to AlignList.Count - 1 do 3158 DoPosition(TControl(AlignList[I]), AAlign, I); 3159 end; 3160 3161 procedure DoAlignNotAligned; 3162 // All controls, not aligned by their own properties, can be auto aligned. 3163 var 3164 i: Integer; 3165 Control: TControl; 3166 begin 3167 // check if ChildSizing aligning is enabled 3168 if (ChildSizing.Layout = cclNone) then 3169 exit; 3170 3171 /// collect all 'not aligned' controls 3172 AlignList.Clear; 3173 for i := 0 to ControlCount - 1 do 3174 begin 3175 Control := Controls[i]; 3176 if IsNotAligned(Control) and Control.IsControlVisible then 3177 AlignList.Add(Control); 3178 end; 3179 //debugln('DoAlignNotAligned ',DbgSName(Self),' AlignList.Count=',dbgs(AlignList.Count)); 3180 if AlignList.Count = 0 then exit; 3181 3182 LastBoundsMutated := nil; 3183 AlignNonAlignedControls(AlignList, BoundsMutated); 3184 end; 3185 3186var 3187 i: Integer; 3188 OldRemainingClientRect: TRect; 3189 OldRemainingBorderSpace: TRect; 3190 MaxTries: LongInt; 3191 r: TRect; 3192begin 3193 //DebugLn(['TWinControl.AlignControls ',DbgSName(Self),' ',not (wcfAligningControls in FWinControlFlags)]); 3194 if wcfAligningControls in FWinControlFlags then exit; 3195 Include(FWinControlFlags,wcfAligningControls); 3196 try 3197 //if csDesigning in ComponentState then begin 3198 //DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' AlignWork=',NeedAlignWork,' ControlCount=',ControlCount); 3199 //if AControl<>nil then DebugLn(' AControl=',AControl.Name,':',AControl.ClassName); 3200 //end; 3201 // first let the DockManager align controls 3202 if DockSite and UseDockManager and (DockManager<>nil) then 3203 DockManager.ResetBounds(false); 3204 AdjustClientRect(RemainingClientRect); 3205 r:=GetLogicalClientRect; 3206 ParentClientWidth:=r.Right; 3207 ParentClientHeight:=r.Bottom; 3208 3209 if NeedAlignWork then 3210 begin 3211 //DebugLn(['TWinControl.AlignControls ',DbgSName(Self),' RemainingClientRect=',dbgs(RemainingClientRect),' ',dbgs(ClientRect)]); 3212 RemainingBorderSpace:=Rect(0,0,0,0); 3213 // adjust RemainingClientRect by ChildSizing properties 3214 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3215 ChildSizing.LeftRightSpacing,ChildSizing.TopBottomSpacing, 3216 ChildSizing.LeftRightSpacing,ChildSizing.TopBottomSpacing); 3217 //DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',RemainingClientRect.Left,',',RemainingClientRect.Top,',',RemainingClientRect.Right,',',RemainingClientRect.Bottom); 3218 AlignList := TFPList.Create; 3219 try 3220 // Auto aligning/anchoring can be very interdependent. 3221 // In worst case the n-2 depends on the n-1, the n-3 depends on n-2 3222 // and so forth. This is allowed, so do up to n loop step. 3223 // Do not more, to avoid endless loops, if there are circlular 3224 // dependencies. 3225 MaxTries:=ControlCount; 3226 {$IFDEF CHECK_POSITION}inc(MaxTries);{$ENDIF} 3227 for i:=1 to MaxTries do begin 3228 // align and anchor child controls 3229 BoundsMutated:=false; 3230 OldRemainingClientRect:=RemainingClientRect; 3231 OldRemainingBorderSpace:=RemainingBorderSpace; 3232 DoAlign(alTop); 3233 DoAlign(alBottom); 3234 DoAlign(alLeft); 3235 DoAlign(alRight); 3236 DoAlign(alClient); 3237 DoAlign(alCustom); 3238 DoAlign(alNone); 3239 DoAlignNotAligned; 3240 if not BoundsMutated then break; 3241 if (i=ControlCount+1) then begin 3242 DebugLn(['Warning: TWinControl.AlignControls ENDLESS LOOP STOPPED ',DbgSName(Self),' i=',i]); 3243 if LastBoundsMutated<>nil then 3244 DebugLn(['Warning: TWinControl.AlignControls LAST CHANGED: ',DbgSName(LastBoundsMutated),' Old=',dbgs(LastBoundsMutatedOld),' Now=',dbgs(LastBoundsMutated.BoundsRect)]); 3245 end; 3246 // update again 3247 RemainingClientRect:=OldRemainingClientRect; 3248 RemainingBorderSpace:=OldRemainingBorderSpace; 3249 end; 3250 finally 3251 AlignList.Free; 3252 end; 3253 end; 3254 ControlsAligned; 3255 finally 3256 Exclude(FWinControlFlags,wcfAligningControls); 3257 end; 3258end; 3259 3260function TWinControl.CustomAlignInsertBefore(AControl1, AControl2: TControl): Boolean; 3261begin 3262 Result := Assigned(FOnAlignInsertBefore) 3263 and FOnAlignInsertBefore(Self, AControl1, AControl2); 3264end; 3265 3266procedure TWinControl.CustomAlignPosition(AControl: TControl; var ANewLeft, ANewTop, 3267 ANewWidth, ANewHeight: Integer; var AlignRect: TRect; AlignInfo: TAlignInfo); 3268begin 3269 if Assigned(FOnAlignPosition) 3270 then FOnAlignPosition(Self, AControl, ANewLeft, ANewTop, ANewWidth, ANewHeight, AlignRect, AlignInfo); 3271end; 3272 3273function TWinControl.DoAlignChildControls(TheAlign: TAlign; AControl: TControl; 3274 AControlList: TFPList; var ARect: TRect): Boolean; 3275begin 3276 Result:=false; 3277end; 3278 3279procedure TWinControl.DoChildSizingChange(Sender: TObject); 3280begin 3281 //debugln('TWinControl.DoChildSizingChange ',DbgSName(Self)); 3282 if ControlCount=0 then exit; 3283 InvalidatePreferredSize; 3284 ReAlign; 3285end; 3286 3287procedure TWinControl.InvalidatePreferredChildSizes; 3288var 3289 AControl: TControl; 3290 i: Integer; 3291begin 3292 for i:=0 to ControlCount-1 do begin 3293 AControl:=Controls[i]; 3294 Exclude(AControl.FControlFlags,cfPreferredSizeValid); 3295 Exclude(AControl.FControlFlags,cfPreferredMinSizeValid); 3296 if AControl is TWinControl then 3297 Exclude(TWinControl(AControl).FWinControlFlags,wcfAdjustedLogicalClientRectValid); 3298 if AControl is TWinControl then 3299 TWinControl(AControl).InvalidatePreferredChildSizes; 3300 end; 3301end; 3302 3303{------------------------------------------------------------------------------- 3304 procedure TWinControl.DoAutoSize; 3305 3306 Shrink or enlarge to fit children. 3307-------------------------------------------------------------------------------} 3308procedure TWinControl.DoAutoSize; 3309var 3310 HasVisibleChilds: boolean; 3311 3312 procedure GetMoveDiffForNonAlignedChilds(const CurClientRect: TRect; 3313 out dx, dy: integer); 3314 // how much can non-aligned-children be moved up and left 3315 // non-aligned-children: no fixed anchoring or autosizing, 3316 // (Align=alNone, visible, AnchorSide[].Control=nil) 3317 // borderspacing is used 3318 // e.g. dx=10 means all non-align-children should be moved 10 pixels to the left 3319 var 3320 NewClientWidth, NewClientHeight: integer; 3321 Layout: TAutoSizeCtrlData; 3322 begin 3323 if ChildSizing.Layout<>cclNone then begin 3324 dx:=0; 3325 dy:=0; 3326 exit; 3327 end; 3328 3329 // get the move requirements for the child controls 3330 Layout:=nil; 3331 try 3332 Layout:=TAutoSizeCtrlData.Create(Self); 3333 Layout.ComputePreferredClientArea( 3334 not (csAutoSizeKeepChildLeft in ControlStyle), 3335 not (csAutoSizeKeepChildTop in ControlStyle), 3336 dx,dy,NewClientWidth,NewClientHeight); 3337 if (NewClientWidth<>0) or (NewClientHeight<>0) then ; 3338 //if (dx<>0) or (dy<>0) then DebugLn(['GetMoveDiffForNonAlignedChilds ',DbgSName(Self),' dx=',dx,' dy=',dy]); 3339 finally 3340 Layout.Free; 3341 end; 3342 end; 3343 3344var 3345 I: Integer; 3346 AControl: TControl; 3347 PreferredWidth: LongInt; 3348 PreferredHeight: LongInt; 3349 CurClientRect: TRect; 3350 WidthIsFixed: boolean; 3351 HeightIsFixed: boolean; 3352 NewLeft: LongInt; 3353 NewTop: LongInt; 3354 CurAnchors: TAnchors; 3355 dx: Integer; 3356 dy: Integer; 3357 NewChildBounds: TRect; 3358 OldChildBounds: TRect; 3359begin 3360 {$IFDEF VerboseAllAutoSize} 3361 debugln('TWinControl.DoAutoSize ',DbgSName(Self)); 3362 {$ENDIF} 3363 if not (caspComputingBounds in AutoSizePhases) then begin 3364 {$IFDEF VerboseAllAutoSize} 3365 DebugLn(['TWinControl.DoAutoSize DELAYED AutoSizePhases=',dbgs(AutoSizePhases)]); 3366 {$ENDIF} 3367 AdjustSize; 3368 exit; 3369 end; 3370 3371 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DoAutoSize'){$ENDIF}; 3372 try 3373 // test if resizing is possible 3374 HasVisibleChilds:=false; 3375 for i:=0 to ControlCount-1 do 3376 if Controls[i].IsControlVisible then begin 3377 HasVisibleChilds:=true; 3378 break; 3379 end; 3380 3381 CurAnchors:=Anchors; 3382 if Align<>alNone then CurAnchors:=CurAnchors+AnchorAlign[Align]; 3383 WidthIsFixed:=WidthIsAnchored; 3384 HeightIsFixed:=HeightIsAnchored; 3385 3386 // move free children as much as possible to left and top (all free children the same) 3387 if HasVisibleChilds then begin 3388 CurClientRect:=GetLogicalClientRect; 3389 AdjustClientRect(CurClientRect); 3390 // get minimum left, top of non aligned children 3391 GetMoveDiffForNonAlignedChilds(CurClientRect,dx,dy); 3392 //DebugLn(['TWinControl.DoAutoSize ',DbgSName(Self),' CurClientRect=',dbgs(CurClientRect)]); 3393 3394 if (dx<>0) or (dy<>0) then begin 3395 // move all free children to left and top of client area 3396 //DebugLn(['TWinControl.DoAutoSize ',DbgSName(Self),' dx=',dbgs(dx),' dy=',dbgs(dy),' CurClientRect=',dbgs(CurClientRect),' CurAnchors=',dbgs(CurAnchors),' IsFixed: w=',WidthIsFixed,' h=',HeightIsFixed]); 3397 for I := 0 to ControlCount - 1 do begin 3398 AControl:=Controls[I]; 3399 if not AControl.IsControlVisible then continue; 3400 if AControl.Align<>alNone then continue; 3401 //DebugLn(['TWinControl.DoAutoSize BEFORE ',DbgSName(AControl),' ',dbgs(AControl.BoundsRect)]); 3402 NewChildBounds:=AControl.BoundsRect; 3403 if (akLeft in AControl.Anchors) 3404 and (AControl.AnchorSide[akLeft].Control=nil) then begin 3405 dec(NewChildBounds.Left,dx); 3406 if not (akRight in AControl.Anchors) then 3407 dec(NewChildBounds.Right,dx); 3408 end; 3409 if (akTop in AControl.Anchors) 3410 and (AControl.AnchorSide[akTop].Control=nil) then begin 3411 dec(NewChildBounds.Top,dy); 3412 if not (akBottom in AControl.Anchors) then 3413 dec(NewChildBounds.Bottom,dy); 3414 end; 3415 // Important: change the BaseBounds too, otherwise the changes will be undone by AlignControls 3416 OldChildBounds:=AControl.BoundsRect; 3417 if not CompareRect(@OldChildBounds,@NewChildBounds) then begin 3418 //DebugLn(['TWinControl.DoAutoSize moving child: ',DbgSName(AControl),' Old=',dbgs(OldChildBounds),' New=',dbgs(NewChildBounds)]); 3419 AControl.BoundsRect:=NewChildBounds; 3420 //DebugLn(['TWinControl.DoAutoSize AFTER ',DbgSName(AControl),' ',dbgs(AControl.BoundsRect)]); 3421 end; 3422 end; 3423 end; 3424 end; 3425 3426 // autosize control to preferred size 3427 if (not WidthIsFixed) or (not HeightIsFixed) then begin 3428 GetPreferredSize(PreferredWidth,PreferredHeight, 3429 false,// with constraints 3430 true // with theme space 3431 ); 3432 //if ControlCount>0 then DebugLn(['TWinControl.DoAutoSize ',DbgSName(Self),' PreferredWidth=',PreferredWidth,' PreferredHeight=',PreferredHeight,' ControlCount=',ControlCount]); 3433 end else begin 3434 PreferredWidth:=0; 3435 PreferredHeight:=0; 3436 end; 3437 if WidthIsFixed or (PreferredWidth<0) 3438 or ((PreferredWidth=0) and (not (csAutoSize0x0 in ControlStyle))) then 3439 PreferredWidth:=Constraints.MinMaxWidth(Width); 3440 if HeightIsFixed or (PreferredHeight<0) 3441 or ((PreferredHeight=0) and (not (csAutoSize0x0 in ControlStyle))) then 3442 PreferredHeight:=Constraints.MinMaxHeight(Height); 3443 3444 // set new size 3445 {$IF defined(VerboseAutoSize) or defined(VerboseAllAutoSize)} 3446 debugln(['TWinControl.DoAutoSize A ',DbgSName(Self),' Cur=',Width,'x',Height,' Prefer=',PreferredWidth,'x',PreferredHeight,' WidgetClass=',WidgetSetClass.ClassName,' Fixed=',WidthIsFixed,'x',HeightIsFixed]); 3447 {$ENDIF} 3448 if (PreferredWidth<>Width) or (PreferredHeight<>Height) then begin 3449 // adjust Left/Top as well to reduce auto sizing overhead 3450 NewLeft:=Left; 3451 NewTop:=Top; 3452 if akRight in CurAnchors then 3453 inc(NewLeft,Width-PreferredWidth); 3454 if akBottom in CurAnchors then 3455 inc(NewTop,Height-PreferredHeight); 3456 //if CompareText(Name,'NewUnitOkButton')=0 then 3457 //debugln(['DoAutoSize Resize ',DbgSName(Self),' Old=',dbgs(BoundsRect),' New=',dbgs(Bounds(NewLeft,NewTop,PreferredWidth,PreferredHeight)),' WidthIsFixed=',WidthIsFixed,' HeightIsFixed=',HeightIsFixed,' Align=',dbgs(Align),' Anchors=',dbgs(Anchors)]); 3458 SetBoundsKeepBase(NewLeft,NewTop,PreferredWidth,PreferredHeight); 3459 end; 3460 finally 3461 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DoAutoSize'){$ENDIF}; 3462 end; 3463end; 3464 3465procedure TWinControl.DoAllAutoSize; 3466 3467 function CheckHandleAllocated(AWinControl: TWinControl): boolean; 3468 // true if a handle was missing 3469 var 3470 i: Integer; 3471 ChildWinControl: TWinControl; 3472 begin 3473 if AWinControl.HandleObjectShouldBeVisible and (not AWinControl.HandleAllocated) then 3474 begin 3475 {$IFDEF VerboseAllAutoSize} 3476 DebugLn(['TWinControl.DoAllAutoSize CREATE HANDLE ',DbgSName(AWinControl)]); 3477 {$ENDIF} 3478 AWinControl.HandleNeeded; 3479 Exit(True); 3480 end; 3481 Result := False; 3482 for i := 0 to AWinControl.ControlCount - 1 do 3483 begin 3484 ChildWinControl := TWinControl(AWinControl.Controls[i]); 3485 if (ChildWinControl is TWinControl) and CheckHandleAllocated(ChildWinControl) then 3486 Result:=true; 3487 end; 3488 end; 3489 3490 procedure ClearRequests(AControl: TControl); 3491 var 3492 i: Integer; 3493 begin 3494 Exclude(AControl.FControlFlags,cfAutoSizeNeeded); 3495 if AControl is TWinControl then 3496 for i:=0 to TWinControl(AControl).ControlCount-1 do 3497 ClearRequests(TWinControl(AControl).Controls[i]); 3498 end; 3499 3500 procedure UpdateShowingRecursive(AWinControl: TWinControl; 3501 OnlyChildren: boolean); 3502 var 3503 i: Integer; 3504 begin 3505 // first make the children visible 3506 if AWinControl.FControls<>nil then 3507 for i:=0 to AWinControl.FControls.Count-1 do 3508 if TObject(AWinControl.FControls[i]) is TWinControl then 3509 UpdateShowingRecursive(TWinControl(AWinControl.FControls[i]),false); 3510 // then make the control visible 3511 if not OnlyChildren and AWinControl.HandleObjectShouldBeVisible and not AWinControl.Showing then 3512 AWinControl.UpdateShowing; 3513 end; 3514 3515var 3516 RealizeCounter: Integer; 3517 UpdateShowingCounter: Integer; 3518begin 3519 if wcfAllAutoSizing in FWinControlFlags then exit; 3520 if AutoSizeDelayed then exit; 3521 3522 {$IFDEF VerboseAllAutoSize} 3523 DebugLn(['TWinControl.DoAllAutoSize START ',DbgSName(Self),' ',dbgs(BoundsRect)]); 3524 {$ENDIF} 3525 Include(FWinControlFlags,wcfAllAutoSizing); 3526 try 3527 // create needed handles 3528 if HandleObjectShouldBeVisible then begin 3529 if CheckHandleAllocated(Self) then begin 3530 // a new handle was created 3531 end; 3532 end else begin 3533 // no autosize possible => remove needed flags 3534 ClearRequests(Self); 3535 exit; 3536 end; 3537 3538 RealizeCounter:=0; 3539 UpdateShowingCounter:=0; 3540 while (not AutoSizeDelayed) do 3541 begin 3542 // compute all sizes for LCL objects without touching the widgetset 3543 {$IFDEF VerboseAllAutoSize} 3544 DebugLn(['TWinControl.DoAllAutoSize COMPUTE BOUNDS ',DbgSName(Self),' old=',dbgs(BoundsRect)]); 3545 {$ENDIF} 3546 inherited DoAllAutoSize; 3547 if cfAutoSizeNeeded in FControlFlags then RaiseGDBException(''); 3548 AllAutoSized; 3549 // send all new bounds to widgetset 3550 {$IFDEF VerboseAllAutoSize} 3551 DebugLn(['TWinControl.DoAllAutoSize REALIZE BOUNDS ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]); 3552 {$ENDIF} 3553 inc(RealizeCounter); 3554 if RealizeCounter=100 then 3555 Include(FWinControlFlags,wcfKillIntfSetBounds); 3556 RealizeBoundsRecursive; 3557 if (cfAutoSizeNeeded in FControlFlags) then continue; // repeat computing bounds 3558 RealizeCounter:=0; 3559 inc(UpdateShowingCounter); 3560 // make child handles visible 3561 {$IFDEF VerboseAllAutoSize} 3562 DebugLn(['TWinControl.DoAllAutoSize UPDATESHOWING children ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]); 3563 {$ENDIF} 3564 Include(FWinControlFlags,wcfUpdateShowing); 3565 try 3566 UpdateShowingRecursive(Self,true); 3567 finally 3568 Exclude(FWinControlFlags,wcfUpdateShowing); 3569 end; 3570 // check if another turn is needed 3571 if not (cfAutoSizeNeeded in FControlFlags) then break; // complete 3572 end; 3573 {$IFDEF VerboseAllAutoSize} 3574 DebugLn(['TWinControl.DoAllAutoSize END ',DbgSName(Self),' ',dbgs(BoundsRect)]); 3575 {$ENDIF} 3576 finally 3577 FWinControlFlags:=FWinControlFlags-[wcfAllAutoSizing,wcfKillIntfSetBounds]; 3578 end; 3579 // make handle visible => this can trigger events like Form.OnShow where 3580 // application does arbitrary stuff 3581 {$IFDEF VerboseAllAutoSize} 3582 DebugLn(['TWinControl.DoAllAutoSize UPDATESHOWING self ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]); 3583 {$ENDIF} 3584 if not (wcfUpdateShowing in FWinControlFlags) then 3585 begin 3586 Include(FWinControlFlags, wcfUpdateShowing); 3587 try 3588 if HandleObjectShouldBeVisible and not Showing then 3589 UpdateShowing 3590 else begin 3591 {$IFDEF VerboseAllAutoSize} 3592 DebugLn(['TWinControl.DoAllAutoSize not UPDATESHOWING self ',DbgSName(Self),' because HandleObjectShouldBeVisible=',HandleObjectShouldBeVisible,' Showing=',Showing]); 3593 {$ENDIF} 3594 end; 3595 finally 3596 Exclude(FWinControlFlags, wcfUpdateShowing); 3597 end; 3598 end; 3599end; 3600 3601procedure TWinControl.AllAutoSized; 3602begin 3603 // see TCustomForm.AllAutoSized 3604end; 3605 3606{------------------------------------------------------------------------------ 3607 TWinControl BroadCast 3608------------------------------------------------------------------------------} 3609procedure TWinControl.BroadCast(var ToAllMessage); 3610var 3611 I: Integer; 3612begin 3613 for I := 0 to ControlCount - 1 do 3614 begin 3615 Controls[I].WindowProc(TLMessage(ToAllMessage)); 3616 if TLMessage(ToAllMessage).Result <> 0 then Exit; 3617 end; 3618end; 3619 3620procedure TWinControl.NotifyControls(Msg: Word); 3621var 3622 ToAllMessage: TLMessage; 3623begin 3624 ToAllMessage.Msg := Msg; 3625 ToAllMessage.WParam := 0; 3626 ToAllMessage.LParam := 0; 3627 ToAllMessage.Result := 0; 3628 Broadcast(ToAllMessage); 3629end; 3630 3631procedure TWinControl.DefaultHandler(var AMessage); 3632begin 3633 TWSWinControlClass(WidgetSetClass).DefaultWndHandler(Self, AMessage); 3634end; 3635 3636 3637{------------------------------------------------------------------------------ 3638 TWinControl CanFocus 3639 3640 3641------------------------------------------------------------------------------} 3642function TWinControl.CanFocus: Boolean; 3643var 3644 Control: TWinControl; 3645 Form: TCustomForm; 3646begin 3647 Result := False; 3648 //Verify that every parent is enabled and visible before returning true. 3649 Form := GetParentForm(Self); 3650 if Form <> nil then 3651 begin 3652 Control := Self; 3653 repeat 3654 if Control = Form then break; 3655 // test all except the Form if it is visible and enabled 3656 if not (Control.IsControlVisible and Control.Enabled) then Exit; 3657 Control := Control.Parent; 3658 until False; 3659 Result := True; 3660 end; 3661end; 3662 3663{------------------------------------------------------------------------------ 3664 TWinControl CanSetFocus 3665 3666 CanSetFocus should be prefered over CanFocus if used in CanSetFocus/SetFocus 3667 combination 3668 3669 if MyControl.CanSetFocus then 3670 MyControl.SetFocus; 3671 3672 because it checks also if the parent form can receive focus and thus prevents 3673 the "cannot focus an invisible window" LCL exception. 3674------------------------------------------------------------------------------} 3675function TWinControl.CanSetFocus: Boolean; 3676var 3677 Control: TWinControl; 3678begin 3679 Control := Self; 3680 while True do 3681 begin 3682 // test if all are visible and enabled 3683 if not (Control.IsControlVisible and Control.Enabled) then 3684 Exit(False); 3685 if not Assigned(Control.Parent) then 3686 Break; 3687 Control := Control.Parent; 3688 end; 3689 Result := Control is TCustomForm;//the very top parent must be a form 3690end; 3691 3692{------------------------------------------------------------------------------ 3693 TWinControl CreateSubClass 3694------------------------------------------------------------------------------} 3695procedure TWinControl.CreateSubClass(var Params: TCreateParams; 3696 ControlClassName: PChar); 3697begin 3698 // TODO: Check if we need this method 3699end; 3700 3701{------------------------------------------------------------------------------ 3702 TWinControl DisableAlign 3703------------------------------------------------------------------------------} 3704procedure TWinControl.DisableAlign; 3705begin 3706 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DisableAlign'){$ENDIF}; 3707end; 3708 3709{------------------------------------------------------------------------------- 3710 TWinControl DoAdjustClientRectChange 3711 3712 Asks the interface if clientrect has changed since last AlignControl 3713 and calls AdjustSize on change. 3714-------------------------------------------------------------------------------} 3715procedure TWinControl.DoAdjustClientRectChange(const InvalidateRect: Boolean = True); 3716var 3717 R: TRect; 3718begin 3719 if InvalidateRect then 3720 InvalidateClientRectCache(False); 3721 R := GetClientRect; 3722 AdjustClientRect(R); 3723 //if CheckPosition(Self) then 3724 //DebugLn(['TWinControl.DoAdjustClientRectChange ',DbgSName(Self),' new=',dbgs(r),' old=',dbgs(FAdjustClientRectRealized),' ',CompareRect(@r,@FAdjustClientRectRealized)]); 3725 if not CompareRect(@R, @FAdjustClientRectRealized) then 3726 begin 3727 // client rect changed since last AlignControl 3728 {$IF defined(VerboseAllAutoSize) or defined(VerboseClientRectBugFix) or defined(VerboseIntfSizing) or defined(VerboseOnResize)} 3729 DebugLn(['TWinControl.DoAdjustClientRectChange ClientRect changed ',DbgSName(Self), 3730 ' Old=',Dbgs(FAdjustClientRectRealized),' New=',DbgS(R)]); 3731 {$ENDIF} 3732 FAdjustClientRectRealized := R; 3733 AdjustSize; 3734 Resize; 3735 end; 3736end; 3737 3738{------------------------------------------------------------------------------- 3739 TWinControl DoConstraintsChange 3740 Params: Sender : TObject 3741 3742 Call inherited, then send the constraints to the interface 3743-------------------------------------------------------------------------------} 3744procedure TWinControl.DoConstraintsChange(Sender : TObject); 3745begin 3746 inherited DoConstraintsChange(Sender); 3747 //debugln('TWinControl.DoConstraintsChange ',DbgSName(Self),' HandleAllocated=',dbgs(HandleAllocated)); 3748 if HandleAllocated then 3749 TWSWinControlClass(WidgetSetClass).ConstraintsChange(Self); 3750end; 3751 3752{------------------------------------------------------------------------------- 3753 TWinControl InvalidateClientRectCache(WithChildControls: boolean) 3754 3755 The clientrect is cached. Call this procedure to invalidate the cache, so that 3756 next time the clientrect is fetched from the interface. 3757-------------------------------------------------------------------------------} 3758procedure TWinControl.InvalidateClientRectCache(WithChildControls: boolean); 3759var 3760 I: Integer; 3761begin 3762 {$IFDEF VerboseClientRectBugFix} 3763 if Name=CheckClientRectName then begin 3764 DebugLn(['TWinControl.InvalidateClientRectCache ',DbgSName(Self)]); 3765 //DumpStack; 3766 end; 3767 {$ENDIF} 3768 Exclude(FWinControlFlags,wcfAdjustedLogicalClientRectValid); 3769 Include(FWinControlFlags,wcfClientRectNeedsUpdate); 3770 3771 if WithChildControls then begin 3772 // invalidate clients too 3773 if Assigned(FControls) then 3774 for I := 0 to FControls.Count - 1 do 3775 if TObject(FControls.Items[I]) is TWinControl then 3776 TWinControl(FControls.Items[I]).InvalidateClientRectCache(true); 3777 end; 3778 InvalidatePreferredSize; 3779end; 3780 3781{------------------------------------------------------------------------------- 3782 TWinControl ClientRectNeedsInterfaceUpdate 3783 3784 The clientrect is cached. Check if cache is valid. 3785-------------------------------------------------------------------------------} 3786function TWinControl.ClientRectNeedsInterfaceUpdate: boolean; 3787var 3788 InterfaceWidth, InterfaceHeight: integer; 3789 IntfClientRect: TRect; 3790begin 3791 if (not HandleAllocated) or (csDestroyingHandle in ControlState) 3792 or (csDestroying in ComponentState) 3793 then 3794 exit(false); 3795 if wcfClientRectNeedsUpdate in FWinControlFlags then 3796 exit(true); 3797 // get the current interface bounds 3798 LCLIntf.GetWindowSize(Handle,InterfaceWidth,InterfaceHeight); 3799 LCLIntf.GetClientRect(Handle,IntfClientRect); 3800 // The LCL is not always in sync with the interface. 3801 // Add the difference between LCL size and interface size to the 3802 // interface clientrect 3803 inc(IntfClientRect.Right,Width-InterfaceWidth); 3804 inc(IntfClientRect.Bottom,Height-InterfaceHeight); 3805 Result:=(FClientWidth<>IntfClientRect.Right) 3806 or (FClientHeight<>IntfClientRect.Bottom); 3807 {$IFDEF VerboseClientRectBugFix} 3808 if (Name=CheckClientRectName) and Result then 3809 DebugLn(['TWinControl.ClientRectNeedsInterfaceUpdate ',DbgSName(Self),' ',dbgs(IntfClientRect)]); 3810 {$ENDIF} 3811end; 3812 3813{------------------------------------------------------------------------------- 3814 TWinControl DoSetBounds 3815 Params: ALeft, ATop, AWidth, AHeight : integer 3816 3817 Anticipate the new clientwidth/height and call inherited 3818 3819 Normally the clientwidth/clientheight is adjusted automatically by the 3820 interface. But it is up to interface when this will be done. The gtk for 3821 example just puts resize requests into a queue. The LCL would resize the 3822 children just after this procedure due to the clientrect. On complex forms with 3823 lots of nested controls, this would result in thousands of resizes. 3824 Changing the clientrect in the LCL to the most probable size reduces 3825 unneccessary resizes. 3826-------------------------------------------------------------------------------} 3827procedure TWinControl.DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); 3828var 3829 OldWidth: LongInt; 3830 OldHeight: LongInt; 3831begin 3832 //DbgOut('[TWinControl.DoSetBounds] ',Name,':',ClassName,' OldHeight=',DbgS(FHeight),' NewHeight=',DbgS(AHeight)); 3833 OldWidth:=Width; 3834 OldHeight:=Height; 3835 inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); 3836 // adapt Clientrect 3837 if not(cfLoading in FControlFlags) 3838 or (cfWidthLoaded in FControlFlags) then // adapt only if Width is valid 3839 inc(FClientWidth,Width-OldWidth); 3840 if not(cfLoading in FControlFlags) 3841 or (cfHeightLoaded in FControlFlags) then // adapt only if Height is valid 3842 inc(FClientHeight,Height-OldHeight); 3843 if FClientWidth<0 then FClientWidth:=0; 3844 if FClientHeight<0 then FClientHeight:=0; 3845 Exclude(FWinControlFlags,wcfAdjustedLogicalClientRectValid); 3846end; 3847 3848function TWinControl.DoubleBufferedIsStored: Boolean; 3849begin 3850 Result := not FParentDoubleBuffered; 3851end; 3852 3853{------------------------------------------------------------------------------ 3854 TWinControl EnableAlign 3855------------------------------------------------------------------------------} 3856procedure TWinControl.EnableAlign; 3857begin 3858 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DisableAlign'){$ENDIF}; 3859end; 3860 3861procedure TWinControl.WriteLayoutDebugReport(const Prefix: string); 3862var 3863 i: Integer; 3864begin 3865 inherited WriteLayoutDebugReport(Prefix); 3866 for i:=0 to ControlCount-1 do 3867 Controls[i].WriteLayoutDebugReport(Prefix+' '); 3868end; 3869 3870procedure TWinControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; 3871 const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer); 3872var 3873 i: Integer; 3874begin 3875 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.AutoAdjustLayout'){$ENDIF}; 3876 try 3877 for i:=0 to ControlCount-1 do 3878 Controls[i].AutoAdjustLayout(AMode, AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth); 3879 3880 inherited; 3881 finally 3882 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.AutoAdjustLayout'){$ENDIF}; 3883 end; 3884end; 3885 3886{------------------------------------------------------------------------------ 3887 TWinControl.CanTab 3888------------------------------------------------------------------------------} 3889function TWinControl.CanTab: Boolean; 3890begin 3891 Result := CanFocus and TWSWinControlClass(WidgetSetClass).CanFocus(Self); 3892end; 3893 3894function TWinControl.DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint; ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean):LRESULT; 3895var 3896 TargetControl: TControl; 3897begin 3898 case ADragMessage of 3899 dmFindTarget: 3900 begin 3901 {$IFDEF VerboseDrag} 3902 DebugLn('TWinControl.DoDragMsg dmFindTarget ',Name,':',ClassName,' Start DragMsg.DragRec^.Pos=',IntToStr(APosition.X),',',IntToStr(APosition.Y)); 3903 {$ENDIF} 3904 TargetControl := ControlAtPos(ScreentoClient(APosition), 3905 [capfAllowWinControls,capfRecursive]); 3906 if TargetControl = nil then TargetControl := Self; 3907 {$IFDEF VerboseDrag} 3908 DebugLn('TWinControl.DoDragMsg dmFindTarget ',Name,':',ClassName,' end Result=',TargetControl.Name,':',TargetControl.ClassName); 3909 {$ENDIF} 3910 Result := LRESULT(TargetControl); 3911 end; 3912 else 3913 Result := inherited; 3914 end; 3915end; 3916 3917{------------------------------------------------------------------------------ 3918 TWinControl GetChildren 3919------------------------------------------------------------------------------} 3920procedure TWinControl.GetChildren(Proc: TGetChildProc; Root: TComponent); 3921var 3922 I : Integer; 3923 Control : TControl; 3924begin 3925 for I := 0 to ControlCount-1 do 3926 begin 3927 Control := Controls[i]; 3928 if Control.Owner = Root then Proc(Control); 3929 end; 3930end; 3931 3932{------------------------------------------------------------------------------- 3933 function TWinControl.ChildClassAllowed(ChildClass: TClass): boolean; 3934 3935 Allow TControl as child. 3936-------------------------------------------------------------------------------} 3937function TWinControl.ChildClassAllowed(ChildClass: TClass): boolean; 3938begin 3939 Result:=(ChildClass<>nil) and ChildClass.InheritsFrom(TControl); 3940end; 3941 3942{------------------------------------------------------------------------------- 3943 TWinControl GetClientOrigin 3944 Result: TPoint 3945 3946 returns the screen coordinate of the topleft coordinate 0,0 of the client area 3947 Note that this value is the position as stored in the interface and is not 3948 always in sync with the LCL. When a control is moved, the LCL sets the bounds 3949 to the wanted position and sends a move message to the interface. It is up to 3950 the interface to handle moves instantly or queued. 3951-------------------------------------------------------------------------------} 3952function TWinControl.GetClientOrigin: TPoint; 3953var 3954 AControl: TWinControl; 3955begin 3956 Result.X := 0; 3957 Result.Y := 0; 3958 if HandleAllocated then 3959 begin 3960 // get the interface idea where the client area is on the screen 3961 LCLIntf.ClientToScreen(Handle, Result); 3962 // adjust the result by all bounds, that are not yet sent to the interface 3963 AControl := Self; 3964 repeat 3965 inc(Result.X, AControl.Left - AControl.FBoundsRealized.Left); 3966 inc(Result.Y, AControl.Top - AControl.FBoundsRealized.Top); 3967 AControl := AControl.Parent; 3968 until AControl = nil; 3969 end else 3970 if Parent <> nil then 3971 Result := inherited GetClientOrigin; 3972end; 3973 3974{------------------------------------------------------------------------------- 3975 TWinControl GetClientRect 3976 Result: TRect 3977 3978 returns the client area. Starting at 0,0. 3979-------------------------------------------------------------------------------} 3980function TWinControl.GetClientRect: TRect; 3981 3982 procedure StoreClientRect(NewClientRect: TRect); 3983 var 3984 ClientSizeChanged: boolean; 3985 begin 3986 if wcfClientRectNeedsUpdate in FWinControlFlags then begin 3987 ClientSizeChanged:=(FClientWidth<>NewClientRect.Right) 3988 or (FClientHeight<>NewClientRect.Bottom); 3989 if ClientSizeChanged then begin 3990 FClientWidth:=NewClientRect.Right; 3991 FClientHeight:=NewClientRect.Bottom; 3992 {$IF defined(VerboseNewAutoSize) or defined(CHECK_POSITION)} 3993 {$IFDEF CHECK_POSITION} 3994 if CheckPosition(Self) then 3995 {$ENDIF} 3996 DebugLn(['StoreClientRect ',Name,':',ClassName,' ',FClientWidth,',',FClientHeight,' HandleAllocated=',HandleAllocated]); 3997 {$ENDIF} 3998 {$IFDEF VerboseClientRectBugFix} 3999 DebugLn(['StoreClientRect ',DbgSName(Self),' ',FClientWidth,',',FClientHeight,' HandleAllocated=',HandleAllocated,' wcfBoundsRealized=',wcfBoundsRealized in FWinControlFlags]); 4000 {$ENDIF} 4001 Exclude(FWinControlFlags,wcfAdjustedLogicalClientRectValid); 4002 end; 4003 Exclude(FWinControlFlags,wcfClientRectNeedsUpdate); 4004 end; 4005 end; 4006 4007 procedure GetDefaults(var r: TRect); 4008 begin 4009 r:=inherited GetClientRect; 4010 if csLoading in ComponentState then begin 4011 if cfClientWidthLoaded in FControlFlags then 4012 r.Right:=FLoadedClientSize.cx; 4013 if cfClientHeightLoaded in FControlFlags then 4014 r.Bottom:=FLoadedClientSize.cy; 4015 end; 4016 end; 4017 4018var 4019 InterfaceWidth, InterfaceHeight: integer; 4020begin 4021 if wcfClientRectNeedsUpdate in FWinControlFlags then begin 4022 //DebugLn(['TWinControl.GetClientRect ',DbgSName(Self),' ',HandleAllocated,' ',wcfBoundsRealized in FWinControlFlags]); 4023 if TWSWinControlClass(WidgetSetClass).GetDefaultClientRect(Self, 4024 Left, Top, Width, Height, Result) 4025 then begin 4026 // the LCL interface provided a ClientRect 4027 end 4028 else if HandleAllocated then 4029 begin 4030 // update clientrect from interface 4031 LCLIntf.GetClientRect(Handle, Result); 4032 // the LCL is not always in sync with the interface 4033 // -> adjust client rect based on LCL bounds 4034 // for example: if the Width in LCL differ from the Width of the Interface 4035 // object, then adjust the clientwidth accordingly 4036 // this often anticipates later LM_SIZE messages from the interface 4037 // and reduces resizes 4038 LCLIntf.GetWindowSize(Handle, InterfaceWidth, InterfaceHeight); 4039 {$IF defined(VerboseNewAutoSize) or defined(CHECK_POSITION)} 4040 {$IFDEF CHECK_POSITION} 4041 if CheckPosition(Self) then 4042 {$ENDIF} 4043 debugln('TWinControl.GetClientRect ',DbgSName(Self),' Interface=',dbgs(InterfaceWidth),',',dbgs(InterfaceHeight),' Result=',dbgs(Result),' Bounds=',dbgs(BoundsRect)); 4044 {$ENDIF} 4045 {$IFDEF VerboseClientRectBugFix} 4046 //if Name=CheckClientRectName then 4047 debugln('TWinControl.GetClientRect ',DbgSName(Self),' InterfaceSize=',dbgs(InterfaceWidth),',',dbgs(InterfaceHeight),' Result=',dbgs(Result),' Bounds=',dbgs(BoundsRect)); 4048 {$ENDIF} 4049 if (Width<>InterfaceWidth) 4050 or (Height<>InterfaceHeight) then 4051 begin 4052 // the LCL is not in sync with the interface 4053 if wcfBoundsRealized in FWinControlFlags then 4054 begin 4055 // no bounds were sent yet to the interface and it didn't initialize 4056 // them on its own 4057 // => the client bounds from the interface are not yet ready 4058 // they will probably change 4059 // to avoid resizes it is better use the defaults 4060 GetDefaults(Result); 4061 end else begin 4062 // -> adjust client rect based on LCL bounds 4063 // for example: if the Width in LCL differ from the Width of the Interface 4064 // object, then adjust the clientwidth accordingly 4065 // this often anticipates later LM_SIZE messages from the interface 4066 // and reduces resizes 4067 inc(Result.Right,Width-InterfaceWidth); 4068 inc(Result.Bottom,Height-InterfaceHeight); 4069 end; 4070 end; 4071 end else begin 4072 // no handle and no interface help => use defaults 4073 GetDefaults(Result); 4074 end; 4075 Result.Right:=Max(Result.Left,Result.Right); 4076 Result.Bottom:=Max(Result.Top,Result.Bottom); 4077 StoreClientRect(Result); 4078 4079 {r:=inherited GetClientRect; 4080 if (r.Left<>Result.Left) 4081 or (r.Top<>Result.Top) 4082 or (r.Right<>Result.Right) 4083 or (r.Bottom<>Result.Bottom) then begin 4084 //DebugLn(' TWinControl.GetClientRect ',Name,':',ClassName, 4085 // ' Old=',r.Left,',',r.Top,',',r.Right,',',r.Bottom, 4086 // ' New=',Result.Left,',',Result.Top,',',Result.Right,',',Result.Bottom 4087 // ); 4088 end;} 4089 4090 end else begin 4091 Result:=Rect(0,0,FClientWidth,FClientHeight); 4092 end; 4093end; 4094 4095{------------------------------------------------------------------------------- 4096 TWinControl GetControlOrigin 4097 Result: TPoint 4098 4099 Returns the screen coordinate of the topleft coordinate 0,0 of the control 4100 area. (The topleft pixel of the control on the screen) 4101 Note that this value is the position as stored in the interface and is not 4102 always in sync with the LCL. When a control is moved, the LCL sets the bounds 4103 to the wanted position and sends a move message to the interface. It is up to 4104 the interface to handle moves instantly or queued. 4105-------------------------------------------------------------------------------} 4106function TWinControl.GetControlOrigin: TPoint; 4107var 4108 AControl: TWinControl; 4109 IntfBounds: TRect; 4110begin 4111 if HandleAllocated then 4112 begin 4113 // get the interface idea where the client area is on the screen 4114 LCLIntf.GetWindowRect(Handle,IntfBounds); 4115 Result.X := IntfBounds.Left; 4116 Result.Y := IntfBounds.Top; 4117 // adjust the result by all bounds, that are not yet sent to the interface 4118 AControl := Self; 4119 repeat 4120 inc(Result.X, AControl.Left - AControl.FBoundsRealized.Left); 4121 inc(Result.Y, AControl.Top - AControl.FBoundsRealized.Top); 4122 AControl := AControl.Parent; 4123 until AControl = nil; 4124 end else 4125 Result:=inherited GetControlOrigin; 4126end; 4127 4128{------------------------------------------------------------------------------ 4129 function TWinControl.GetChildrenRect(Scrolled: boolean): TRect; 4130 4131 Returns the Client rectangle relative to the controls left, top. 4132 If Scrolled is true, the rectangle is moved by the current scrolling values 4133 (for an example see TScrollingWincontrol). 4134------------------------------------------------------------------------------} 4135function TWinControl.GetChildrenRect(Scrolled: boolean): TRect; 4136var 4137 ScrolledOffset: TPoint; 4138begin 4139 if HandleAllocated then begin 4140 LCLIntf.GetClientBounds(Handle,Result); 4141 if Scrolled then begin 4142 ScrolledOffset:=GetClientScrollOffset; 4143 inc(Result.Left,ScrolledOffset.X); 4144 inc(Result.Top,ScrolledOffset.Y); 4145 inc(Result.Right,ScrolledOffset.X); 4146 inc(Result.Bottom,ScrolledOffset.Y); 4147 end; 4148 end else 4149 Result:=inherited GetChildrenRect(Scrolled); 4150end; 4151 4152{------------------------------------------------------------------------------ 4153 TWinControl SetBorderStyle 4154------------------------------------------------------------------------------} 4155procedure TWinControl.SetBorderStyle(NewStyle: TBorderStyle); 4156begin 4157 if FBorderStyle = NewStyle then Exit; 4158 FBorderStyle := NewStyle; 4159 if HandleAllocated then 4160 TWSWinControlClass(WidgetSetClass).SetBorderStyle(Self, NewStyle); 4161end; 4162 4163{------------------------------------------------------------------------------ 4164 TWinControl SetBorderWidth 4165------------------------------------------------------------------------------} 4166procedure TWinControl.SetBorderWidth(Value: TBorderWidth); 4167begin 4168 if FBorderWidth = Value then exit; 4169 FBorderWidth := Value; 4170 Perform(CM_BORDERCHANGED, 0, 0); 4171end; 4172 4173procedure TWinControl.SetParentWindow(const AValue: HWND); 4174begin 4175 if (ParentWindow = AValue) or Assigned(Parent) then Exit; 4176 FParentWindow := AValue; 4177 if HandleAllocated then 4178 if (AValue <> 0) then 4179 LCLIntf.SetParent(Handle, AValue) 4180 else 4181 DestroyHandle; 4182 UpdateControlState; 4183end; 4184 4185{------------------------------------------------------------------------------ 4186 TWinControl.SetChildZPosition 4187 4188 Set the position of the child control in the TWinControl(s) 4189------------------------------------------------------------------------------} 4190procedure TWinControl.SetChildZPosition(const AChild: TControl; 4191 const APosition: Integer); 4192var 4193 OldPos, NewPos: Integer; 4194 IsWinControl: boolean; 4195 i: Integer; 4196 WinControls: TFPList; 4197begin 4198 if AChild = nil 4199 then begin 4200 DebugLn('WARNING: TWinControl.SetChildZPosition: Child = nil'); 4201 Exit; 4202 end; 4203 4204 IsWinControl := AChild is TWincontrol; 4205 4206 if FControls = nil then 4207 begin 4208 DebugLn('WARNING: TWinControl.SetChildZPosition: Unknown child'); 4209 Exit; 4210 end; 4211 OldPos := FControls.IndexOf(AChild); 4212 if OldPos<0 then begin 4213 DebugLn('WARNING: TWinControl.SetChildZPosition: Not a child'); 4214 Exit; 4215 end; 4216 4217 NewPos := APosition; 4218 4219 if NewPos < 0 then 4220 NewPos := 0; 4221 if NewPos >= FControls.Count then 4222 NewPos := FControls.Count - 1; 4223 4224 if NewPos = OldPos then Exit; 4225 4226 FControls.Move(OldPos, NewPos); 4227 4228 if IsWinControl then 4229 begin 4230 if HandleAllocated and TWinControl(AChild).HandleAllocated then 4231 begin 4232 // ignore children without handle 4233 WinControls:=TFPList.Create; 4234 try 4235 for i:=FControls.Count-1 downto 0 do 4236 begin 4237 if (TObject(FControls[i]) is TWinControl) then 4238 begin 4239 WinControls.Add(FControls[i]); 4240 end else begin 4241 if i<OldPos then dec(OldPos); 4242 if i<NewPos then dec(NewPos); 4243 end; 4244 end; 4245 TWSWinControlClass(WidgetSetClass).SetChildZPosition(Self, 4246 TWinControl(AChild), OldPos, NewPos, WinControls); 4247 finally 4248 WinControls.Free; 4249 end; 4250 end; 4251 end 4252 else begin 4253 AChild.InvalidateControl(AChild.IsVisible, True, True); 4254 end; 4255end; 4256 4257{------------------------------------------------------------------------------ 4258 TWinControl.SetTabOrder 4259------------------------------------------------------------------------------} 4260procedure TWinControl.SetTabOrder(NewTabOrder: TTabOrder); 4261begin 4262 if csLoading in ComponentState then 4263 FTabOrder := NewTabOrder 4264 else 4265 UpdateTabOrder(NewTabOrder); 4266end; 4267 4268procedure TWinControl.SetTabStop(NewTabStop: Boolean); 4269begin 4270 if FTabStop = NewTabStop then 4271 Exit; 4272 FTabStop := NewTabStop; 4273 UpdateTabOrder(FTabOrder); 4274 Perform(CM_TABSTOPCHANGED, 0, 0); 4275end; 4276 4277{------------------------------------------------------------------------------ 4278 TControl UpdateTabOrder 4279------------------------------------------------------------------------------} 4280procedure TWinControl.UpdateTabOrder(NewTabOrder: TTabOrder); 4281var 4282 Count: Integer; 4283begin 4284 if FParent <> nil then 4285 begin 4286 FTabOrder := GetTabOrder; 4287 Count := ListCount(FParent.FTabList); 4288 if NewTabOrder < 0 then 4289 NewTabOrder := Count; 4290 if FTabOrder = -1 then 4291 Inc(Count); 4292 if NewTabOrder > Count then 4293 NewTabOrder := Count; 4294 if NewTabOrder <> FTabOrder then 4295 begin 4296 if FTabOrder <> - 1 then 4297 ListDelete(FParent.FTabList,FTabOrder); 4298 if NewTabOrder <> -1 then 4299 begin 4300 if NewTabOrder = Count then 4301 ListAdd(FParent.FTabList,Self) 4302 else 4303 ListInsert(FParent.FTabList,NewTabOrder,Self); 4304 FTabOrder := NewTabOrder; 4305 end; 4306 end; 4307 end; 4308end; 4309 4310{------------------------------------------------------------------------------- 4311 procedure TWinControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean); 4312 4313 Send Move and Size messages through the LCL message paths. This simulates the 4314 VCL behaviour and has no real effect. 4315-------------------------------------------------------------------------------} 4316procedure TWinControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean); 4317var 4318 SizeMsg : TLMSize; 4319 MoveMsg : TLMMove; 4320 //Flags: UINT; 4321begin 4322 if (not HandleAllocated) 4323 or ((not SizeChanged) and (not PosChanged)) then exit; 4324 4325 Perform(LM_WindowposChanged, 0, 0); 4326 4327 if SizeChanged then 4328 begin 4329 with SizeMsg do 4330 begin 4331 Msg := LM_SIZE; 4332 SizeType := 6; // force realign 4333 if (FWidth < Low(Word)) or (FWidth > High(Word)) 4334 or (FHeight < Low(Word)) or (FHeight > High(Word)) then 4335 raise Exception.CreateFmt('Size range overflow in %s.SendMoveSizeMessages:' 4336 +' Width=%d, Height=%d.', [Name, FWidth, FHeight]); 4337 Width := FWidth; 4338 Height := FHeight; 4339 {$IFDEF CHECK_POSITION} 4340 if CheckPosition(Self) then 4341 DebugLn(' [TControl.SendMoveSizeMessages] ',Name,':',ClassName,' SizeMsg Width=',DbgS(Width),' Height=',DbgS(Height)); 4342 {$ENDIF} 4343 end; 4344 WindowProc(TLMessage(SizeMsg)); 4345 end; 4346 4347 if PosChanged then 4348 begin 4349 with MoveMsg do 4350 begin 4351 Msg:= LM_MOVE; 4352 MoveType:= 1; 4353 if (FLeft < Low(Smallint)) or (FLeft > High(Smallint)) 4354 or (FTop < Low(Smallint)) or (FTop > High(Smallint)) then 4355 raise Exception.CreateFmt('Position range overflow in %s.SendMoveSizeMessages:' 4356 +' Left=%d, Top=%d.', [Name, FLeft, FTop]); 4357 XPos := FLeft; 4358 YPos := FTop; 4359 {$IFDEF CHECK_POSITION} 4360 if CheckPosition(Self) then 4361 DebugLn(' [TControl.SendMoveSizeMessages] ',Name,':',ClassName,' MoveMsg XPos=',Dbgs(XPos),' YPos=',Dbgs(YPos)); 4362 {$ENDIF} 4363 end; 4364 WindowProc(TLMessage(MoveMsg)); 4365 end; 4366end; 4367 4368{------------------------------------------------------------------------------ 4369 TWinControl UpdateShowing 4370 4371 Check control's handle visibility. 4372 If handle should become visible the handle and child handles are created. 4373 The 4374------------------------------------------------------------------------------} 4375procedure TWinControl.UpdateShowing; 4376 4377 procedure ChangeShowing(bShow: Boolean); 4378 begin 4379 if FShowing = bShow then Exit; 4380 FShowing := bShow; 4381 try 4382 {$IFDEF VerboseShowing} 4383 DebugLn(['ChangeShowing ',DbgSName(Self),' new FShowing=',FShowing]); 4384 {$ENDIF} 4385 Perform(CM_SHOWINGCHANGED, 0, 0); // see TWinControl.CMShowingChanged 4386 finally 4387 if FShowing<>(wcfHandleVisible in FWinControlFlags) then 4388 begin 4389 FShowing := wcfHandleVisible in FWinControlFlags; 4390 DebugLn(['TWinControl.UpdateShowing.ChangeShowing failed for ',DbgSName(Self),', Showing reset to ',FShowing]); 4391 end; 4392 end; 4393 end; 4394 4395var 4396 bShow: Boolean; 4397 n: Integer; 4398begin 4399 bShow := HandleObjectShouldBeVisible; 4400 4401 if bShow then 4402 begin 4403 if not HandleAllocated then CreateHandle; 4404 if Assigned(FControls) then 4405 begin 4406 for n := 0 to FControls.Count - 1 do 4407 if TObject(FControls[n]) is TWinControl then 4408 TWinControl(FControls[n]).UpdateShowing; 4409 end; 4410 end; 4411 if not HandleAllocated then 4412 begin 4413 {$IFDEF VerboseShowing} 4414 if bShow then 4415 DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' handle not allocated']); 4416 {$ENDIF} 4417 Exit; 4418 end; 4419 4420 if FShowing = bShow then Exit; 4421 //DebugLn(['TWinControl.UpdateShowing ',dbgsName(Self),' FShowing=',dbgs(FShowing),' bShow=',dbgs(bShow), ' IsWindowVisible=', IsWindowVisible(FHandle)]); 4422 if bShow then 4423 begin 4424 // the Handle should become visible 4425 // delay this until all other autosizing has been processed 4426 if AutoSizeDelayed or (not (caspShowing in AutoSizePhases)) then 4427 begin 4428 {$IFDEF VerboseShowing} 4429 if AutoSizeDelayed then DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' SKIPPING because AutoSizeDelayed: ',AutoSizeDelayedReport]); 4430 if (not (caspShowing in AutoSizePhases)) then DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' SKIPPING because wrong phase']); 4431 {$ENDIF} 4432 exit; 4433 end; 4434 end; 4435 ChangeShowing(bShow); 4436end; 4437 4438procedure TWinControl.Update; 4439begin 4440 if HandleAllocated then UpdateWindow(Handle); 4441end; 4442 4443{------------------------------------------------------------------------------ 4444 TWinControl Focused 4445------------------------------------------------------------------------------} 4446function TWinControl.Focused: Boolean; 4447begin 4448 Result := CanTab and (HandleAllocated and (FindOwnerControl(GetFocus)=Self)); 4449end; 4450 4451function TWinControl.PerformTab(ForwardTab: boolean): boolean; 4452var 4453 NewFocus: TWinControl; 4454 ParentForm: TCustomForm; 4455begin 4456 Result := True; 4457 ParentForm := GetParentForm(Self); 4458 if ParentForm = nil then 4459 Exit; 4460 NewFocus := ParentForm.FindNextControl(Self, ForwardTab, True, False); 4461 if NewFocus = nil then 4462 Exit; 4463 4464 NewFocus.SetFocus; 4465 Result := NewFocus.Focused; 4466end; 4467 4468{------------------------------------------------------------------------------ 4469 TWinControl SelectNext 4470 4471 Find next control (Tab control or Child control). 4472 Like VCL the CurControl parameter is ignored. 4473------------------------------------------------------------------------------} 4474procedure TWinControl.SelectNext(CurControl: TWinControl; GoForward, 4475 CheckTabStop: Boolean); 4476begin 4477 CurControl := FindNextControl(CurControl, GoForward, 4478 CheckTabStop, not CheckTabStop); 4479 if CurControl <> nil then CurControl.SetFocus; 4480end; 4481 4482procedure TWinControl.SetTempCursor(Value: TCursor); 4483begin 4484 if not HandleAllocated then exit; 4485 TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[Value]); 4486end; 4487 4488{------------------------------------------------------------------------------ 4489 TWinControl FindChildControl 4490------------------------------------------------------------------------------} 4491function TWinControl.FindChildControl(const ControlName: String): TControl; 4492var 4493 I: Integer; 4494begin 4495 if FControls <> nil then 4496 for I := 0 to FControls.Count - 1 do begin 4497 Result:=TControl(FControls[I]); 4498 if CompareText(Result.Name, ControlName) = 0 then 4499 exit; 4500 end; 4501 Result := nil; 4502end; 4503 4504procedure TWinControl.FlipChildren(AllLevels: Boolean); 4505var 4506 i: Integer; 4507 FlipControls: TFPList; 4508 CurControl: TControl; 4509begin 4510 if ControlCount = 0 then exit; 4511 FlipControls := TFPList.Create; 4512 4513 DisableAlign; 4514 try 4515 // Collect all controls with Align Right and Left 4516 for i := 0 to ControlCount - 1 do begin 4517 CurControl:=Controls[i]; 4518 if CurControl.Align in [alLeft,alRight] then 4519 FlipControls.Add(CurControl); 4520 end; 4521 // flip the rest 4522 DoFlipChildren; 4523 // reverse Right and Left alignments 4524 while FlipControls.Count > 0 do begin 4525 CurControl:=TControl(FlipControls[FlipControls.Count-1]); 4526 if CurControl.Align=alLeft then 4527 CurControl.Align:=alRight 4528 else if CurControl.Align=alRight then 4529 CurControl.Align:=alLeft; 4530 FlipControls.Delete(FlipControls.Count - 1); 4531 end; 4532 finally 4533 FlipControls.Free; 4534 EnableAlign; 4535 end; 4536 FFlipped := not FFlipped; // toggle FFlipped status 4537 // flip recursively 4538 if AllLevels then begin 4539 for i := 0 to ControlCount - 1 do begin 4540 CurControl:=Controls[i]; 4541 if CurControl is TWinControl then 4542 TWinControl(CurControl).FlipChildren(true); 4543 end; 4544 end; 4545end; 4546 4547procedure TWinControl.ScaleBy(Multiplier, Divider: Integer); 4548begin 4549 ChangeScale(Multiplier, Divider); 4550end; 4551 4552{------------------------------------------------------------------------------} 4553{ TWinControl FindNextControl } 4554{------------------------------------------------------------------------------} 4555function TWinControl.FindNextControl(CurrentControl: TWinControl; GoForward, 4556 CheckTabStop, CheckParent: Boolean): TWinControl; 4557var 4558 List: TFPList; 4559 Next: TWinControl; 4560 I, J: Longint; 4561begin 4562 try 4563 Result := nil; 4564 List := TFPList.Create; 4565 GetTabOrderList(List); 4566 //for i:=0 to List.Count-1 do 4567 // debugln(['TWinControl.FindNextControl TabOrderList ',dbgs(i),' ',DbgSName(TObject(List[i]))]); 4568 if List.Count > 0 then 4569 begin 4570 J := List.IndexOf(CurrentControl); 4571 if J < 0 then 4572 begin 4573 if GoForward then 4574 J := List.Count - 1 4575 else 4576 J := 0; 4577 end; 4578 //DebugLn(['TWinControl.FindNextControl A ',DbgSName(CurrentControl),' ',dbgs(J), 4579 // ' GoForward='+dbgs(GoForward)+' CheckTabStop='+dbgs(CheckTabStop)+' CheckParent='+dbgs(CheckParent)]); 4580 I := J; 4581 repeat 4582 if GoForward then 4583 begin 4584 Inc(I); 4585 if I >= List.Count then 4586 I := 0; 4587 end else 4588 begin 4589 Dec(I); 4590 if I < 0 then 4591 I := List.Count - 1; 4592 end; 4593 4594 Next := TWinControl(List[I]); 4595{ DebugLn(['TWinControl.FindNextControl B ',Next.Name,' ',dbgs(I), 4596 ' ChckTabStop='+dbgs(CheckTabStop)+' TabStop='+dbgs(Next.TabStop) 4597 +' ChckParent='+dbgs(CheckParent)+' Parent=Self='+dbgs(Next.Parent = Self) 4598 +' Enabled='+dbgs(Next.Enabled) 4599 +' TestTab='+dbgs(((Not CheckTabStop) or Next.TabStop)) 4600 +' TestPar='+dbgs(((not CheckParent) or (Next.Parent = Self))) 4601 +' TestEnVi='+dbgs(Next.Enabled and Next.IsVisible)]);} 4602 if (((not CheckTabStop) or Next.TabStop) 4603 and ((not CheckParent) or (Next.Parent = Self))) 4604 and (Next.Enabled and Next.IsVisible) then 4605 Result := Next; 4606 4607 // if we reached the start then exit because we traversed the loop and 4608 // did not find any control 4609 if I = J then 4610 break; 4611 until (Result <> nil); 4612 //DebugLn(['TWinControl.FindNextControl END ',DbgSName(Result),' I=',dbgs(I)]); 4613 end; 4614 finally 4615 List.Free; 4616 end; 4617end; 4618 4619procedure TWinControl.SelectFirst; 4620var 4621 Form : TCustomForm; 4622 Control : TWinControl; 4623begin 4624 Form := GetParentForm(Self); 4625 if Form <> nil then begin 4626 Control := FindNextControl(nil, true, true, false); 4627 if Control = nil then 4628 Control := FindNextControl(nil, true, false, false); 4629 if Control <> nil then 4630 Form.ActiveControl := Control; 4631 end; 4632end; 4633 4634procedure TWinControl.FixupTabList; 4635var 4636 I, J: Integer; 4637 Control: TWinControl; 4638 List: TFPList; 4639 WinControls: TFPList; 4640begin 4641 if FControls <> nil then 4642 begin 4643 List := TFPList.Create; 4644 WinControls:=TFPList.Create; 4645 try 4646 for i:=0 to FControls.Count-1 do 4647 if TObject(FControls[i]) is TWinControl then 4648 WinControls.Add(FControls[i]); 4649 List.Count := WinControls.Count; 4650 for I := 0 to WinControls.Count - 1 do 4651 begin 4652 Control := TWinControl(WinControls[I]); 4653 J := Control.FTabOrder; 4654 if (J >= 0) and (J < WinControls.Count) then 4655 List[J] := Control; 4656 end; 4657 for I := 0 to List.Count - 1 do 4658 begin 4659 Control := TWinControl(List[I]); 4660 if Control <> nil then 4661 Control.UpdateTabOrder(TTabOrder(I)); 4662 end; 4663 finally 4664 List.Free; 4665 WinControls.Free; 4666 end; 4667 end; 4668end; 4669 4670{------------------------------------------------------------------------------ 4671 TWinControl GetTabOrderList 4672------------------------------------------------------------------------------} 4673procedure TWinControl.GetTabOrderList(List: TFPList); 4674var 4675 I: Integer; 4676 lWinControl: TWinControl; 4677begin 4678 if FTabList <> nil then 4679 for I := 0 to FTabList.Count - 1 do 4680 begin 4681 lWinControl := TWinControl(FTabList[I]); 4682 // The tab order list should exclude injected LCL-CustomDrawn controls 4683 if lWinControl.CanFocus and (not LCLIntf.IsCDIntfControl(lWinControl)) then 4684 List.Add(lWinControl); 4685 lWinControl.GetTabOrderList(List); 4686 end; 4687end; 4688 4689{------------------------------------------------------------------------------ 4690 TWinControl IsControlMouseMsg 4691------------------------------------------------------------------------------} 4692function TWinControl.IsControlMouseMsg(var TheMessage): Boolean; 4693var 4694 MouseMessage: TLMMouse absolute TheMessage; 4695 MouseEventMessage: TLMMouseEvent; 4696 Control: TControl; 4697 ScrolledOffset, P: TPoint; 4698 ClientBounds: TRect; 4699begin 4700 { CaptureControl = nil means that widgetset has captured input, but it does 4701 not know anything about TControl controls } 4702 if (FindOwnerControl(GetCapture) = Self) and (CaptureControl <> nil) then 4703 begin 4704 Control := nil; 4705 //DebugLn(['TWinControl.IsControlMouseMsg A ', DbgSName(CaptureControl), ', ',DbgSName(CaptureControl.Parent),', Self: ', DbgSName(Self)]); 4706 if (CaptureControl.Parent = Self) then 4707 Control := CaptureControl; 4708 end 4709 else 4710 begin 4711 // do query wincontrol children, in case they overlap 4712 Control := ControlAtPos(SmallPointToPoint(MouseMessage.Pos), []); 4713 end; 4714 4715 //DebugLn(['TWinControl.IsControlMouseMsg B ',DbgSName(Self),' Control=',DbgSName(Control),' Msg=',TheMessage.Msg]); 4716 Result := False; 4717 if Control <> nil then 4718 begin 4719 // map mouse coordinates to control 4720 ScrolledOffset := GetClientScrollOffset; 4721 4722 P.X := MouseMessage.XPos - Control.Left + ScrolledOffset.X; 4723 P.Y := MouseMessage.YPos - Control.Top + ScrolledOffset.Y; 4724 if (Control is TWinControl) and TWinControl(Control).HandleAllocated then 4725 begin 4726 // map coordinates to client area of control 4727 LCLIntf.GetClientBounds(TWinControl(Control).Handle, ClientBounds); 4728 dec(P.X, ClientBounds.Left); 4729 dec(P.Y, ClientBounds.Top); 4730 {$IFDEF VerboseMouseBugfix} 4731 DebugLn(['TWinControl.IsControlMouseMsg ',Name,' -> ',Control.Name, 4732 ' MsgPos=',MouseMessage.Pos.X,',',MouseMessage.Pos.Y, 4733 ' Control=',Control.Left,',',Control.Top, 4734 ' ClientBounds=',ClientBounds.Left,',',ClientBounds.Top, 4735 ' Scrolled=',GetClientScrollOffset.X,',',GetClientScrollOffset.Y, 4736 ' P=',P.X,',',P.Y] 4737 ); 4738 {$ENDIF} 4739 end; 4740 if (MouseMessage.Msg = LM_MOUSEWHEEL) or 4741 (MouseMessage.Msg = LM_MOUSEHWHEEL) then 4742 begin 4743 MouseEventMessage := TLMMouseEvent(TheMessage); 4744 {$PUSH} 4745 {$R-}{$Q-} // no range, no overflow checks 4746 MouseEventMessage.X := P.X; 4747 MouseEventMessage.Y := P.Y; 4748 {$POP} 4749 Control.Dispatch(MouseEventMessage); 4750 MouseMessage.Result := MouseEventMessage.Result; 4751 Result := (MouseMessage.Result <> 0); 4752 end 4753 else 4754 begin 4755 MouseMessage.Result := Control.Perform(MouseMessage.Msg, WParam(MouseMessage.Keys), 4756 LParam(Integer(PointToSmallPointNoChecks(P)))); 4757 Result := True; 4758 end; 4759 end; 4760end; 4761 4762procedure TWinControl.FontChanged(Sender: TObject); 4763begin 4764 if HandleAllocated and ([csLoading, csDestroying] * ComponentState = []) then 4765 begin 4766 TWSWinControlClass(WidgetSetClass).SetFont(Self, TFont(Sender)); 4767 Exclude(FWinControlFlags, wcfFontChanged); 4768 end 4769 else 4770 Include(FWinControlFlags, wcfFontChanged); 4771 inherited FontChanged(Sender); 4772 NotifyControls(CM_PARENTFONTCHANGED); 4773end; 4774 4775procedure TWinControl.SetColor(Value: TColor); 4776begin 4777 if Value = Color then Exit; 4778 inherited SetColor(Value); 4779 if BrushCreated then 4780 if Color = clDefault then 4781 FBrush.Color := GetDefaultColor(dctBrush) 4782 else 4783 FBrush.Color := Color; 4784 if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then 4785 begin 4786 TWSWinControlClass(WidgetSetClass).SetColor(Self); 4787 Exclude(FWinControlFlags, wcfColorChanged); 4788 end 4789 else 4790 Include(FWinControlFlags, wcfColorChanged); 4791 NotifyControls(CM_PARENTCOLORCHANGED); 4792end; 4793 4794procedure TWinControl.PaintHandler(var TheMessage: TLMPaint); 4795 4796 function ControlMustBeClipped(AControl: TControl): boolean; 4797 begin 4798 Result := (csOpaque in AControl.ControlStyle) and AControl.IsVisible; 4799 end; 4800 4801var 4802 I, Clip, SaveIndex: Integer; 4803 DC: HDC; 4804 PS: TPaintStruct; //defined in LCLIntf.pp 4805 ControlsNeedsClipping: boolean; 4806 CurControl: TControl; 4807begin 4808 //DebugLn('[TWinControl.PaintHandler] ',Name,':',ClassName,' DC=',DbgS(TheMessage.DC,8)); 4809 if (csDestroying in ComponentState) or (not HandleAllocated) then exit; 4810 4811 {$IFDEF VerboseResizeFlicker} 4812 DebugLn('TWinControl.PaintHandler A ',Name,':',ClassName); 4813 {$ENDIF} 4814 {$IFDEF VerboseDsgnPaintMsg} 4815 if csDesigning in ComponentState then 4816 DebugLn('TWinControl.PaintHandler A ',Name,':',ClassName); 4817 {$ENDIF} 4818 4819 //DebugLn(Format('Trace:> [TWinControl.PaintHandler] %s --> Msg.DC: 0x%x', [ClassName, TheMessage.DC])); 4820 DC := TheMessage.DC; 4821 if DC = 0 then 4822 DC := BeginPaint(Handle, PS); 4823 4824 try 4825 // check if child controls need clipping 4826 //if Name='GroupBox1' then 4827 //DebugLn('[TWinControl.PaintHandler] ',DbgSName(Self),' B'); 4828 ControlsNeedsClipping:=false; 4829 if FControls<>nil then 4830 for I := 0 to FControls.Count - 1 do 4831 if ControlMustBeClipped(TControl(FControls[I])) then begin 4832 ControlsNeedsClipping:=true; 4833 break; 4834 end; 4835 // exclude child controls and send new paint message 4836 //if Name='GroupBox1' then 4837 //debugln(['TWinControl.PaintHandler ControlsNeedsClipping=',ControlsNeedsClipping,' ControlCount=',ControlCount]); 4838 if not ControlsNeedsClipping then begin 4839 //DebugLn('[TWinControl.PaintHandler] ',DbgSName(Self),' no clipping ...'); 4840 PaintWindow(DC) 4841 end else 4842 begin 4843 SaveIndex := SaveDC(DC); 4844 Clip := SimpleRegion; 4845 for I := 0 to FControls.Count - 1 do begin 4846 CurControl:=TControl(FControls[I]); 4847 if ControlMustBeClipped(CurControl) then 4848 with CurControl do begin 4849 //DebugLn('TWinControl.PaintHandler Exclude Child ',DbgSName(Self),' Control=',DbgSName(CurControl),'(',dbgs(CurControl.BoundsRect),')'); 4850 Clip := ExcludeClipRect(DC, Left, Top, Left + Width, Top + Height); 4851 if Clip = NullRegion then Break; 4852 end; 4853 end; 4854 //DebugLn('[TWinControl.PaintHandler] ',DbgSName(Self),' with clipping ...'); 4855 if Clip <> NullRegion then 4856 PaintWindow(DC); 4857 RestoreDC(DC, SaveIndex); 4858 end; 4859 // paint controls 4860 //DebugLn('[TWinControl.PaintHandler] ',DbgSName(Self),' PaintControls ...'); 4861 if FDockSite and FUseDockManager and Assigned(DockManager) then 4862 DockManager.PaintSite(DC); 4863 PaintControls(DC, nil); 4864 finally 4865 if TheMessage.DC = 0 then 4866 EndPaint(Handle, PS); 4867 end; 4868 //DebugLn(Format('Trace:< [TWinControl.PaintHandler] %s', [ClassName])); 4869//DebugLn('[TWinControl.PaintHandler] END ',Name,':',ClassName,' DC=',DbgS(Message.DC,8)); 4870end; 4871 4872procedure TWinControl.PaintControls(DC: HDC; First: TControl); 4873var 4874 I, Count, SaveIndex: Integer; 4875// FrameBrush: HBRUSH; 4876 TempControl : TControl; 4877 {off $Define VerboseControlDCOrigin} 4878 {$IFDEF VerboseControlDCOrigin} 4879 P: TPoint; 4880 {$ENDIF} 4881begin 4882 {$ifdef DEBUG_WINDOW_ORG} 4883 DebugLn(':> [TWinControl.PaintControls] A'); 4884 {$endif} 4885 4886 //DebugLn('[TWinControl.PaintControls] ',Name,':',ClassName,' DC=',DbgS(DC,8)); 4887 if (csDestroying in ComponentState) 4888 or ((DC=0) and (not HandleAllocated)) then 4889 exit; 4890 4891 {$IFDEF VerboseDsgnPaintMsg} 4892 if csDesigning in ComponentState then 4893 DebugLn('TWinControl.PaintControls A ',Name,':',ClassName); 4894 {$ENDIF} 4895 4896 // Controls that are not TWinControl, have no handle of their own, and so 4897 // they are repainted as part of the parent: 4898 if FControls <> nil then 4899 begin 4900 {$ifdef DEBUG_WINDOW_ORG} 4901 DebugLn(':> [TWinControl.PaintControls] B'); 4902 {$endif} 4903 I := 0; 4904 if First <> nil then 4905 begin 4906 I := FControls.IndexOf(First); 4907 if I < 0 then I := 0; 4908 end; 4909 //debugln(['TWinControl.PaintControls ',DbgSName(Self),' ClientRect=',dbgs(ClientRect)]); 4910 Count := FControls.Count; 4911 while I < Count do 4912 begin 4913 TempControl := TControl(FControls.Items[I]); 4914 {$ifdef DEBUG_WINDOW_ORG} 4915 if Name='GroupBox1' then 4916 DebugLn( 4917 Format(':> [TWinControl.PaintControls] C DC=%d TempControl=%s Left=%d Top=%d Width=%d Height=%d IsVisible=%s RectVisible=%s', 4918 [DC, DbgSName(TempControl), 4919 TempControl.Left, TempControl.Top, TempControl.Width, TempControl.Height, 4920 dbgs(IsVisible), 4921 dbgs(RectVisible(DC, TempControl.BoundsRect)) 4922 ])); 4923 {$endif} 4924 if not (TempControl is TWinControl) then begin 4925 //DebugLn('TWinControl.PaintControls B Self=',Self.Name,':',Self.ClassName,' Control=',TempControl.Name,':',TempControl.ClassName,' ',TempControl.Left,',',TempControl.Top,',',TempControl.Width,',',TempControl.Height); 4926 with TempControl do 4927 if IsVisible 4928 and RectVisible(DC, TempControl.BoundsRect) then 4929 begin 4930 if csPaintCopy in Self.ControlState then 4931 Include(FControlState, csPaintCopy); 4932 SaveIndex := SaveDC(DC); 4933 4934 {$ifdef DEBUG_WINDOW_ORG} 4935 DebugLn( 4936 Format(':> [TWinControl.PaintControls] Control=%s Left=%d Top=%d Width=%d Height=%d', 4937 [Self.Name, Left, Top, Width, Height])); 4938 {$endif} 4939 4940 MoveWindowOrg(DC, Left, Top); 4941 {$IFDEF VerboseControlDCOrigin} 4942 DebugLn('TWinControl.PaintControls B Self=',DbgSName(Self),' Control=',DbgSName(TempControl),' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height)); 4943 {$ENDIF} 4944 IntersectClipRect(DC, 0, 0, Width, Height); 4945 {$IFDEF VerboseControlDCOrigin} 4946 DebugLn('TWinControl.PaintControls C'); 4947 P:=Point(-1,-1); 4948 GetWindowOrgEx(DC,@P); 4949 debugln(' DCOrigin=',dbgs(P)); 4950 {$ENDIF} 4951 Perform(LM_PAINT, WParam(DC), 0); 4952 {$IFDEF VerboseControlDCOrigin} 4953 DebugLn('TWinControl.PaintControls D TempControl=',DbgSName(TempControl)); 4954 {$ENDIF} 4955 RestoreDC(DC, SaveIndex); 4956 Exclude(FControlState, csPaintCopy); 4957 end; 4958 end; 4959 Inc(I); 4960 end; 4961 end; 4962 //DebugLn('[TWinControl.PaintControls] END ',Name,':',ClassName,' DC=',DbgS(DC,8)); 4963end; 4964 4965procedure TWinControl.PaintWindow(DC: HDC); 4966var 4967 Message: TLMessage; 4968begin 4969 //DebugLn('[TWinControl.PaintWindow] ',Name,':',Classname,' DC=',DbgS(DC)); 4970 if (csDestroying in ComponentState) 4971 or ((DC=0) and (not HandleAllocated)) then 4972 exit; 4973 4974 {$IFDEF VerboseDsgnPaintMsg} 4975 if csDesigning in ComponentState then 4976 DebugLn('TWinControl.PaintWindow A ',Name,':',ClassName); 4977 {$ENDIF} 4978 4979 Message.Msg := LM_PAINT; 4980 Message.WParam := WParam(DC); 4981 Message.LParam := 0; 4982 Message.Result := 0; 4983 DefaultHandler(Message); 4984end; 4985 4986procedure TWinControl.CreateBrush; 4987begin 4988 if BrushCreated then exit; 4989 FBrush := TBrush.Create; 4990 if Color = clDefault then 4991 FBrush.Color := GetDefaultColor(dctBrush) 4992 else 4993 FBrush.Color := Color; 4994end; 4995 4996procedure TWinControl.ScaleControls(Multiplier, Divider: Integer); 4997var 4998 i: Integer; 4999begin 5000 for i := 0 to ControlCount - 1 do 5001 Controls[i].ChangeScale(Multiplier, Divider); 5002end; 5003 5004procedure TWinControl.ChangeScale(Multiplier, Divider: Integer); 5005var 5006 i: Integer; 5007begin 5008 if Multiplier <> Divider then 5009 begin 5010 DisableAlign; 5011 try 5012 ScaleControls(Multiplier, Divider); 5013 inherited; 5014 for i := 0 to ControlCount - 1 do 5015 Controls[i].UpdateAnchorRules; 5016 finally 5017 EnableAlign; 5018 end; 5019 end; 5020end; 5021 5022{------------------------------------------------------------------------------ 5023 procedure TWinControl.EraseBackground; 5024------------------------------------------------------------------------------} 5025procedure TWinControl.EraseBackground(DC: HDC); 5026var 5027 ARect: TRect; 5028begin 5029 if DC = 0 then Exit; 5030 ARect := Rect(0, 0, Width, Height); 5031 FillRect(DC, ARect, HBRUSH(Brush.Reference.Handle)); 5032end; 5033 5034{------------------------------------------------------------------------------ 5035 function TWinControl.IntfUTF8KeyPress(var UTF8Key: TUTF8Char; 5036 RepeatCount: integer; SystemKey: boolean): boolean; 5037 5038 Called by the interface after the navigation and specials keys are handled 5039 (e.g. after KeyDown but before KeyPress). 5040------------------------------------------------------------------------------} 5041function TWinControl.IntfUTF8KeyPress(var UTF8Key: TUTF8Char; 5042 RepeatCount: integer; SystemKey: boolean): boolean; 5043begin 5044 IncLCLRefCount; 5045 try 5046 Result := (RepeatCount > 0) and not SystemKey and DoUTF8KeyPress(UTF8Key); 5047 finally 5048 DecLCLRefCount; 5049 end; 5050end; 5051 5052function TWinControl.IntfGetDropFilesTarget: TWinControl; 5053begin 5054 Result:=Self; 5055 repeat 5056 Result:=GetFirstParentForm(Result); 5057 if Result=nil then exit; 5058 if TCustomForm(Result).AllowDropFiles then exit; 5059 Result:=Result.Parent; 5060 until Result=nil; 5061end; 5062 5063procedure TWinControl.PaintTo(DC: HDC; X, Y: Integer); 5064begin 5065 if HandleAllocated then 5066 TWSWinControlClass(WidgetSetClass).PaintTo(Self, DC, X, Y); 5067end; 5068 5069procedure TWinControl.PaintTo(ACanvas: TCanvas; X, Y: Integer); 5070begin 5071 PaintTo(ACanvas.Handle, X, Y); 5072 ACanvas.Changed; 5073end; 5074 5075procedure TWinControl.SetShape(AShape: TBitmap); 5076begin 5077 if not HandleAllocated then 5078 Exit; 5079 5080 if (AShape <> nil) and (AShape.Width = Width) and (AShape.Height = Height) then 5081 TWSWinControlClass(WidgetSetClass).SetShape(Self, AShape.Handle) 5082 else 5083 if AShape = nil then 5084 TWSWinControlClass(WidgetSetClass).SetShape(Self, 0) 5085end; 5086 5087procedure TWinControl.SetShape(AShape: TRegion); 5088begin 5089 LCLIntf.SetWindowRgn(Handle, AShape.Reference.Handle, True); 5090end; 5091 5092{------------------------------------------------------------------------------ 5093 TWinControl ControlAtPos 5094 Params: const Pos : TPoint 5095 AllowDisabled: Boolean 5096 Results: TControl 5097 5098 Searches a child (not grand child) control, which client area contains Pos. 5099 Pos is relative to the ClientOrigin. 5100------------------------------------------------------------------------------} 5101function TWinControl.ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean): TControl; 5102begin 5103 Result := ControlAtPos(Pos, AllowDisabled, False); 5104end; 5105 5106{------------------------------------------------------------------------------ 5107 TWinControl ControlAtPos 5108 Params: const Pos : TPoint 5109 AllowDisabled, AllowWinControls: Boolean 5110 Results: TControl 5111 5112 Searches a child (not grand child) control, which client area contains Pos. 5113 Pos is relative to the ClientOrigin. 5114------------------------------------------------------------------------------} 5115function TWinControl.ControlAtPos(const Pos: TPoint; 5116 AllowDisabled, AllowWinControls: Boolean): TControl; 5117var 5118 Flags: TControlAtPosFlags; 5119begin 5120 Flags := [capfOnlyClientAreas]; 5121 if AllowDisabled then Include(Flags, capfAllowDisabled); 5122 if AllowWinControls then Include(Flags, capfAllowWinControls); 5123 Result := ControlAtPos(Pos, Flags); 5124end; 5125 5126{------------------------------------------------------------------------------ 5127 TWinControl ControlAtPos 5128 Params: const Pos : TPoint 5129 Flags: TControlAtPosFlags 5130 Results: TControl 5131 5132 Searches a child (not grand child) control, which contains Pos. 5133 Pos is relative to the ClientOrigin. 5134------------------------------------------------------------------------------} 5135function TWinControl.ControlAtPos(const Pos: TPoint; 5136 Flags: TControlAtPosFlags): TControl; 5137var 5138 I: Integer; 5139 P: TPoint; 5140 LControl: TControl; 5141 ClientBounds: TRect; 5142 5143 function GetControlAtPos(AControl: TControl): Boolean; 5144 var 5145 ControlPos: TPoint; 5146 begin 5147 with AControl do 5148 begin 5149 ControlPos := Point(P.X - Left, P.Y - Top); 5150 Result := (ControlPos.X >= 0) and (ControlPos.Y >= 0) and 5151 (ControlPos.X < Width) and (ControlPos.Y < Height); 5152 5153 if Result and (capfOnlyClientAreas in Flags) then 5154 Result := PtInRect(ClientRect, ControlPos); 5155 5156 Result := Result 5157 and ( 5158 ( 5159 (csDesigning in ComponentState) 5160 and not (csNoDesignVisible in ControlStyle) 5161 // Here was a VCL bug: VCL checks if control is Visible, 5162 // which should be ignored at designtime 5163 ) 5164 or 5165 ( 5166 (not (csDesigning in ComponentState)) 5167 and 5168 (Visible) 5169 and 5170 (Enabled or (capfAllowDisabled in Flags)) 5171 and 5172 (Perform(CM_HITTEST, 0, 5173 LParam(Integer(PointToSmallPointNoChecks(ControlPos)))) <> 0) 5174 ) 5175 ); 5176 {$IFDEF VerboseMouseBugfix} 5177 //if Result then 5178 DebugLn(['GetControlAtPos ',Name,':',ClassName, 5179 ' Pos=',Pos.X,',',Pos.Y, 5180 ' P=',P.X,',',P.Y, 5181 ' ControlPos=',dbgs(ControlPos), 5182 ' ClientBounds=',ClientBounds.Left,',',ClientBounds.Top,',',ClientBounds.Right,',',ClientBounds.Bottom, 5183 // ' OnlyCl=',OnlyClientAreas, 5184 ' Result=',Result]); 5185 {$ENDIF} 5186 if Result then 5187 LControl := AControl; 5188 end; 5189 end; 5190 5191var 5192 ScrolledOffset: TPoint; 5193 OldClientOrigin: TPoint; 5194 NewClientOrigin: TPoint; 5195 NewPos: TPoint; 5196begin 5197 //debugln(['TWinControl.ControlAtPos START ',DbgSName(Self),' P=',dbgs(Pos)]); 5198 5199 // check if Pos in visible client area 5200 ClientBounds := GetClientRect; 5201 ScrolledOffset := GetClientScrollOffset; 5202 if capfHasScrollOffset in Flags then 5203 begin 5204 { ClientBounds do not include scrolling offset } 5205 inc(ClientBounds.Left, ScrolledOffset.x); 5206 inc(ClientBounds.Right, ScrolledOffset.x); 5207 inc(ClientBounds.Top, ScrolledOffset.y); 5208 inc(ClientBounds.Bottom, ScrolledOffset.y); 5209 end; 5210 5211 if not PtInRect(ClientBounds, Pos) then 5212 begin 5213 //debugln(['TWinControl.ControlAtPos OUT OF CLIENTBOUNDS ',DbgSName(Self),' P=',dbgs(Pos),' ClientBounds=',dbgs(ClientBounds)]); 5214 Result := nil; 5215 exit; 5216 end; 5217 5218 // map Pos to logical client area 5219 P := Pos; 5220 if not (capfHasScrollOffset in Flags) then 5221 begin 5222 inc(P.X, ScrolledOffset.X); 5223 inc(P.Y, ScrolledOffset.Y); 5224 end; 5225 5226 LControl := nil; 5227 if FControls<>nil then 5228 begin 5229 // check wincontrols 5230 if (capfAllowWinControls in Flags) then 5231 for I := FControls.Count - 1 downto 0 do 5232 if (TObject(FControls[i]) is TWinControl) 5233 and GetControlAtPos(TControl(FControls[I])) then 5234 Break; 5235 // check controls 5236 if (LControl = nil) and not(capfOnlyWinControls in Flags) then 5237 for I := FControls.Count - 1 downto 0 do 5238 if (not (TObject(FControls[i]) is TWinControl)) 5239 and GetControlAtPos(TControl(FControls[I])) then 5240 Break; 5241 end; 5242 Result := LControl; 5243 5244 // check recursive sub children 5245 if (capfRecursive in Flags) and (Result is TWinControl) and 5246 (TWinControl(Result).ControlCount > 0) then 5247 begin 5248 // in LCL ClientOrigin contains the scroll offset. At least this is so 5249 // for win32 and gtk2 5250 OldClientOrigin := ClientOrigin; 5251 NewClientOrigin := TWinControl(Result).ClientOrigin; 5252 NewPos := Pos; 5253 NewPos.X := NewPos.X - NewClientOrigin.X + OldClientOrigin.X; 5254 NewPos.Y := NewPos.Y - NewClientOrigin.Y + OldClientOrigin.Y; 5255 LControl := TWinControl(Result).ControlAtPos(NewPos, Flags + [capfHasScrollOffset]); 5256 //debugln(['TWinControl.RECURSED ControlAtPos Result=',DbgSName(Result),' LControl=',DbgSName(LControl),' ',dbgs(NewPos),' AllowDisabled=',AllowDisabled,' OnlyClientAreas=',OnlyClientAreas]); 5257 if LControl <> nil then 5258 Result := LControl; 5259 end; 5260 //debugln(['TWinControl.ControlAtPos END ',DbgSName(Self),' P=',dbgs(Pos),' Result=',DbgSName(Result)]); 5261end; 5262 5263{------------------------------------------------------------------------------- 5264 function TWinControl.GetControlIndex(AControl: TControl): integer; 5265 5266 5267-------------------------------------------------------------------------------} 5268function TWinControl.GetControlIndex(AControl: TControl): integer; 5269begin 5270 if FControls <> nil then 5271 Result := FControls.IndexOf(AControl) 5272 else 5273 Result := -1; 5274end; 5275 5276{------------------------------------------------------------------------------- 5277 function TWinControl.GetControlIndex(AControl: TControl): integer; 5278 5279 5280-------------------------------------------------------------------------------} 5281procedure TWinControl.SetControlIndex(AControl: TControl; NewIndex: integer); 5282begin 5283 SetChildZPosition(AControl, NewIndex); 5284end; 5285 5286{------------------------------------------------------------------------------ 5287 TWinControl DestroyHandle 5288------------------------------------------------------------------------------} 5289procedure TWinControl.DestroyHandle; 5290var 5291 i: integer; 5292 AControl: TControl; 5293begin 5294 //DebugLn(['TWinControl.DestroyHandle START ',DbgSName(Self)]); 5295 if not HandleAllocated then begin 5296 DebugLn('Warning: TWinControl.DestroyHandle ',Name,':',ClassName,' Handle not Allocated'); 5297 //RaiseGDBException(''); 5298 end; 5299 5300 // First destroy all children handles 5301 //DebugLn(['TWinControl.DestroyHandle DESTROY CHILDS ',DbgSName(Self)]); 5302 Include(FControlState, csDestroyingHandle); 5303 try 5304 if FControls <> nil then begin 5305 for i:= 0 to FControls.Count - 1 do begin 5306 //DebugLn([' ',i,' ',DbgSName(TObject(FWinControls[i]))]); 5307 AControl:=TControl(FControls[i]); 5308 if (AControl is TWinControl) and TWinControl(AControl).HandleAllocated then 5309 TWinControl(AControl).DestroyHandle; 5310 end; 5311 end; 5312 //DebugLn(['TWinControl.DestroyHandle DESTROY SELF ',DbgSName(Self)]); 5313 DestroyWnd; 5314 finally 5315 Exclude(FControlState, csDestroyingHandle); 5316 end; 5317 //DebugLn(['TWinControl.DestroyHandle END ',DbgSName(Self)]); 5318end; 5319 5320{------------------------------------------------------------------------------ 5321 TWinControl WndPRoc 5322------------------------------------------------------------------------------} 5323procedure TWinControl.WndProc(var Message: TLMessage); 5324var 5325 Form: TCustomForm; 5326begin 5327 //debugln(['TWinControl.WndProc ',DbgSName(Self),' ',Message.Msg]); 5328 //DebugLn(Format('Trace:[TWinControl.WndPRoc] %s(%s) --> Message = %d', [ClassName, Name, Message.Msg])); 5329 case Message.Msg of 5330 LM_SETFOCUS: 5331 begin 5332 //DebugLn(Format('Trace:[TWinControl.WndPRoc] %s --> LM_SETFOCUS', [ClassName])); 5333 {$IFDEF VerboseFocus} 5334 DebugLn('TWinControl.WndProc LM_SetFocus ',DbgSName(Self)); 5335 {$ENDIF} 5336 Form := GetParentForm(Self); 5337 if Assigned(Form) and not (csDestroyingHandle in ControlState) and not (csDestroying in ComponentState) then 5338 begin 5339 if not Form.SetFocusedControl(Self) then 5340 begin 5341 {$IFDEF VerboseFocus} 5342 DebugLn('TWinControl.WndProc LM_SetFocus ',DbgSName(Self),' form=',DbgSName(Form),' Form.SetFocusedControl FAILED'); 5343 {$ENDIF} 5344 Exit; 5345 end; 5346 Message.Result := 0; 5347 end; 5348 {$IFDEF VerboseFocus} 5349 DebugLn('TWinControl.WndProc AFTER form LM_SetFocus ',DbgSName(Self)); 5350 {$ENDIF} 5351 end; 5352 5353 LM_KILLFOCUS: 5354 begin 5355 //DebugLn(Format('Trace:[TWinControl.WndPRoc] %s --> _KILLFOCUS', [ClassName])); 5356 if csFocusing in ControlState then 5357 begin 5358 {$IFDEF VerboseFocus} 5359 DebugLn('TWinControl.WndProc LM_KillFocus during focusing ',Name,':',ClassName); 5360 {$ENDIF} 5361 Exit; 5362 end; 5363 Message.Result:=0; 5364 end; 5365 5366 // exclude only LM_MOUSEENTER, LM_MOUSELEAVE 5367 LM_MOUSEFIRST..LM_MOUSELAST, 5368 LM_MOUSEFIRST2..LM_RBUTTONQUADCLK, 5369 LM_XBUTTONTRIPLECLK..LM_MOUSELAST2: 5370 begin 5371 {$IFDEF VerboseMouseBugfix} 5372 DebugLn('TWinControl.WndPRoc A ',Name,':',ClassName); 5373 {$ENDIF} 5374 //if Message.Msg=LM_RBUTTONUP then begin DebugLn(['TWinControl.WndProc ',DbgSName(Self)]); DumpStack end; 5375 DoBeforeMouseMessage; 5376 if IsControlMouseMSG(Message) then 5377 Exit 5378 else 5379 begin 5380 if FDockSite and FUseDockManager and Assigned(DockManager) then 5381 DockManager.MessageHandler(Self, Message); 5382 end; 5383 {$IFDEF VerboseMouseBugfix} 5384 DebugLn('TWinControl.WndPRoc B ',Name,':',ClassName); 5385 {$ENDIF} 5386 end; 5387 5388 LM_KEYFIRST..LM_KEYLAST: 5389 if Dragging then Exit; 5390 5391 LM_CANCELMODE: 5392 if (FindOwnerControl(GetCapture) = Self) 5393 and (CaptureControl <> nil) 5394 and (CaptureControl.Parent = Self) 5395 then CaptureControl.Perform(LM_CANCELMODE,0,0); 5396 CM_MOUSEENTER, 5397 CM_MOUSELEAVE: 5398 begin 5399 if FDockSite and FUseDockManager and Assigned(DockManager) then 5400 DockManager.MessageHandler(Self, Message); 5401 end; 5402 CM_TEXTCHANGED, CM_VISIBLECHANGED, LM_SIZE, LM_MOVE: 5403 begin 5404 // forward message to the dock manager is we are docked 5405 if (HostDockSite <> nil) and (HostDockSite.UseDockManager) and 5406 Assigned(HostDockSite.DockManager) then 5407 HostDockSite.DockManager.MessageHandler(Self, Message); 5408 end; 5409 end; 5410 5411 inherited WndProc(Message); 5412end; 5413 5414procedure TWinControl.WSSetText(const AText: String); 5415begin 5416 TWSWinControlClass(WidgetSetClass).SetText(Self, AText); 5417end; 5418 5419{------------------------------------------------------------------------------ 5420 procedure TWinControl.DoAddDockClient(Client: TControl; const ARect: TRect); 5421 5422 Default method for adding a dock client. Become the new parent and break 5423 old anchored controls. 5424 ------------------------------------------------------------------------------} 5425procedure TWinControl.DoAddDockClient(Client: TControl; const ARect: TRect); 5426begin 5427 //DebugLn(['TWinControl.DoAddDockClient ',DbgSName(Self),' Client=',DbgSName(Client),' OldParent=',DbgSName(Client.Parent),' Client.AnchoredControlCount=',Client.AnchoredControlCount]); 5428 Client.Parent := Self; 5429end; 5430 5431{------------------------------------------------------------------------------ 5432 procedure TWinControl.DockOver(Source: TDragDockObject; X, Y: Integer; 5433 State: TDragState; var Accept: Boolean); 5434 5435 Called to check whether this control allows docking and where. 5436 ------------------------------------------------------------------------------} 5437procedure TWinControl.DockOver(Source: TDragDockObject; X, Y: Integer; 5438 State: TDragState; var Accept: Boolean); 5439begin 5440 if State = dsDragMove then 5441 PositionDockRect(Source); 5442 DoDockOver(Source, X, Y, State, Accept); 5443end; 5444 5445{------------------------------------------------------------------------------ 5446 procedure TWinControl.DoDockOver(Source: TDragDockObject; X, Y: Integer; 5447 State: TDragState; var Accept: Boolean); 5448 ------------------------------------------------------------------------------} 5449procedure TWinControl.DoDockOver(Source: TDragDockObject; X, Y: Integer; 5450 State: TDragState; var Accept: Boolean); 5451begin 5452 if Assigned(FOnDockOver) then 5453 FOnDockOver(Self, Source, X, Y, State, Accept); 5454end; 5455 5456{------------------------------------------------------------------------------ 5457 procedure TWinControl.DoRemoveDockClient(Client: TControl); 5458 5459 Called to remove client from dock list. 5460 This method exists for descendent overrides. 5461 ------------------------------------------------------------------------------} 5462procedure TWinControl.DoRemoveDockClient(Client: TControl); 5463begin 5464 // empty (this method exists for descendent overrides) 5465 {$IFDEF VerboseDocking} 5466 DebugLn(['TWinControl.DoRemoveDockClient ',DbgSName(Self),' ',DbgSName(Client)]); 5467 {$ENDIF} 5468end; 5469 5470{------------------------------------------------------------------------------ 5471 function TWinControl.DoUnDock(NewTarget: TWinControl; Client: TControl 5472 ): Boolean; 5473 ------------------------------------------------------------------------------} 5474function TWinControl.DoUnDock(NewTarget: TWinControl; Client: TControl; 5475 KeepDockSiteSize: Boolean): Boolean; 5476var 5477 NewBounds: TRect; 5478begin 5479 {$IFDEF VerboseDocking} 5480 DebugLn('TWinControl.DoUnDock ',Name,' NewTarget=',DbgSName(NewTarget),' Client=',DbgSName(Client)); 5481 {$ENDIF} 5482 Result := True; 5483 if Assigned(FOnUnDock) then 5484 begin 5485 FOnUnDock(Self, Client, NewTarget, Result); 5486 if not Result then 5487 Exit; 5488 end; 5489 5490 if not KeepDockSiteSize then 5491 begin 5492 NewBounds := BoundsRect; 5493 case Client.Align of 5494 alLeft: 5495 inc(NewBounds.Left, Client.Width); 5496 alTop: 5497 inc(NewBounds.Top, Client.Height); 5498 alRight: 5499 dec(NewBounds.Right, Client.Width); 5500 alBottom: 5501 dec(NewBounds.Bottom, Client.Height); 5502 end; 5503 SetBoundsKeepBase(NewBounds.Left, NewBounds.Top, 5504 NewBounds.Right - NewBounds.Left, 5505 NewBounds.Bottom - NewBounds.Top); 5506 end; 5507 5508 Result := Result and DoUndockClientMsg(NewTarget, Client); 5509end; 5510 5511{------------------------------------------------------------------------------ 5512 procedure TWinControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; 5513 MousePos: TPoint; var CanDock: Boolean); 5514 ------------------------------------------------------------------------------} 5515procedure TWinControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; 5516 MousePos: TPoint; var CanDock: Boolean); 5517const 5518 ADockMargin = 10; 5519begin 5520 GetWindowRect(Handle, InfluenceRect); 5521 //Margins to test docking (enlarged surface for test) 5522 InfluenceRect.Left := InfluenceRect.Left-ADockMargin; 5523 InfluenceRect.Top := InfluenceRect.Top-ADockMargin; 5524 InfluenceRect.Right := InfluenceRect.Right+ADockMargin; 5525 InfluenceRect.Bottom := InfluenceRect.Bottom+ADockMargin; 5526 5527 if UseDockManager then 5528 CanDock:=DockManager.IsEnabledControl(Client); 5529 5530 if Assigned(FOnGetSiteInfo) then 5531 FOnGetSiteInfo(Self, Client, InfluenceRect, MousePos, CanDock); 5532end; 5533 5534{------------------------------------------------------------------------------ 5535 function TWinControl.GetParentHandle: HWND; 5536 ------------------------------------------------------------------------------} 5537function TWinControl.GetParentHandle: HWND; 5538begin 5539 if Parent <> nil then 5540 Result := Parent.Handle 5541 else 5542 Result := ParentWindow; 5543end; 5544 5545{------------------------------------------------------------------------------ 5546 function TWinControl.GetTopParentHandle: HWND; 5547 ------------------------------------------------------------------------------} 5548function TWinControl.GetTopParentHandle: HWND; 5549var 5550 AWinControl: TWinControl; 5551begin 5552 AWinControl := Self; 5553 while AWinControl.Parent <> nil do 5554 AWinControl := AWinControl.Parent; 5555 if AWinControl.ParentWindow = 0 then 5556 Result := AWinControl.Handle 5557 else 5558 Result := AWinControl.ParentWindow; 5559end; 5560 5561{------------------------------------------------------------------------------ 5562 procedure TWinControl.ReloadDockedControl(const AControlName: string; 5563 var AControl: TControl); 5564 ------------------------------------------------------------------------------} 5565procedure TWinControl.ReloadDockedControl(const AControlName: string; 5566 var AControl: TControl); 5567begin 5568 AControl := Owner.FindComponent(AControlName) as TControl; 5569end; 5570 5571{------------------------------------------------------------------------------ 5572 function TWinControl.CreateDockManager: TDockManager; 5573 ------------------------------------------------------------------------------} 5574function TWinControl.CreateDockManager: TDockManager; 5575begin 5576 if (DockManager = nil) and DockSite and UseDockManager then 5577 // this control can dock other controls, so it needs a TDockManager 5578 Result := DefaultDockManagerClass.Create(Self) 5579 else 5580 Result := DockManager; 5581end; 5582 5583procedure TWinControl.SetDockManager(AMgr: TDockManager); 5584begin 5585 //use FDockManager only here! 5586 if Assigned(DockManager) and (DockManager <> AMgr) then 5587 if FDockManager.AutoFreeByControl then 5588 FDockManager.Free; 5589 FDockManager := AMgr; //can be nil 5590end; 5591 5592{------------------------------------------------------------------------------ 5593 procedure TWinControl.SetUseDockManager(const AValue: Boolean); 5594 ------------------------------------------------------------------------------} 5595procedure TWinControl.SetUseDockManager(const AValue: Boolean); 5596begin 5597 if FUseDockManager=AValue then exit; 5598 FUseDockManager:=AValue; 5599 if FUseDockManager and ([csDesigning,csDestroying]*ComponentState=[]) 5600 and (DockManager=nil) then 5601 DockManager := CreateDockManager; 5602end; 5603 5604procedure TWinControl.DoFloatMsg(ADockSource: TDragDockObject); 5605var 5606 WasVisible: Boolean; 5607begin 5608 if FloatingDockSiteClass = ClassType then 5609 begin 5610 WasVisible := Visible; 5611 try 5612 Dock(nil, ADockSource.DockRect); 5613 finally 5614 if WasVisible then BringToFront; 5615 end; 5616 end 5617 else 5618 inherited DoFloatMsg(ADockSource); 5619end; 5620 5621function TWinControl.GetDockCaption(AControl: TControl): String; 5622begin 5623 Result := AControl.GetDefaultDockCaption; 5624 DoGetDockCaption(AControl, Result); 5625end; 5626 5627procedure TWinControl.UpdateDockCaption(Exclude: TControl); 5628begin 5629 { Called when this is a hostdocksite and either the list of docked clients have 5630 changed or one of their captions. 5631 Exclude an currently undocking control. } 5632end; 5633 5634procedure TWinControl.DoGetDockCaption(AControl: TControl; var ACaption: String); 5635begin 5636 if Assigned(FOnGetDockCaption) then 5637 OnGetDockCaption(Self, AControl, ACaption); 5638end; 5639 5640{------------------------------------------------------------------------------ 5641 procedure TWinControl.MainWndProc(var Message : TLMessage); 5642 5643 The message handler of this wincontrol. 5644 Only needed by controls, which needs features not yet supported by the LCL. 5645 ------------------------------------------------------------------------------} 5646procedure TWinControl.MainWndProc(var Msg: TLMessage); 5647begin 5648 //DebugLn(Format('Trace:[TWinControl.MainWndPRoc] %s(%s) --> Message = %d', [ClassName, Name, Msg.Msg])); 5649end; 5650 5651{------------------------------------------------------------------------------ 5652 TWinControl SetFocus 5653------------------------------------------------------------------------------} 5654procedure TWinControl.SetFocus; 5655var 5656 Form: TCustomForm; 5657begin 5658 {$IFDEF VerboseFocus} 5659 DebugLn('[TWinControl.SetFocus] ',Name,':',ClassName,' Visible=',dbgs(Visible),' HandleAllocated=',dbgs(HandleAllocated)); 5660 {$ENDIF} 5661 Form := GetParentForm(Self); 5662 if Form <> nil then 5663 Form.FocusControl(Self) 5664 else 5665 if IsVisible and HandleAllocated then 5666 LCLIntf.SetFocus(Handle); 5667end; 5668 5669{------------------------------------------------------------------------------ 5670 TWinControl KeyDown 5671------------------------------------------------------------------------------} 5672procedure TWinControl.KeyDown(var Key: Word; Shift: TShiftState); 5673begin 5674 if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift); 5675 if Key <> 0 then 5676 DoCallKeyEventHandler(chtOnKeyDown, Key, Shift); 5677end; 5678 5679{------------------------------------------------------------------------------ 5680 TWinControl KeyDownBeforeInterface 5681------------------------------------------------------------------------------} 5682procedure TWinControl.KeyDownBeforeInterface(var Key: Word; Shift: TShiftState); 5683begin 5684 KeyDown(Key, Shift); 5685end; 5686 5687{------------------------------------------------------------------------------ 5688 TWinControl KeyDownAfterInterface 5689------------------------------------------------------------------------------} 5690procedure TWinControl.KeyDownAfterInterface(var Key: Word; Shift: TShiftState); 5691begin 5692 5693end; 5694 5695{------------------------------------------------------------------------------ 5696 TWinControl KeyPress 5697------------------------------------------------------------------------------} 5698procedure TWinControl.KeyPress(var Key: char); 5699begin 5700 if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key); 5701end; 5702 5703{------------------------------------------------------------------------------ 5704 TWinControl UTF8KeyPress 5705 5706 Called before KeyPress. 5707------------------------------------------------------------------------------} 5708procedure TWinControl.UTF8KeyPress(var UTF8Key: TUTF8Char); 5709begin 5710 if Assigned(FOnUTF8KeyPress) then FOnUTF8KeyPress(Self, UTF8Key); 5711end; 5712 5713{------------------------------------------------------------------------------ 5714 TWinControl KeyUp 5715------------------------------------------------------------------------------} 5716procedure TWinControl.KeyUp(var Key: Word; Shift : TShiftState); 5717begin 5718 if Assigned(FOnKeyUp) then FOnKeyUp(Self, Key, Shift); 5719end; 5720 5721procedure TWinControl.KeyUpBeforeInterface(var Key: Word; Shift: TShiftState); 5722begin 5723 //debugln('TWinControl.KeyUpBeforeInterface ',DbgSName(Self)); 5724 KeyUp(Key,Shift); 5725end; 5726 5727procedure TWinControl.KeyUpAfterInterface(var Key: Word; Shift: TShiftState); 5728begin 5729 //debugln('TWinControl.KeyUpAfterInterface ',DbgSName(Self)); 5730end; 5731 5732{------------------------------------------------------------------------------ 5733 TWinControl DoKeyDownBeforeInterface 5734 5735 returns true if handled 5736------------------------------------------------------------------------------} 5737function TWinControl.DoKeyDownBeforeInterface(var Message: TLMKey; IsRecurseCall: Boolean): Boolean; 5738 5739 function IsShortCut: Boolean; 5740 var 5741 AParent: TWinControl; 5742 APopupMenu: TPopupMenu; 5743 begin 5744 Result := False; 5745 // check popup menu 5746 APopupMenu := PopupMenu; 5747 if Assigned(APopupMenu) and APopupMenu.IsShortCut(Message) then 5748 Exit(True); 5749 5750 if IsRecurseCall then 5751 Exit; 5752 5753 // let each parent form handle shortcuts 5754 AParent := Parent; 5755 while Assigned(AParent) do 5756 begin 5757 if (AParent is TCustomForm) and TCustomForm(AParent).IsShortcut(Message) then 5758 Exit(True); 5759 AParent := AParent.Parent; 5760 end; 5761 5762 // let application handle shortcut 5763 if Assigned(Application) and Application.IsShortcut(Message) then 5764 Exit(True); 5765 end; 5766 5767var 5768 F: TCustomForm; 5769 ShiftState: TShiftState; 5770 AParent: TWinControl; 5771begin 5772 //debugln('TWinControl.DoKeyDown ',DbgSName(Self),' ShiftState=',dbgs(KeyDataToShiftState(Message.KeyData)),' CharCode=',dbgs(Message.CharCode)); 5773 Result := True; 5774 5775 with Message do 5776 begin 5777 if CharCode = VK_UNKNOWN then Exit; 5778 ShiftState := KeyDataToShiftState(KeyData); 5779 5780 if not IsRecurseCall then 5781 begin 5782 // let application handle the key 5783 if Assigned(Application) then 5784 begin 5785 Application.NotifyKeyDownBeforeHandler(Self, CharCode, ShiftState); 5786 if CharCode = VK_UNKNOWN then Exit; 5787 end; 5788 5789 // let each parent form with keypreview handle the key 5790 AParent := Parent; 5791 while Assigned(AParent) do 5792 begin 5793 if (AParent is TCustomForm) then 5794 begin 5795 F := TCustomForm(AParent); 5796 if (F.KeyPreview) and (F.DoKeyDownBeforeInterface(Message, True)) then Exit; 5797 end; 5798 AParent := AParent.Parent; 5799 end; 5800 5801 if CharCode = VK_UNKNOWN then Exit; 5802 ShiftState := KeyDataToShiftState(KeyData); 5803 5804 // let drag object handle the key 5805 if DragManager.IsDragging then 5806 begin 5807 DragManager.KeyDown(CharCode, ShiftState); 5808 if CharCode = VK_UNKNOWN then Exit; 5809 end; 5810 end; 5811 5812 // let user handle the key 5813 if not (csNoStdEvents in ControlStyle) then 5814 begin 5815 KeyDownBeforeInterface(CharCode, ShiftState); 5816 if CharCode = VK_UNKNOWN then Exit; 5817 end; 5818 5819 // check the shortcuts 5820 if IsShortCut then Exit; 5821 end; 5822 5823 Result := False; 5824end; 5825 5826function TWinControl.ChildKey(var Message: TLMKey): boolean; 5827begin 5828 if Assigned(Parent) then 5829 Result := Parent.ChildKey(Message) 5830 else 5831 Result := false; 5832end; 5833 5834function TWinControl.DialogChar(var Message: TLMKey): boolean; 5835var 5836 I: integer; 5837begin 5838 // broadcast to children 5839 Result := False; 5840 for I := 0 to ControlCount - 1 do 5841 begin 5842 // for Delphi compatibility send it to all controls, 5843 // even those that can not focus or are disabled 5844 Result := Controls[I].DialogChar(Message); 5845 if Result then Exit; 5846 end; 5847end; 5848 5849{------------------------------------------------------------------------------ 5850 TWinControl DoRemainingKeyDown 5851 5852 Returns True if key handled 5853------------------------------------------------------------------------------} 5854function TWinControl.DoRemainingKeyDown(var Message: TLMKeyDown): Boolean; 5855var 5856 ShiftState: TShiftState; 5857begin 5858 Result := True; 5859 5860 ShiftState := KeyDataToShiftState(Message.KeyData); 5861 5862 // let parent(s) handle key from child key 5863 if Assigned(Parent) and Parent.ChildKey(Message) then 5864 Exit; 5865 5866 // handle LCL special keys 5867 ControlKeyDown(Message.CharCode, ShiftState); 5868 if Message.CharCode = VK_UNKNOWN then Exit; 5869 5870 //DebugLn('TWinControl.WMKeyDown ',Name,':',ClassName); 5871 if not (csNoStdEvents in ControlStyle) then 5872 begin 5873 KeyDownAfterInterface(Message.CharCode, ShiftState); 5874 if Message.CharCode = VK_UNKNOWN then Exit; 5875 // Note: Message.CharCode can now be different or even 0 5876 end; 5877 5878 // let application handle the remaining key 5879 if Assigned(Application) then 5880 Application.NotifyKeyDownHandler(Self, Message.CharCode, ShiftState); 5881 if Message.CharCode = VK_UNKNOWN then Exit; 5882 5883 Result := False; 5884end; 5885 5886{------------------------------------------------------------------------------ 5887 TWinControl DoKeyPress 5888 5889 Returns True if key handled 5890------------------------------------------------------------------------------} 5891function TWinControl.DoKeyPress(var Message : TLMKey): Boolean; 5892var 5893 F: TCustomForm; 5894 C: char; 5895 AParent: TWinControl; 5896begin 5897 Result := True; 5898 5899 // let each parent form with keypreview handle the key 5900 AParent := Parent; 5901 while (AParent <> nil) do 5902 begin 5903 if (AParent is TCustomForm) then 5904 begin 5905 F := TCustomForm(AParent); 5906 if F.KeyPreview and F.DoKeyPress(Message) then Exit; 5907 end; 5908 AParent := AParent.Parent; 5909 end; 5910 5911 if not (csNoStdEvents in ControlStyle) then 5912 with Message do 5913 begin 5914 C := Char(CharCode); 5915 KeyPress(C); 5916 CharCode := Ord(C); 5917 if Char(CharCode) = #0 then Exit; 5918 end; 5919 5920 Result := False; 5921end; 5922 5923{------------------------------------------------------------------------------ 5924 TWinControl DoRemainingKeyPress 5925 5926 Returns True if key handled 5927------------------------------------------------------------------------------} 5928function TWinControl.SendDialogChar(var Message : TLMKey): Boolean; 5929var 5930 ParentForm: TCustomForm; 5931begin 5932 Result := False; 5933 ParentForm := GetParentForm(Self); 5934 if ParentForm <> nil then 5935 begin 5936 Result := ParentForm.DialogChar(Message); 5937 if Result then 5938 Message.CharCode := VK_UNKNOWN; 5939 end; 5940end; 5941 5942function TWinControl.DoRemainingKeyUp(var Message: TLMKeyDown): Boolean; 5943var 5944 ShiftState: TShiftState; 5945begin 5946 //debugln('TWinControl.DoRemainingKeyUp ',DbgSName(Self)); 5947 Result := True; 5948 5949 ShiftState := KeyDataToShiftState(Message.KeyData); 5950 5951 // handle LCL special keys 5952 ControlKeyUp(Message.CharCode,ShiftState); 5953 if Message.CharCode=VK_UNKNOWN then exit; 5954 5955 if not (csNoStdEvents in ControlStyle) then 5956 begin 5957 KeyUpAfterInterface(Message.CharCode, ShiftState); 5958 if Message.CharCode=VK_UNKNOWN then exit; 5959 // Note: Message.CharCode can now be different or even 0 5960 end; 5961 Result := False; 5962end; 5963 5964{------------------------------------------------------------------------------ 5965 TWinControl DoUTF8KeyPress 5966 5967 Returns True if key handled 5968------------------------------------------------------------------------------} 5969function TWinControl.DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; 5970var 5971 AParent: TWinControl; 5972 F: TCustomForm; 5973begin 5974 Result := True; 5975 5976 // let each parent form with keypreview handle the key 5977 AParent := Parent; 5978 while Assigned(AParent) do 5979 begin 5980 if (AParent is TCustomForm) then 5981 begin 5982 F := TCustomForm(AParent); 5983 if (F.KeyPreview) and F.DoUTF8KeyPress(UTF8Key) then Exit; 5984 end; 5985 AParent := AParent.Parent; 5986 end; 5987 5988 if not (csNoStdEvents in ControlStyle) then 5989 begin 5990 UTF8KeyPress(UTF8Key); 5991 if UTF8Key = '' then Exit; 5992 end; 5993 5994 // redirect to designer 5995 if (csDesigning in ComponentState) then 5996 begin 5997 F := GetDesignerForm(Self); 5998 if Assigned(F) and Assigned(F.Designer) then 5999 begin 6000 F.Designer.UTF8KeyPress(UTF8Key); 6001 if UTF8Key = '' then Exit; 6002 end; 6003 end; 6004 6005 Result := False; 6006end; 6007 6008{------------------------------------------------------------------------------ 6009 TWinControl DoKeyUpBeforeInterface 6010 6011 Returns True if key handled 6012------------------------------------------------------------------------------} 6013function TWinControl.DoKeyUpBeforeInterface(var Message : TLMKey): Boolean; 6014var 6015 F: TCustomForm; 6016 ShiftState: TShiftState; 6017 AParent: TWinControl; 6018begin 6019 Result := True; 6020 6021 // let each parent form with keypreview handle the key 6022 AParent:=Parent; 6023 while (AParent<>nil) do begin 6024 if (AParent is TCustomForm) then begin 6025 F := TCustomForm(AParent); 6026 if (F.KeyPreview) 6027 and (F.DoKeyUpBeforeInterface(Message)) then Exit; 6028 end; 6029 AParent:=AParent.Parent; 6030 end; 6031 6032 with Message do 6033 begin 6034 ShiftState := KeyDataToShiftState(KeyData); 6035 6036 if DragManager.IsDragging then 6037 begin 6038 DragManager.KeyUp(CharCode, ShiftState); 6039 if CharCode = VK_UNKNOWN then Exit; 6040 end; 6041 6042 if not (csNoStdEvents in ControlStyle) 6043 then begin 6044 KeyUpBeforeInterface(CharCode, ShiftState); 6045 if CharCode = VK_UNKNOWN then Exit; 6046 end; 6047 6048 // TODO 6049 //if (CharCode = VK_APPS) and not (ssAlt in ShiftState) then 6050 // CheckMenuPopup(SmallPoint(0, 0)); 6051 end; 6052 Result := False; 6053end; 6054 6055{------------------------------------------------------------------------------ 6056 TWinControl ControlKeyDown 6057------------------------------------------------------------------------------} 6058procedure TWinControl.ControlKeyDown(var Key: Word; Shift: TShiftState); 6059begin 6060 Application.ControlKeyDown(Self,Key,Shift); 6061end; 6062 6063procedure TWinControl.ControlKeyUp(var Key: Word; Shift: TShiftState); 6064begin 6065 //debugln('TWinControl.ControlKeyUp ',DbgSName(Self)); 6066 Application.ControlKeyUp(Self,Key,Shift); 6067end; 6068 6069{------------------------------------------------------------------------------ 6070 TWinControl CreateParams 6071------------------------------------------------------------------------------} 6072procedure TWinControl.CreateParams(var Params : TCreateParams); 6073begin 6074 FillChar(Params, SizeOf(Params),0); 6075 Params.Caption := PChar(FCaption); 6076 Params.Style := WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; 6077 Params.ExStyle := 0; 6078 if csAcceptsControls in ControlStyle then 6079 Params.ExStyle := Params.ExStyle or WS_EX_CONTROLPARENT; 6080 if BorderStyle = bsSingle then 6081 Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; 6082 if TabStop then 6083 Params.Style := Params.Style or WS_TABSTOP; 6084 6085 if (Parent <> nil) then 6086 Params.WndParent := Parent.Handle 6087 else 6088 Params.WndParent := ParentWindow; 6089 6090 Params.X := Left; 6091 Params.Y := Top; 6092 Params.Width := Width; 6093 Params.Height := Height; 6094end; 6095 6096{------------------------------------------------------------------------------ 6097 TWinControl Invalidate 6098------------------------------------------------------------------------------} 6099procedure TWinControl.Invalidate; 6100begin 6101 //DebugLn(['TWinControl.Invalidate ',DbgSName(Self),' HandleAllocated=',HandleAllocated]); 6102 if HandleAllocated and ([csDestroying,csLoading]*ComponentState=[]) then 6103 TWSWinControlClass(WidgetSetClass).Invalidate(Self); 6104end; 6105 6106{------------------------------------------------------------------------------ 6107 TWinControl AddControl 6108 6109 Add Handle object to parents Handle object. 6110------------------------------------------------------------------------------} 6111procedure TWinControl.AddControl; 6112begin 6113 TWSControlClass(WidgetSetClass).AddControl(Self); 6114end; 6115 6116{------------------------------------------------------------------------------ 6117 TWinControl Repaint 6118------------------------------------------------------------------------------} 6119procedure TWinControl.Repaint; 6120begin 6121 if (not HandleAllocated) or (csDestroying in ComponentState) then exit; 6122 {$IFDEF VerboseDsgnPaintMsg} 6123 if csDesigning in ComponentState then 6124 DebugLn('TWinControl.Repaint A ',Name,':',ClassName); 6125 {$ENDIF} 6126 TWSWinControlClass(WidgetSetClass).Repaint(Self); 6127end; 6128 6129{------------------------------------------------------------------------------ 6130 TWinControl Insert 6131------------------------------------------------------------------------------} 6132procedure TWinControl.Insert(AControl : TControl); 6133begin 6134 Insert(AControl,ControlCount); 6135end; 6136 6137{------------------------------------------------------------------------------ 6138 procedure TWinControl.Insert(AControl: TControl; Index: integer); 6139------------------------------------------------------------------------------} 6140procedure TWinControl.Insert(AControl: TControl; Index: integer); 6141begin 6142 if AControl = nil then exit; 6143 if AControl.FParent<>nil then 6144 raise EInvalidOperation.Create('control has already a parent'); 6145 6146 if AControl = Self then 6147 raise EInvalidOperation.Create(rsAControlCanNotHaveItselfAsParent); 6148 6149 ListInsert(FControls, Index, AControl); 6150 if AControl is TWinControl then 6151 begin 6152 ListAdd(FTabList, AControl); 6153 6154 if (csDesigning in ComponentState) and (not (csLoading in ComponentState)) 6155 and AControl.CanTab then 6156 TWinControl(AControl).TabStop := true; 6157 end; 6158 6159 AControl.FParent := Self; 6160 if AControl.FAutoSizingLockCount>0 then 6161 begin 6162 // the AControl has disabled autosizing => disable it for the parent=self too 6163 //DebugLn([Space(FAutoSizingLockCount*2+2),'TWinControl.Insert ',DbgSName(Self),' Control=',DbgSName(AControl),' disable Parent']); 6164 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.DisableAutoSizing'){$ENDIF}; 6165 end; 6166end; 6167 6168{------------------------------------------------------------------------------ 6169 TWinControl ReAlign 6170 6171 Realign all children 6172------------------------------------------------------------------------------} 6173procedure TWinControl.ReAlign; 6174begin 6175 AdjustSize; 6176end; 6177 6178procedure TWinControl.ScrollBy_WS(DeltaX, DeltaY: Integer); 6179begin 6180 if HandleAllocated then 6181 TWSWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY) 6182 else 6183 raise Exception.Create('TWinControl.ScrollBy_WS: Handle not allocated'); 6184end; 6185 6186procedure TWinControl.ScrollBy(DeltaX, DeltaY: Integer); 6187var 6188 i: Integer; 6189begin 6190 // scroll inner controls 6191 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.ScrollBy'){$ENDIF}; 6192 try 6193 for i := 0 to ControlCount - 1 do 6194 with Controls[i] do 6195 SetBounds(Left + DeltaX, Top + DeltaY, Width, Height); 6196 finally 6197 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.ScrollBy'){$ENDIF}; 6198 end; 6199end; 6200 6201{------------------------------------------------------------------------------ 6202 TWinControl Remove 6203------------------------------------------------------------------------------} 6204procedure TWinControl.Remove(AControl : TControl); 6205begin 6206 if AControl <> nil then 6207 begin 6208 //DebugLn(Format('trace:[TWinControl.Remove] %s(%S) --> Remove: %s(%s)', [ClassName, Name, AControl.ClassName, AControl.Name])); 6209 if AControl is TWinControl then 6210 ListRemove(FTabList, AControl); 6211 ListRemove(FControls, AControl); 6212 ListRemove(FAlignOrder, AControl); 6213 AControl.FParent := nil; 6214 if AControl.FAutoSizingLockCount>0 then 6215 begin 6216 // AControl has disabled autosizing and thus for its parent=Self too 6217 // end disable autosize for parent=self 6218 //DebugLn([Space(FAutoSizingLockCount*2),'TWinControl.Remove ',DbgSName(Self),' Control=',DbgSName(AControl),' enable Parent']); 6219 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.DisableAutoSizing'){$ENDIF}; 6220 end; 6221 end; 6222end; 6223 6224procedure TWinControl.AlignNonAlignedControls(ListOfControls: TFPList; 6225 var BoundsModified: Boolean); 6226{ All controls, not aligned/anchored by their own properties, can be auto aligned. 6227 6228 Example: 6229 cclLeftToRightThenTopToBottom 6230 6231 +-----------------------------------+ 6232 |+---------------------------------+| 6233 || Control1 | Control2 | Control 3 || 6234 |+---------------------------------+| 6235 |+---------------------------------+| 6236 || Control4 | Control5 | Control 6 || 6237 |+---------------------------------+| 6238 |+---------------------+ | 6239 || Control7 | Control8 | | 6240 |+---------------------+ | 6241 +-----------------------------------+ 6242} 6243var 6244 Box: TAutoSizeBox; 6245 r: TRect; 6246begin 6247 // check if ChildSizing aligning is enabled 6248 if (ChildSizing.Layout=cclNone) or (ListOfControls.Count=0) then 6249 exit; 6250 6251 //debugln('TWinControl.AlignNonAlignedControls ',DbgSName(Self),' ListOfControls.Count=',dbgs(ListOfControls.Count),' ',dbgs(ord(ChildSizing.EnlargeHorizontal))); 6252 6253 Box:=TAutoSizeBox.Create; 6254 try 6255 r:=GetLogicalClientRect; 6256 BoundsModified:=Box.AlignControlsInTable(ListOfControls,ChildSizing,BiDiMode, 6257 r.Right,r.Bottom,true); 6258 finally 6259 Box.Free; 6260 end; 6261end; 6262 6263class procedure TWinControl.WSRegisterClass; 6264begin 6265 inherited WSRegisterClass; 6266 RegisterWinControl; 6267 RegisterPropertyToSkip(TWinControl, 'ParentDoubleBuffered', 'VCL compatibility property', ''); 6268 RegisterPropertyToSkip(TWinControl, 'ImeMode', 'VCL compatibility property', ''); 6269 RegisterPropertyToSkip(TWinControl, 'ImeName', 'VCL compatibility property', ''); 6270end; 6271 6272function TWinControl.IsClientHeightStored: boolean; 6273begin 6274 // The ClientHeight is needed to restore children anchored akBottom 6275 Result:=ControlCount>0; 6276end; 6277 6278function TWinControl.IsClientWidthStored: boolean; 6279begin 6280 // The ClientWidth is needed to restore children anchored akRight 6281 Result:=ControlCount>0; 6282end; 6283 6284{------------------------------------------------------------------------------ 6285 TWinControl RemoveFocus 6286------------------------------------------------------------------------------} 6287procedure TWinControl.RemoveFocus(Removing : Boolean); 6288var 6289 Form: TCustomForm; 6290begin 6291 Form := GetParentForm(Self); 6292 if Form <> nil then Form.DefocusControl(Self, Removing); 6293end; 6294 6295{------------------------------------------------------------------------------ 6296 TWinControl UpdateControlState 6297 6298 Called by: RecreateWnd, TCustomTabControl.ShowCurrentPage, 6299 TWinControl.SetParentWindow, TWinControl.InsertControl, 6300 TWinControl.CMVisibleChanged 6301------------------------------------------------------------------------------} 6302procedure TWinControl.UpdateControlState; 6303begin 6304 if HandleObjectShouldBeVisible then 6305 AdjustSize // this will trigger DoAllAutoSize, which calls UpdateShowing 6306 else 6307 UpdateShowing; // hide immediately 6308end; 6309 6310{------------------------------------------------------------------------------ 6311 TWinControl InsertControl 6312------------------------------------------------------------------------------} 6313procedure TWinControl.InsertControl(AControl: TControl); 6314begin 6315 InsertControl(AControl, ControlCount); 6316end; 6317 6318procedure TWinControl.InsertControl(AControl: TControl; Index: integer); 6319begin 6320 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.InsertControl'){$ENDIF}; 6321 try 6322 AControl.ValidateContainer(Self); 6323 Perform(CM_CONTROLLISTCHANGE, WParam(AControl), LParam(True)); 6324 Insert(AControl,Index); 6325 Assert(AControl.Parent = Self, 'TWinControl.InsertControl: AControl.Parent <> Self'); 6326 UpdateAlignIndex(AControl); 6327 if not (csReading in AControl.ComponentState) then 6328 begin 6329 AControl.Perform(CM_PARENTCOLORCHANGED, 0, 0); 6330 AControl.Perform(CM_PARENTSHOWHINTCHANGED, 0, 0); 6331 AControl.Perform(CM_PARENTBIDIMODECHANGED, 0, 0); 6332 AControl.Perform(CM_PARENTFONTCHANGED, 0, 0); 6333 AControl.Perform(CM_PARENTDOUBLEBUFFEREDCHANGED, 0, 0); 6334 AControl.UpdateBaseBounds(false,true,false); 6335 if AControl is TWinControl then 6336 TWinControl(AControl).UpdateControlState 6337 else 6338 if HandleAllocated then 6339 AControl.Invalidate; 6340 //DebugLn('TWinControl.InsertControl ',Name,':',ClassName); 6341 end; 6342 AdjustSize; 6343 Perform(CM_CONTROLCHANGE, WParam(AControl), LParam(True)); 6344 finally 6345 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.InsertControl'){$ENDIF}; 6346 end; 6347 //debugln(['TWinControl.InsertControl ',DbgSName(Self),' ',csDesigning in ComponentState,' ',DbgSName(AControl),' ',csDesigning in AControl.ComponentState]); 6348end; 6349 6350{------------------------------------------------------------------------------ 6351 TWinControl removeControl 6352------------------------------------------------------------------------------} 6353procedure TWinControl.RemoveControl(AControl: TControl); 6354var 6355 AWinControl: TWinControl; 6356 AGrControl: TGraphicControl; 6357begin 6358 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.RemoveControl'){$ENDIF}; 6359 try 6360 Perform(CM_CONTROLCHANGE, WParam(AControl), LParam(False)); 6361 if AControl is TWinControl then 6362 begin 6363 AWinControl := TWinControl(AControl); 6364 AWinControl.RemoveFocus(True); 6365 if AWinControl.HandleAllocated then 6366 AWinControl.DestroyHandle; 6367 end 6368 else 6369 begin 6370 if AControl is TGraphicControl then 6371 begin 6372 AGrControl := TGraphicControl(AControl); 6373 if (AGrControl.Canvas<>nil) then 6374 TControlCanvas(AGrControl.Canvas).FreeHandle; 6375 end; 6376 if HandleAllocated then 6377 AControl.InvalidateControl(AControl.IsVisible, False, True); 6378 end; 6379 Remove(AControl); 6380 Perform(CM_CONTROLLISTCHANGE, WParam(AControl), LParam(False)); 6381 if not (csDestroying in ComponentState) then 6382 begin 6383 InvalidatePreferredSize; 6384 AdjustSize; 6385 end; 6386 finally 6387 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.RemoveControl'){$ENDIF}; 6388 end; 6389end; 6390 6391function TWinControl.GetEnumeratorControls: TWinControlEnumerator; 6392begin 6393 Result:=TWinControlEnumerator.Create(Self,true); 6394end; 6395 6396function TWinControl.GetEnumeratorControlsReverse: TWinControlEnumerator; 6397begin 6398 Result:=TWinControlEnumerator.Create(Self,false); 6399end; 6400 6401{------------------------------------------------------------------------------ 6402 TWinControl AlignControl 6403------------------------------------------------------------------------------} 6404procedure TWinControl.AlignControl(AControl: TControl); 6405var 6406 ARect: TRect; 6407 NewRect: TRect; 6408begin 6409 //if csDesigning in ComponentState then begin 6410 // DbgOut('TWinControl.AlignControl ',Name,':',ClassName); 6411 // if AControl<>nil then DebugLn(' AControl=',AControl.Name,':',AControl.ClassName) else DebugLn(' AControl=nil');; 6412 //end; 6413 if csDestroying in ComponentState then exit; 6414 6415 // only called by DoAllAutoSize, so no check needed 6416 6417 DisableAlign; 6418 try 6419 // store 6420 ARect := GetClientRect; 6421 AdjustClientRect(ARect); 6422 FAdjustClientRectRealized:=ARect; 6423 6424 ARect:=GetLogicalClientRect; 6425 AlignControls(AControl, ARect); 6426 // some widgetsets updates their clientrect when the first child was moved 6427 // do a second pass if ClientRect changed 6428 NewRect:=GetLogicalClientRect; 6429 if not CompareRect(@ARect,@NewRect) then 6430 AlignControls(AControl, NewRect); 6431 finally 6432 EnableAlign; 6433 end; 6434end; 6435 6436{------------------------------------------------------------------------------ 6437 Method: TWinControl.ContainsControl 6438 Params: Control: the control to be checked 6439 Returns: Self is a (super)parent of Control 6440 6441 Checks if Control is a child of Self 6442 ------------------------------------------------------------------------------} 6443function TWinControl.ContainsControl(Control: TControl): Boolean; 6444begin 6445 while (Control <> nil) and (Control <> Self) do Control := Control.Parent; 6446 Result := Control = Self; 6447end; 6448 6449{------------------------------------------------------------------------------ 6450 TWinControl GetBorderStyle 6451------------------------------------------------------------------------------} 6452function TWinControl.GetBorderStyle: TBorderStyle; 6453begin 6454 Result := TBorderStyle(FBorderStyle); 6455end; 6456 6457{------------------------------------------------------------------------------ 6458 TWinControl GetBrush 6459------------------------------------------------------------------------------} 6460function TWinControl.GetBrush: TBrush; 6461begin 6462 if not BrushCreated then 6463 CreateBrush; 6464 Result := FBrush; 6465end; 6466 6467{------------------------------------------------------------------------------ 6468 TWinControl GetControl 6469------------------------------------------------------------------------------} 6470function TWinControl.GetControl(const Index: Integer): TControl; 6471begin 6472 Result := TControl(FControls[Index]); 6473end; 6474 6475{------------------------------------------------------------------------------ 6476 TWinControl GetControlCount 6477------------------------------------------------------------------------------} 6478function TWinControl.GetControlCount: Integer; 6479begin 6480 if FControls <> nil then 6481 Result := FControls.Count 6482 else 6483 Result := 0; 6484end; 6485 6486function TWinControl.GetDockClientCount: Integer; 6487begin 6488 if FDockClients <> nil then 6489 Result := FDockClients.Count 6490 else 6491 Result := 0; 6492end; 6493 6494function TWinControl.GetDockClients(Index: Integer): TControl; 6495begin 6496 if FDockClients <> nil then 6497 Result := TControl(FDockClients[Index]) 6498 else 6499 Result := nil; 6500end; 6501 6502{------------------------------------------------------------------------------ 6503 TWinControl GetHandle 6504------------------------------------------------------------------------------} 6505function TWinControl.GetHandle: HWND; 6506begin 6507 //if not HandleAllocated then DebugLn('TWinControl.GetHandle Creating handle on the fly: ',DbgSName(Self)); 6508 HandleNeeded; 6509 Result := FHandle; 6510end; 6511 6512{------------------------------------------------------------------------------ 6513 TWinControl SetHandle 6514 Params: NewHandle 6515 Returns: Nothing 6516-------------------------------------------------------------------------------} 6517procedure TWinControl.SetHandle(NewHandle: HWND); 6518begin 6519 //if (NewHandle=0) and (AnsiCompareText(ClassName,'TPAGE')=0) then 6520 // RaiseGDBException('TWincontrol.SetHandle'); 6521 FHandle:=NewHandle; 6522 InvalidatePreferredSize; 6523end; 6524 6525procedure TWinControl.SetParentBackground(const AParentBackground: Boolean); 6526begin 6527 if ParentBackground = AParentBackground then 6528 Exit; 6529 6530 if AParentBackground then 6531 ControlStyle := ControlStyle + [csParentBackground] 6532 else 6533 ControlStyle := ControlStyle - [csParentBackground]; 6534 Invalidate; 6535end; 6536 6537procedure TWinControl.SetParentDoubleBuffered(Value: Boolean); 6538begin 6539 if FParentDoubleBuffered <> Value then 6540 begin 6541 FParentDoubleBuffered := Value; 6542 if Assigned(FParent) and not (csReading in ComponentState) then 6543 Perform(CM_PARENTDOUBLEBUFFEREDCHANGED, 0, 0); 6544 end; 6545end; 6546 6547{------------------------------------------------------------------------------ 6548 Method: TWinControl.Create 6549 Params: None 6550 Returns: Nothing 6551 6552 Constructor for the class. 6553 ------------------------------------------------------------------------------} 6554constructor TWinControl.Create(TheOwner : TComponent); 6555begin 6556 // do not set borderstyle, because TCustomForm needs to set it before calling 6557 // inherited, to have it set before handle is created via streaming 6558 // use property that bsNone is zero 6559 //FBorderStyle := bsNone; 6560 inherited Create(TheOwner); 6561 FParentDoubleBuffered := True; 6562 FCompStyle := csWinControl; 6563 FChildSizing:=TControlChildSizing.Create(Self); 6564 FChildSizing.OnChange:=@DoChildSizingChange; 6565 FBrush := nil; // Brush will be created on demand. Only few controls need it. 6566 FTabOrder := -1; 6567 FTabStop := False; 6568 InvalidateClientRectCache(false); 6569end; 6570 6571{------------------------------------------------------------------------------ 6572 TWinControl CreateParented 6573------------------------------------------------------------------------------} 6574constructor TWinControl.CreateParented(AParentWindow: HWND); 6575begin 6576 FParentWindow := AParentWindow; 6577 Create(nil); 6578end; 6579 6580{------------------------------------------------------------------------------ 6581 TWinControl CreateParentedControl 6582------------------------------------------------------------------------------} 6583class function TWinControl.CreateParentedControl(AParentWindow: HWND 6584 ): TWinControl; 6585begin 6586 Result := CreateParented(AParentWindow); 6587end; 6588 6589{------------------------------------------------------------------------------ 6590 Method: TWinControl.Destroy 6591 Params: None 6592 Returns: Nothing 6593 6594 Destructor for the class. 6595 ------------------------------------------------------------------------------} 6596destructor TWinControl.Destroy; 6597var 6598 n: Integer; 6599 Control: TControl; 6600begin 6601 //DebugLn('[TWinControl.Destroy] A ',Name,':',ClassName); 6602 // prevent parent to try to focus a to be destroyed control 6603 if Parent <> nil then 6604 RemoveFocus(true); 6605 if HandleAllocated then 6606 DestroyHandle; 6607 //DebugLn('[TWinControl.Destroy] B ',Name,':',ClassName); 6608 6609 //for n:=0 to ComponentCount-1 do 6610 // DebugLn(' n=',n,' ',Components[n].ClassName); 6611 6612 n := ControlCount; 6613 6614 while n > 0 do 6615 begin 6616 Control := Controls[n - 1]; 6617 //DebugLn('[TWinControl.Destroy] C ',Name,':',ClassName,' ',Control.Name,':',Control.ClassName); 6618 Remove(Control); // this sets Control.Parent to nil 6619 //DebugLn(['TWinControl.Destroy ',DbgSName(Control.HostDockSite)]); 6620 if Control.HostDockSite = Self then 6621 Control.HostDockSite := nil; 6622 // don't free the control, controls are freed by the owner 6623 n := ControlCount; 6624 end; 6625 6626 // undock controls that use this as HostDockSite 6627 while DockClientCount>0 do begin 6628 Control:=DockClients[DockClientCount-1]; 6629 //DebugLn(['TWinControl.Destroy ',DbgSName(Self),' undocking ',DbgSName(Control)]); 6630 Control.HostDockSite:=nil; 6631 end; 6632 6633 FreeAndNil(FAlignOrder); 6634 FreeThenNil(FBrush); 6635 FreeThenNil(FChildSizing); 6636 if (FDockManager<>nil) then 6637 if FDockManager.AutoFreeByControl then 6638 FreeThenNil(FDockManager) 6639 else 6640 FDockManager:=nil; 6641 FreeThenNil(FDockClients); 6642 FreeThenNil(FTabList); 6643 //DebugLn('[TWinControl.Destroy] D ',Name,':',ClassName); 6644 inherited Destroy; 6645 //DebugLn('[TWinControl.Destroy] END ',Name,':',ClassName); 6646end; 6647 6648{------------------------------------------------------------------------------ 6649 Method: TWinControl.DoEnter 6650 Params: none 6651 Returns: Nothing 6652 6653 Call user's callback for OnEnter. 6654 ------------------------------------------------------------------------------} 6655procedure TWinControl.DoEnter; 6656begin 6657 if Assigned(FOnEnter) then FOnEnter(Self); 6658end; 6659 6660{------------------------------------------------------------------------------ 6661 Method: TWinControl.DoExit 6662 Params: none 6663 Returns: Nothing 6664 6665 Call user's callback for OnExit. 6666 ------------------------------------------------------------------------------} 6667procedure TWinControl.DoExit; 6668begin 6669 if Assigned(FOnExit) then FOnExit(Self); 6670end; 6671 6672{------------------------------------------------------------------------------ 6673 procedure TWinControl.DoFlipChildren; 6674 6675 Flip children horizontally. That means mirroring the left position. 6676 ------------------------------------------------------------------------------} 6677procedure TWinControl.DoFlipChildren; 6678var 6679 i: Integer; 6680 CurControl: TControl; 6681 AWidth: Integer; 6682 SaveLeft: Integer; 6683begin 6684 AWidth:=GetLogicalClientRect.Right; 6685 DisableAlign; 6686 for i:=0 to ControlCount-1 do begin 6687 CurControl:=Controls[i]; 6688 // flip BorderSpacing 6689 SaveLeft := CurControl.BorderSpacing.Left; 6690 CurControl.BorderSpacing.Left := CurControl.BorderSpacing.Right; 6691 CurControl.BorderSpacing.Right := SaveLeft; 6692 // flip control and anchors 6693 CurControl.Left:=AWidth-CurControl.Left-CurControl.Width; 6694 CurControl.Anchors := BidiFlipAnchors(CurControl, True); 6695 end; 6696 EnableAlign; 6697end; 6698 6699{------------------------------------------------------------------------------ 6700 Method: TWinControl.CMEnabledChanged 6701 Params: Message 6702 Returns: Nothing 6703 6704 Called when enabled is changed. Takes action to enable control 6705 ------------------------------------------------------------------------------} 6706procedure TWinControl.CMEnabledChanged(var Message: TLMessage); 6707begin 6708 if not Enabled and (Parent <> nil) 6709 then RemoveFocus(False); 6710 6711 if HandleAllocated and not (csDesigning in ComponentState) then begin 6712 //if (not Enabled) then debugln('TWinControl.CMEnabledChanged disable ',Name,':',CLassName); 6713 EnableWindow(Handle, Enabled); 6714 end; 6715 inherited; 6716end; 6717 6718{------------------------------------------------------------------------------ 6719 Method: TWinControl.CMShowHintChanged 6720 Params: Message 6721 Returns: Nothing 6722 6723 Called when showhint is changed. Notifies children 6724 ------------------------------------------------------------------------------} 6725procedure TWinControl.CMShowHintChanged(var Message: TLMessage); 6726begin 6727 NotifyControls(CM_PARENTSHOWHINTCHANGED); 6728end; 6729 6730procedure TWinControl.CMBiDiModeChanged(var Message: TLMessage); 6731begin 6732 inherited CMBiDiModeChanged(Message); 6733 NotifyControls(CM_PARENTBIDIMODECHANGED); 6734 if HandleAllocated and (Message.wParam = 0) then 6735 TWSWinControlClass(WidgetSetClass).SetBiDiMode(Self, 6736 UseRightToLeftAlignment, UseRightToLeftReading, UseRightToLeftScrollBar); 6737 AdjustSize; 6738end; 6739 6740procedure TWinControl.CMBorderChanged(var Message: TLMessage); 6741begin 6742 DoAdjustClientRectChange; 6743 AdjustSize; 6744 Invalidate; 6745end; 6746 6747procedure TWinControl.CMDoubleBufferedChanged(var Message: TLMessage); 6748begin 6749 NotifyControls(CM_PARENTDOUBLEBUFFEREDCHANGED); 6750 Invalidate; 6751end; 6752 6753{------------------------------------------------------------------------------ 6754 Method: TWinControl.WMSetFocus 6755 Params: Message 6756 Returns: Nothing 6757 6758 SetFocus event handler 6759 ------------------------------------------------------------------------------} 6760procedure TWinControl.WMSetFocus(var Message: TLMSetFocus); 6761begin 6762 {$IFDEF VerboseFocus} 6763 DebugLn('TWinControl.WMSetFocus A ',Name,':',ClassName); 6764 {$ENDIF} 6765end; 6766 6767{------------------------------------------------------------------------------ 6768 Method: TWinControl.LMKillFocus 6769 Params: Msg: The message 6770 Returns: nothing 6771 6772 event handler. 6773 ------------------------------------------------------------------------------} 6774procedure TWinControl.WMKillFocus(var Message: TLMKillFocus); 6775var 6776 ParentForm: TCustomForm; 6777begin 6778 //DebugLn('TWinControl.WMKillFocus A ',Name,':',ClassName); 6779 //DebugLn(Format('Trace: %s', [ClassName])); 6780 if [csLoading,csDestroying,csDesigning]*ComponentState=[] then 6781 begin 6782 ParentForm := GetParentForm(Self); 6783 if Assigned(ParentForm) and ParentForm.Active then 6784 EditingDone; 6785 end; 6786end; 6787 6788{------------------------------------------------------------------------------ 6789 Method: TWinControl.WMPaint 6790 Params: Msg: The paint message 6791 Returns: nothing 6792 6793 Paint event handler. 6794 ------------------------------------------------------------------------------} 6795procedure TWinControl.WMPaint(var Msg: TLMPaint); 6796var 6797 DC,MemDC: HDC; 6798{$ifdef BUFFERED_WMPAINT} 6799 MemBitmap, OldBitmap : HBITMAP; 6800 MemWidth: Integer; 6801 MemHeight: Integer; 6802{$ENDIF} 6803 PS : TPaintStruct; 6804 ClientBoundRect: TRect; 6805begin 6806 //DebugLn('[TWinControl.WMPaint] ',DbgSName(Self),' ',DbgS(Msg.DC)); 6807 {$IFDEF VerboseResizeFlicker} 6808 DebugLn('[TWinControl.WMPaint] ',DbgSName(Self),' Bounds=',dbgs(BoundsRect),' ClientRect=',dbgs(ClientRect)); 6809 {$ENDIF} 6810 if ([csDestroying,csLoading]*ComponentState<>[]) or (not HandleAllocated) then 6811 exit; 6812 6813 {$IFDEF VerboseDsgnPaintMsg} 6814 if csDesigning in ComponentState then 6815 DebugLn('TWinControl.WMPaint A ',Name,':',ClassName); 6816 {$ENDIF} 6817 6818 //if Name='GroupBox1' then 6819 // debugln(['TWinControl.WMPaint ',DbgSName(Self),' DoubleBuffered=',DoubleBuffered,' Msg.DC=',dbgs(Msg.DC),' csCustomPaint=',csCustomPaint in ControlState,' ControlCount=',ControlCount,' ClientRect=',dbgs(ClientRect)]); 6820 if (Msg.DC <> 0) or not TWSWinControlClass(WidgetSetClass).GetDoubleBuffered(Self) then 6821 begin 6822 if not (csCustomPaint in ControlState) and (ControlCount = 0) then 6823 begin 6824 DefaultHandler(Msg); 6825 end 6826 else 6827 PaintHandler(Msg); 6828 end 6829 else begin 6830 // NOTE: not every interface uses this part 6831 //DebugLn('TWinControl.WMPaint Painting doublebuffered ',Name,':',classname); 6832{$ifdef BUFFERED_WMPAINT} 6833 DC := GetDC(0); 6834 MemWidth:=Width; 6835 MemHeight:=Height; 6836 MemBitmap := CreateCompatibleBitmap(DC, MemWidth, MemHeight); 6837 ReleaseDC(0, DC); 6838 MemDC := CreateCompatibleDC(0); 6839 OldBitmap := SelectObject(MemDC, MemBitmap); 6840{$ENDIF} 6841 try 6842 // Fetch a DC of the whole Handle (including client area) 6843 DC := BeginPaint(Handle, PS); 6844 if DC=0 then exit; 6845{$ifNdef BUFFERED_WMPAINT} 6846 MemDC := DC; 6847{$ENDIF} 6848 // erase background 6849 Include(FWinControlFlags,wcfEraseBackground); 6850 Perform(LM_ERASEBKGND, WParam(MemDC), 0); 6851 Exclude(FWinControlFlags,wcfEraseBackground); 6852 // create a paint message to paint the child controls. 6853 // WMPaint expects the DC origin to be equal to the client origin of its 6854 // parent 6855 // -> Move the DC Origin to the client origin 6856 if not GetClientBounds(Handle,ClientBoundRect) then exit; 6857 MoveWindowOrgEx(MemDC,ClientBoundRect.Left,ClientBoundRect.Top); 6858 // handle the paint message 6859 Msg.DC := MemDC; 6860 Perform(LM_PAINT, WParam(MemDC), 0); 6861 Msg.DC := 0; 6862 // restore the DC origin 6863 MoveWindowOrgEx(MemDC,-ClientBoundRect.Left,-ClientBoundRect.Top); 6864{$ifdef BUFFERED_WMPAINT} 6865 BitBlt(DC, 0,0, MemWidth, MemHeight, MemDC, 0, 0, SRCCOPY); 6866{$ENDIF} 6867 EndPaint(Handle, PS); 6868 finally 6869 Exclude(FWinControlFlags,wcfEraseBackground); 6870{$ifdef BUFFERED_WMPAINT} 6871 SelectObject(MemDC, OldBitmap); 6872 DeleteDC(MemDC); 6873 DeleteObject(MemBitmap); 6874{$ENDIF} 6875 end; 6876 end; 6877 //DebugLn(Format('Trace:< [TWinControl.WMPaint] %s', [ClassName])); 6878//DebugLn('[TWinControl.WMPaint] END ',Name,':',ClassName); 6879end; 6880 6881{------------------------------------------------------------------------------ 6882 Method: TWinControl.WMDestroy 6883 Params: Msg: The destroy message 6884 Returns: nothing 6885 6886 event handler. 6887 ------------------------------------------------------------------------------} 6888procedure TWinControl.WMDestroy(var Message: TLMDestroy); 6889begin 6890 //DebugLn(Format('Trace: [TWinControl.LMDestroy] %s', [ClassName])); 6891 //DebugLn('TWinControl.WMDestroy ',Name,':',ClassName); 6892 // Our widget/window doesn't exist anymore 6893 Handle := 0; 6894end; 6895 6896{------------------------------------------------------------------------------ 6897 Method: TWinControl.WMMove 6898 Params: Msg: The message 6899 Returns: nothing 6900 6901 event handler. 6902 ------------------------------------------------------------------------------} 6903procedure TWinControl.WMMove(var Message: TLMMove); 6904var 6905 NewWidth, NewHeight: Integer; 6906 NewBoundsRealized: TRect; 6907 TopParent: TControl; 6908 6909 procedure RaiseLoop; 6910 begin 6911 raise Exception.Create('TWinControl.WMMove loop detected: '+DbgSName(Self)+' BoundsRealized='+dbgs(FBoundsRealized)+' NewBoundsRealized='+dbgs(NewBoundsRealized)); 6912 end; 6913 6914begin 6915 {$IF defined (VerboseSizeMsg) or defined(VerboseIntfSizing)} 6916 if (Message.MoveType and Move_SourceIsInterface)>0 then 6917 DebugLn(['TWinControl.WMMove A ',DbgSName(Self),' Message=',Message.XPos,',',Message.YPos, 6918 ' BoundsRealized=',FBoundsRealized.Left,',',FBoundsRealized.Top, 6919 ' FromIntf=',Message.MoveType=Move_SourceIsInterface, 6920 ',',FBoundsRealized.Right-FBoundsRealized.Left, 6921 'x',FBoundsRealized.Bottom-FBoundsRealized.Top]); 6922 {$ENDIF} 6923 NewWidth := Width; 6924 NewHeight := Height; 6925 if (Message.MoveType and Move_SourceIsInterface)>0 then 6926 begin 6927 if not (wcfBoundsRealized in FWinControlFlags) then exit; 6928 // interface widget has moved 6929 // -> update size and realized bounds 6930 NewWidth := FBoundsRealized.Right - FBoundsRealized.Left; 6931 NewHeight := FBoundsRealized.Bottom - FBoundsRealized.Top; 6932 // skip size update when window is minimized 6933 if HandleAllocated and (not IsIconic(Handle)) then 6934 GetWindowSize(Handle, NewWidth, NewHeight); 6935 6936 NewBoundsRealized:=Bounds(Message.XPos, Message.YPos, NewWidth, NewHeight); 6937 if CompareRect(@NewBoundsRealized,@FBoundsRealized) then exit; 6938 6939 TopParent:=GetTopParent; 6940 if (TopParent is TWinControl) 6941 and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags) then 6942 RaiseLoop; 6943 6944 FBoundsRealized := NewBoundsRealized; 6945 if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[]) then 6946 begin 6947 // while the LCL is creating handles the widgetset may send default bounds 6948 // we have not yet told the widgetset the final bounds 6949 // => the InvalidatePreferredSize and the InvalidateClientRectCache 6950 // (invoked by the widgetset) may trigger a further loop in the auto 6951 // size algorithm to take care of the new bounds 6952 // => do not call SetBounds, as this will set the Bounds to the widgetset 6953 // default values. 6954 //DebugLn(['TWinControl.WMMove from intf ignored, because phases=',dbgs(AutoSizePhases),' boundsrealized=',wcfBoundsRealized in FWinControlFlags]); 6955 exit; 6956 end; 6957 end; 6958 SetBounds(Message.XPos, Message.YPos, NewWidth, NewHeight); 6959end; 6960 6961{------------------------------------------------------------------------------ 6962 Method: TWinControl.WMSize 6963 Params: Message: TLMSize 6964 Returns: nothing 6965 6966 Event handler for size messages. This is called, whenever width, height, 6967 clientwidth or clientheight have changed. 6968 If the source of the message is the interface, the new size is stored 6969 in FBoundsRealized to avoid sending a size message back to the interface. 6970 ------------------------------------------------------------------------------} 6971procedure TWinControl.WMSize(var Message: TLMSize); 6972var 6973 NewLeft, NewTop: integer; 6974 NewBoundsRealized: TRect; 6975 TopParent: TControl; 6976 OldClientSize: TSize; 6977 NewClientSize: TSize; 6978 6979 procedure RaiseLoop; 6980 var 6981 s: String; 6982 begin 6983 s:='TWinControl.WMSize loop detected, the widgetset does not like the LCL bounds or sends unneeded wmsize messages: '+DbgSName(Self)+' BoundsRealized='+dbgs(FBoundsRealized)+' NewBoundsRealized='+dbgs(NewBoundsRealized); 6984 if (OldClientSize.cx<>NewClientSize.cx) 6985 or (OldClientSize.cy<>NewClientSize.cy) 6986 then 6987 s:=s+' OldClientSize='+dbgs(OldClientSize)+' NewClientSize='+dbgs(NewClientSize); 6988 raise Exception.Create(s); 6989 end; 6990 6991begin 6992 {$IF defined(VerboseSizeMsg) or defined(CHECK_POSITION) or defined(VerboseIntfSizing)} 6993 {$IFDEF CHECK_POSITION} 6994 if CheckPosition(Self) then 6995 {$ENDIF} 6996 if (Message.SizeType and Size_SourceIsInterface) > 0 then 6997 DebugLn(['TWinControl.WMSize A ',Name,':',ClassName,' Message=',Message.Width,',',Message.Height, 6998 ' BoundsRealized=',dbgs(FBoundsRealized), 6999 ' WChg=',FBoundsRealized.Right-FBoundsRealized.Left<>Message.Width, 7000 ' HChg=',FBoundsRealized.Bottom-FBoundsRealized.Top<>Message.Height, 7001 ' FromIntf=',(Message.SizeType and Size_SourceIsInterface)>0,' ClientRectInvalid=',ClientRectNeedsInterfaceUpdate]); 7002 {$ENDIF} 7003 7004 NewLeft := Left; 7005 NewTop := Top; 7006 if ((Message.SizeType and Size_SourceIsInterface) > 0) then 7007 begin 7008 // interface widget has resized 7009 // -> update realized position and realized bounds 7010 {$IFDEF VerboseAllAutoSize} 7011 DebugLn(['TWinControl.WMSize FromIntf ',dbgsname(Self),' Message=',Message.Width,',',Message.Height, 7012 ' BoundsRealized=',dbgs(FBoundsRealized), 7013 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]); 7014 {$ENDIF} 7015 if not (wcfBoundsRealized in FWinControlFlags) then exit; 7016 {$IFDEF VerboseClientRectBugFix} 7017 //if Name=CheckClientRectName then 7018 DebugLn(['TWinControl.WMSize FromIntf ',dbgsname(Self),' Message=',Message.Width,',',Message.Height, 7019 ' BoundsRealized=',dbgs(FBoundsRealized), 7020 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]); 7021 {$ENDIF} 7022 7023 //if CheckPosition(Self) then 7024 //DebugLn(['TWinControl.WMSize GetWindowRelativePosition: ',DbgSName(Self),' ',NewLeft,',',NewTop,' ClientRectNeedsInterfaceUpdate=',ClientRectNeedsInterfaceUpdate]); 7025 NewBoundsRealized := Bounds(NewLeft, NewTop, Message.Width, Message.Height); 7026 OldClientSize := Size(0, 0); 7027 NewClientSize := Size(0, 0); 7028 if CompareRect(@NewBoundsRealized, @FBoundsRealized) then 7029 begin 7030 if not (wcfClientRectNeedsUpdate in FWinControlFlags) then 7031 begin 7032 OldClientSize := Size(FClientWidth, FClientHeight); 7033 NewClientSize := Size(ClientWidth, ClientHeight); 7034 if (OldClientSize.cx = NewClientSize.cx) and 7035 (OldClientSize.cy = NewClientSize.cy) then 7036 Exit; 7037 end; 7038 end; 7039 {$IFDEF VerboseAllAutoSize} 7040 {$IFDEF CHECK_POSITION} 7041 if CheckPosition(Self) then 7042 {$ENDIF} 7043 DebugLn(['TWinControl.WMSize Changed From Intf ',dbgsname(Self),' Message=',Message.Width,',',Message.Height, 7044 ' BoundsRealized=',dbgs(FBoundsRealized), 7045 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags, 7046 ' ClientRectNeedsInterfaceUpdate=',ClientRectNeedsInterfaceUpdate]); 7047 {$ENDIF} 7048 7049 TopParent := GetTopParent; 7050 if (TopParent is TWinControl) and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags) then 7051 RaiseLoop; 7052 7053 FBoundsRealized := NewBoundsRealized; 7054 //DebugLn(['TWinControl.WMSize ',DbgSName(Self),' phases=',dbgs(AutoSizePhases)]); 7055 if ([caspCreatingHandles, caspComputingBounds] * AutoSizePhases <> []) then 7056 begin 7057 // while the LCL is creating handles the widgetset may send default bounds 7058 // we have not yet told the widgetset the final bounds 7059 // => the InvalidatePreferredSize and the InvalidateClientRectCache 7060 // (invoked by the widgetset) may trigger a further loop in the auto 7061 // size algorithm to take care of the new bounds 7062 // => do not call SetBounds, as this will set the Bounds to the widgetset 7063 // default values. 7064 {$IFDEF CHECK_POSITION} 7065 if CheckPosition(Self) then 7066 {$ENDIF} 7067 // DebugLn(['TWinControl.WMSize from intf ignored, because phases=',dbgs(AutoSizePhases),' boundsrealized=',wcfBoundsRealized in FWinControlFlags]); 7068 Exit; 7069 end; 7070 7071 if Assigned(Parent) then 7072 InvalidatePreferredSize; 7073 end; 7074 7075 if Assigned(Parent) and not (Self is TCustomForm) then 7076 SetBoundsKeepBase(NewLeft, NewTop, Message.Width, Message.Height) 7077 else 7078 SetBounds(NewLeft, NewTop, Message.Width, Message.Height); 7079 //if CheckPosition(Self) then 7080 //debugln(['TWinControl.WMSize ',DbgSName(Self),' ClientRectNeedsInterfaceUpdate=',ClientRectNeedsInterfaceUpdate]); 7081 if ((Message.SizeType and Size_SourceIsInterface) > 0) and ((Message.SizeType and SIZE_MINIMIZED) = 0) 7082 and ClientRectNeedsInterfaceUpdate then 7083 DoAdjustClientRectChange; 7084 {$IFDEF VerboseClientRectBugFix} 7085 {$IFDEF CHECK_POSITION} 7086 if CheckPosition(Self) then 7087 {$ENDIF} 7088 if ((Message.SizeType and Size_SourceIsInterface) > 0) then 7089 DebugLn(['TWinControl.WMSize END ',dbgsname(Self),' Message=',Message.Width,',',Message.Height, 7090 ' BoundsRealized=',dbgs(FBoundsRealized),' ClientRect=',dbgs(ClientRect), 7091 ' ']); 7092 {$ENDIF} 7093end; 7094 7095{------------------------------------------------------------------------------ 7096 Method: TWinControl.WMWindowPosChanged 7097 Params: Message: TLMWindowPosChanged 7098 Returns: nothing 7099 7100 Event handler for size/move messages. This is called, whenever left, top, 7101 width, height, clientwidth or clientheight have changed. 7102 If the source of the message is the interface, the new size is stored 7103 in FBoundsRealized to avoid sending a SetBounds back to the interface. 7104 ------------------------------------------------------------------------------} 7105procedure TWinControl.WMWindowPosChanged(var Message: TLMWindowPosChanged); 7106var 7107 NewLeft, NewTop, NewWidth, NewHeight: integer; 7108 NewBoundsRealized: TRect; 7109 TopParent: TControl; 7110 7111 procedure RaiseLoop; 7112 begin 7113 raise Exception.Create('TWinControl.WMWindowPosChanged loop detected: '+DbgSName(Self)+' BoundsRealized='+dbgs(FBoundsRealized)+' NewBoundsRealized='+dbgs(NewBoundsRealized)); 7114 end; 7115 7116begin 7117 if not Assigned(Message.WindowPos) or 7118 ((Message.WindowPos^.flags and SWP_SourceIsInterface) = 0) then 7119 begin 7120 inherited WMWindowPosChanged(Message); 7121 Exit; 7122 end; 7123 7124 {$IFDEF VerboseAllAutoSize} 7125 DebugLn(DbgSName(Self) + ' : ' + DbgSWindowPosFlags(Message.WindowPos^.flags)); 7126 {$ENDIF} 7127 7128 NewLeft := Message.WindowPos^.x; 7129 NewTop := Message.WindowPos^.y; 7130 NewWidth := Message.WindowPos^.cx; 7131 NewHeight := Message.WindowPos^.cy; 7132 7133 {$IF defined(VerboseSizeMsg) or defined(CHECK_POSITION) or defined(VerboseIntfSizing)} 7134 {$IFDEF CHECK_POSITION} 7135 if CheckPosition(Self) then 7136 {$ENDIF} 7137 DebugLn(['TWinControl.WMWindowPosChanged START ',DbgSName(Self),' Message=',NewLeft,',',NewTop,',',NewWidth,'x',NewHeight, 7138 ' BoundsRealized=',dbgs(FBoundsRealized),' FromIntf=',(Message.WindowPos^.flags and SWP_SourceIsInterface)>0,' ClientRectInvalid=',ClientRectNeedsInterfaceUpdate]); 7139 {$ENDIF} 7140 7141 // interface widget has moved/resized 7142 // -> update realized bounds 7143 {$IFDEF VerboseAllAutoSize} 7144 DebugLn(['TWinControl.WMWindowPosChanged FROM INTF ',dbgsname(Self),' Message=',NewLeft,',',NewTop,',',NewWidth,'x',NewHeight, 7145 ' BoundsRealized=',dbgs(FBoundsRealized), 7146 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]); 7147 {$ENDIF} 7148 //DebugLn('TWinControl.WMSize B ',Name,':',ClassName,' ',NewLeft,',',NewTop); 7149 NewBoundsRealized := Bounds(NewLeft, NewTop, NewWidth, NewHeight); 7150 if CompareRect(@NewBoundsRealized,@FBoundsRealized) 7151 and (not (wcfClientRectNeedsUpdate in FWinControlFlags)) then 7152 exit; 7153 7154 {$IFDEF VerboseAllAutoSize} 7155 DebugLn(['TWinControl.WMWindowPosChanged CHANGED BY INTF ',dbgsname(Self),' Message=',NewLeft,',',NewTop,',',NewWidth,'x',NewHeight, 7156 ' BoundsRealized=',dbgs(FBoundsRealized), 7157 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]); 7158 {$ENDIF} 7159 7160 TopParent:=GetTopParent; 7161 if (TopParent is TWinControl) 7162 and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags) 7163 then 7164 RaiseLoop; 7165 7166 FBoundsRealized := NewBoundsRealized; 7167 //DebugLn(['TWinControl.WMSize ',DbgSName(Self),' phases=',dbgs(AutoSizePhases)]); 7168 if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[]) 7169 or (not (wcfBoundsRealized in FWinControlFlags)) 7170 then begin 7171 // while the LCL is creating handles the widgetset may send default bounds 7172 // we have not yet told the widgetset the final bounds 7173 // => the InvalidatePreferredSize and the InvalidateClientRectCache 7174 // (invoked by the widgetset) may trigger a further loop in the auto 7175 // size algorithm to take care of the new bounds 7176 // => do not call SetBounds, as this will set the Bounds to the widgetset 7177 // default values. 7178 //DebugLn(['TWinControl.WMSize from intf ignored, because phases=',dbgs(AutoSizePhases),' boundsrealized=',wcfBoundsRealized in FWinControlFlags]); 7179 exit; 7180 end; 7181 7182 if Parent<>nil then 7183 InvalidatePreferredSize; 7184 7185 if Parent<>nil then 7186 SetBoundsKeepBase(NewLeft, NewTop, NewWidth, NewHeight) 7187 else 7188 SetBounds(NewLeft, NewTop, NewWidth, NewHeight); 7189 if ((Message.WindowPos^.flags and SWP_SourceIsInterface) > 0) 7190 and ClientRectNeedsInterfaceUpdate then 7191 DoAdjustClientRectChange; 7192end; 7193 7194{------------------------------------------------------------------------------ 7195 Method: TWinControl.CNKeyDown 7196 Params: Msg: The message 7197 Returns: nothing 7198 7199 event handler. 7200 ------------------------------------------------------------------------------} 7201procedure TWinControl.CNKeyDown(var Message: TLMKeyDown); 7202begin 7203 //DebugLn('TWinControl.CNKeyDown ',Name,':',ClassName); 7204 if DoKeyDownBeforeInterface(Message, False) then 7205 Message.Result := 1 7206 else 7207 {inherited}; // there is nothing to inherit 7208end; 7209 7210{------------------------------------------------------------------------------ 7211 procedure TWinControl.CNSysKeyDown(var Message: TLMKeyDown); 7212 ------------------------------------------------------------------------------} 7213procedure TWinControl.CNSysKeyDown(var Message: TLMKeyDown); 7214begin 7215 if DoKeyDownBeforeInterface(Message, False) then 7216 Message.Result := 1 7217 else 7218 {inherited}; // there is nothing to inherit 7219end; 7220 7221{------------------------------------------------------------------------------ 7222 procedure TWinControl.CNSysKeyUp(var Message: TLMKeyUp); 7223 ------------------------------------------------------------------------------} 7224procedure TWinControl.CNSysKeyUp(var Message: TLMKeyUp); 7225begin 7226 if DoKeyUpBeforeInterface(Message) then 7227 Message.Result := 1 7228 else 7229 {inherited}; // there is nothing to inherit 7230end; 7231 7232{------------------------------------------------------------------------------ 7233 Method: TWinControl.CNKeyUp 7234 Params: Msg: The message 7235 Returns: nothing 7236 7237 event handler. 7238 ------------------------------------------------------------------------------} 7239procedure TWinControl.CNKeyUp(var Message: TLMKeyUp); 7240begin 7241 if DoKeyUpBeforeInterface(Message) then 7242 Message.Result := 1 7243 else 7244 {inherited}; // there is nothing to inherit 7245end; 7246 7247{------------------------------------------------------------------------------ 7248 Method: TWinControl.CNChar 7249 Params: Msg: The message 7250 Returns: nothing 7251 7252 event handler. 7253 CNChar is sent by the interface before it has handled the keypress itself. 7254 ------------------------------------------------------------------------------} 7255procedure TWinControl.CNChar(var Message: TLMKeyUp); 7256var 7257 c: TUTF8Char; 7258begin 7259 //debugln('TWinControl.CNChar B ',DbgSName(Self),' ',dbgs(Message.CharCode),' ',dbgs(IntfSendsUTF8KeyPress)); 7260 if Widgetset.GetLCLCapability(lcSendsUTF8KeyPress) = LCL_CAPABILITY_NO then 7261 begin 7262 // current interface does not (yet) send UTF8 key press notifications 7263 // -> emulate 7264 if (Message.CharCode < %11000000) then 7265 begin 7266 c:=chr(Message.CharCode); 7267 IntfUTF8KeyPress(c,1,false); 7268 if (length(c)<>1) or (c[1]<>chr(Message.CharCode)) then 7269 begin 7270 // character changed 7271 if length(c)=1 then 7272 Message.CharCode:=ord(c[1]) 7273 else 7274 Message.CharCode:=0; 7275 end; 7276 end; 7277 if Message.CharCode=0 then 7278 begin 7279 Message.Result := 1; 7280 exit; 7281 end; 7282 end; 7283 7284 {$ifdef VerboseKeyboard} 7285 debugln('TWinControl.CNChar A ',DbgSName(Self),' ',dbgs(Message.CharCode),' ',dbgs(IntfSendsUTF8KeyPress)); 7286 {$endif} 7287 7288 if DoKeyPress(Message) then 7289 Message.Result := 1 7290 else 7291 {inherited}; // there is nothing to inherit 7292end; 7293 7294procedure TWinControl.WMSysChar(var Message: TLMKeyUp); 7295begin 7296 if SendDialogChar(Message) then 7297 Message.Result := 1 7298 else 7299 {inherited}; // there is nothing to inherit 7300end; 7301 7302{------------------------------------------------------------------------------ 7303 Method: TWinControl.WMNofity 7304 Params: Msg: The message 7305 Returns: nothing 7306 7307 event handler. 7308 ------------------------------------------------------------------------------} 7309procedure TWinControl.WMNotify(var Message: TLMNotify); 7310begin 7311 if not DoControlMsg(Message.NMHdr^.hwndfrom, Message) then 7312 inherited; 7313end; 7314 7315{------------------------------------------------------------------------------ 7316 Method: TWinControl.WMShowWindow 7317 Params: Msg: The message 7318 Returns: nothing 7319 7320 event handler. 7321 ------------------------------------------------------------------------------} 7322procedure TWinControl.WMShowWindow(var Message: TLMShowWindow); 7323begin 7324 // DebugLn(['TWinControl.LMShowWindow ', dbgsName(self)]); 7325end; 7326 7327{------------------------------------------------------------------------------ 7328 Method: TWinControl.WMEnter 7329 Params: Msg: The message 7330 Returns: nothing 7331 7332 event handler. 7333 ------------------------------------------------------------------------------} 7334procedure TWinControl.WMEnter(var Message: TLMEnter); 7335begin 7336 //DebugLn(Format('Trace: TODO: [TWinControl.LMEnter] %s', [ClassName])); 7337end; 7338 7339{------------------------------------------------------------------------------ 7340 Method: TWinControl.WMEraseBkgnd 7341 Params: Msg: The message 7342 Returns: nothing 7343 7344 event handler. 7345 ------------------------------------------------------------------------------} 7346procedure TWinControl.WMEraseBkgnd(var Message: TLMEraseBkgnd); 7347begin 7348 if (Message.DC <> 0) and (wcfEraseBackground in FWinControlFlags) then 7349 begin 7350 EraseBackground(Message.DC); 7351 Message.Result := 1; 7352 end; 7353end; 7354 7355{------------------------------------------------------------------------------ 7356 Method: TWinControl.WMExit 7357 Params: Msg: The message 7358 Returns: nothing 7359 7360 event handler. 7361 ------------------------------------------------------------------------------} 7362procedure TWinControl.WMExit(var Message: TLMExit); 7363begin 7364 //DebugLn(Format('Trace: TODO: [TWinControl.LMExit] %s', [ClassName])); 7365end; 7366 7367{------------------------------------------------------------------------------ 7368 Method: TWinControl.WMChar 7369 Params: Msg: The message 7370 Returns: nothing 7371 7372 event handler. 7373 WMChar is sent by the interface after it has handled the keypress by itself. 7374 ------------------------------------------------------------------------------} 7375procedure TWinControl.WMChar(var Message: TLMChar); 7376begin 7377 //debugln('TWinControl.WMChar ',DbgSName(Self),' ',dbgs(Message.CharCode)); 7378 if SendDialogChar(Message) then 7379 Message.Result := 1; 7380 //DebugLn(Format('Trace:[TWinControl.WMChar] %s', [ClassName])); 7381end; 7382 7383{------------------------------------------------------------------------------ 7384 Method: TWinControl.WMKeyDown 7385 Params: Msg: The message 7386 Returns: nothing 7387 7388 Event handler for keys not handled by the interface 7389 ------------------------------------------------------------------------------} 7390procedure TWinControl.WMKeyDown(var Message: TLMKeyDown); 7391begin 7392 if DoRemainingKeyDown(Message) then 7393 Message.Result := 1; 7394end; 7395 7396procedure TWinControl.WMSysKeyDown(var Message: TLMKeyDown); 7397begin 7398 if DoRemainingKeyDown(Message) then 7399 Message.Result := 1; 7400end; 7401 7402{------------------------------------------------------------------------------ 7403 procedure TWinControl.WMSysKeyUp(var Message: TLMKeyUp); 7404 ------------------------------------------------------------------------------} 7405procedure TWinControl.WMSysKeyUp(var Message: TLMKeyUp); 7406begin 7407 //debugln('TWinControl.WMSysKeyUp ',DbgSName(Self)); 7408 if DoRemainingKeyUp(Message) then 7409 Message.Result := 1; 7410end; 7411 7412{------------------------------------------------------------------------------ 7413 Method: TWinControl.WMKeyUp 7414 Params: Msg: The message 7415 Returns: nothing 7416 7417 event handler. 7418 ------------------------------------------------------------------------------} 7419procedure TWinControl.WMKeyUp(var Message: TLMKeyUp); 7420begin 7421 //debugln('TWinControl.WMKeyUp ',DbgSName(Self)); 7422 if DoRemainingKeyUp(Message) then 7423 Message.Result := 1; 7424end; 7425 7426{------------------------------------------------------------------------------ 7427 function: TWinControl.HandleAllocated 7428 Params: None 7429 Returns: True is handle is allocated 7430 7431 Checks if a handle is allocated. I.E. if the control is mapped 7432 ------------------------------------------------------------------------------} 7433function TWinControl.HandleAllocated : Boolean; 7434begin 7435 HandleAllocated := (FHandle <> 0); 7436end; 7437 7438{------------------------------------------------------------------------------ 7439 Method: TWinControl.CreateHandle 7440 Params: None 7441 Returns: Nothing 7442 7443 Creates the handle ( = object) if not already done. 7444 ------------------------------------------------------------------------------} 7445procedure TWinControl.CreateHandle; 7446begin 7447 if (not HandleAllocated) then CreateWnd; 7448end; 7449 7450{------------------------------------------------------------------------------ 7451 Method: TWinControl.CreateWnd 7452 Params: None 7453 Returns: Nothing 7454 7455 Creates the interface object and assigns the handle 7456 ------------------------------------------------------------------------------} 7457procedure TWinControl.CreateWnd; 7458var 7459 Params: TCreateParams; 7460 i: Integer; 7461 AWinControl: TWinControl; 7462 7463{ procedure WriteClientRect(const Prefix: string); 7464 var r: TRect; 7465 begin 7466 LCLIntf.GetClientRect(Handle,r); 7467 if csDesigning in ComponentState then 7468 DebugLn('WriteClientRect ',Prefix,' ',Name,':',ClassName,' r=',r.Right,',',r.Bottom); 7469 end;} 7470 7471begin 7472 //DebugLn('[TWinControl.CreateWnd] START ',DbgSName(Self)); 7473 if (csDestroying in ComponentState) or Assigned(Parent) and (csDestroying in Parent.ComponentState) then 7474 begin 7475 DebugLn('[TWinControl.CreateWnd] NOTE: csDestroying ',DbgSName(Self)); 7476 RaiseGDBException(''); 7477 exit; 7478 end; 7479 7480 if wcfInitializing in FWinControlFlags then 7481 begin 7482 DebugLn('[WARNING] Recursive call to CreateWnd for ',DbgSName(Self), ' while initializing'); 7483 RaiseGDBException(''); 7484 Exit; 7485 end; 7486 7487 if wcfCreatingHandle in FWinControlFlags then 7488 begin 7489 DebugLn('[WARNING] Recursive call to CreateWnd for ',DbgSName(Self), ' while creating handle'); 7490 RaiseGDBException(''); 7491 Exit; 7492 end; 7493 7494 if wcfCreatingChildHandles in FWinControlFlags then 7495 begin 7496 DebugLn('[WARNING] Recursive call to CreateWnd for ',DbgSName(Self), ' while creating children'); 7497 RaiseGDBException(''); 7498 Exit; 7499 end; 7500 7501 if [csLoading,csDesigning]*ComponentState=[csLoading] then 7502 begin 7503 DebugLn('[HINT] TWinControl.CreateWnd creating Handle during loading ',DbgSName(Self),' csDesigning=',dbgs(csDesigning in ComponentState)); 7504 //DumpStack; 7505 //RaiseGDBException(''); 7506 end; 7507 7508 FBoundsRealized := Rect(0,0,0,0); 7509 Exclude(FWinControlFlags, wcfBoundsRealized); 7510 7511 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.CreateWnd'){$ENDIF}; 7512 try 7513 if Assigned(Parent) and not Parent.HandleAllocated then 7514 begin 7515 // first create the parent handle 7516 Parent.HandleNeeded; 7517 if HandleAllocated then exit; 7518 DebugLn(['WARNING: TWinControl.CreateWnd: parent created handles, but not ours']); 7519 end; 7520 // Control is not visible at this moment. It will be shown in UpdateShowing 7521 FShowing := False; 7522 Exclude(FWinControlFlags, wcfHandleVisible); 7523 7524 Include(FWinControlFlags, wcfCreatingHandle); 7525 try 7526 CreateParams(Params); 7527 with Params do 7528 begin 7529 if (WndParent = 0) and (Style and WS_CHILD <> 0) then 7530 begin 7531 DebugLn(['TWinControl.CreateWnd ',DbgSName(Self),' Parent=',DbgSName(Parent),' ERROR WndParent=0']); 7532 raise EInvalidOperation.CreateFmt(rsControlHasNoParentWindow, [Name]); 7533 end; 7534 end; 7535 7536 //DebugLn(['TWinControl.CreateWnd Creating handle ... ',DbgSName(WidgetSetClass),' ',DbgSName(Self)]); 7537 FHandle := TWSWinControlClass(WidgetSetClass).CreateHandle(Self, Params); 7538 if not HandleAllocated then 7539 begin 7540 if WidgetSet.LCLPlatform=lpNoGUI then 7541 RaiseGDBException('TWinControl.CreateWnd: The nogui widgetset does not support visual controls.') 7542 else 7543 RaiseGDBException('TWinControl.CreateWnd: Handle creation failed creating '+DbgSName(Self)); 7544 end; 7545 //debugln('TWinControl.CreateWnd update constraints ... ',DbgSName(Self)); 7546 TWSWinControlClass(WidgetSetClass).SetBiDiMode(Self, 7547 UseRightToLeftAlignment, UseRightToLeftReading, UseRightToLeftScrollBar); 7548 7549 Constraints.UpdateInterfaceConstraints; 7550 InvalidateClientRectCache(False); 7551 TWSWinControlClass(WidgetSetClass).ConstraintsChange(Self); 7552 7553 //WriteClientRect('A'); 7554 if Assigned(Parent) and (Params.Style and WS_POPUP = 0) then 7555 AddControl 7556 else 7557 if ParentWindow <> 0 then 7558 LCLIntf.SetParent(FHandle, ParentWindow); 7559 //WriteClientRect('B'); 7560 7561 Include(FWinControlFlags, wcfInitializing); 7562 //DebugLn(['TWinControl.CreateWnd initializing window ...']); 7563 InitializeWnd; 7564 7565 finally 7566 Exclude(FWinControlFlags, wcfInitializing); 7567 Exclude(FWinControlFlags, wcfCreatingHandle); 7568 end; 7569 7570 Include(FWinControlFlags, wcfCreatingChildHandles); 7571 try 7572 //DebugLn('[TWinControl.CreateWnd] ',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height); 7573 //WriteClientRect('C'); 7574 7575 if FControls <> nil then 7576 begin 7577 for i := 0 to FControls.Count - 1 do 7578 begin 7579 AWinControl := TWinControl(FControls.Items[i]); 7580 //DebugLn(['TWinControl.CreateWnd create child handles self=',DbgSName(Self),' Child=',DbgSName(AWinControl)]); 7581 if (AWinControl is TWinControl) and AWinControl.IsControlVisible then 7582 AWinControl.HandleNeeded; 7583 end; 7584 end; 7585 7586 ChildHandlesCreated; 7587 finally 7588 Exclude(FWinControlFlags, wcfCreatingChildHandles); 7589 end; 7590 7591 InvalidatePreferredSize; 7592 if Assigned(FControls) then 7593 for i := 0 to FControls.Count - 1 do 7594 TControl(FControls[i]).InvalidatePreferredSize; 7595 // size this control 7596 AdjustSize; 7597 finally 7598 //DebugLn(['TWinControl.CreateWnd created ',DbgSName(Self),' enable autosizing ...']); 7599 (* If an error occured and FHandle was not created, 7600 then EnableAutoSizing must not be called. 7601 EnableAutoSizing will need the Handle, and trigger another attempt to create it. 7602 This leads to an endless loop/recursion. 7603 As a side effect the current control will be left in autosize-disabled *) 7604 if FHandle <> 0 then 7605 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.CreateWnd'){$ENDIF}; 7606 end; 7607 7608 //DebugLn('[TWinControl.CreateWnd] END ',Name,':',Classname); 7609 //WriteClientRect('D'); 7610end; 7611 7612{------------------------------------------------------------------------------ 7613 Method: TWinControl.InitializeWnd 7614 Params: none 7615 Returns: Nothing 7616 7617 Gets called after the window is created, but before the child controls are 7618 created. Place cached property code here. 7619 ------------------------------------------------------------------------------} 7620procedure TWinControl.InitializeWnd; 7621var 7622 CachedText: string; 7623begin 7624 //DebugLn(Format('Trace:[TWinControl.InitializeWnd] %s', [ClassName])); 7625 // set all cached properties 7626 7627 //DebugLn('[TWinControl.InitializeWnd] ',Name,':',ClassName,':', FCaption,' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height)); 7628 7629 // First set the WinControl property some interfaces depends on it 7630 SetProp(Handle,'WinControl',TWinControl(Self)); 7631 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.InitializeWnd'){$ENDIF}; 7632 try 7633 {$IFDEF CHECK_POSITION} 7634 if CheckPosition(Self) then 7635 DebugLn('[TWinControl.InitializeWnd] A ',DbgSName(Self), 7636 ' OldRelBounds=',dbgs(FBoundsRealized), 7637 ' -> NewBounds=',dbgs(BoundsRect)); 7638 {$ENDIF} 7639 7640 if wcfColorChanged in FWinControlFlags then 7641 begin 7642 // replace by update style call 7643 TWSWinControlClass(WidgetSetClass).SetColor(Self); 7644 Exclude(FWinControlFlags, wcfColorChanged); 7645 end; 7646 if wcfFontChanged in FWinControlFlags then 7647 begin 7648 // replace by update style call 7649 TWSWinControlClass(WidgetSetClass).SetFont(Self,Font); 7650 Exclude(FWinControlFlags, wcfFontChanged); 7651 end; 7652 7653 if not (csDesigning in ComponentState) then 7654 EnableWindow(Handle, Enabled); 7655 7656 // Delay the setting of text until it is completely loaded 7657 if not (csLoading in ComponentState) then 7658 begin 7659 if GetCachedText(CachedText) then 7660 WSSetText(CachedText); 7661 InvalidatePreferredSize; 7662 end; 7663 7664 if csDesigning in ComponentState then 7665 TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[crDefault]) 7666 else 7667 TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[Cursor]); 7668 finally 7669 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.InitializeWnd'){$ENDIF}; 7670 end; 7671 // send pending OnResize 7672 {$IFDEF VerboseOnResize} 7673 debugln(['TWinControl.InitializeWnd ',DbgSName(Self),' calling Resize ...']); 7674 {$ENDIF} 7675 Resize; 7676end; 7677 7678procedure TWinControl.FinalizeWnd; 7679var 7680 S: string; 7681begin 7682 if not HandleAllocated then 7683 RaiseGDBException('TWinControl.FinalizeWnd Handle already destroyed'); 7684 // make sure our text is saved 7685 if TWSWinControlClass(WidgetSetClass).GetText(Self, S) then 7686 FCaption := S; 7687 // if color has changed make sure it will be restored 7688 if FColor <> {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif} then 7689 Include(FWinControlFlags,wcfColorChanged); 7690 RemoveProp(Handle,'WinControl'); 7691 FAdjustClientRectRealized := Rect(0,0,0,0); 7692end; 7693 7694{------------------------------------------------------------------------------ 7695 procedure TWinControl.ParentFormHandleInitialized; 7696 7697 Called after all children handles of the ParentForm are created. 7698 ------------------------------------------------------------------------------} 7699procedure TWinControl.ParentFormHandleInitialized; 7700var 7701 i: Integer; 7702begin 7703 inherited ParentFormHandleInitialized; 7704 // tell all controls about the final end of the handle creation phase 7705 if FControls<>nil then begin 7706 for i:=0 to FControls.Count-1 do 7707 TControl(FControls[i]).ParentFormHandleInitialized; 7708 end; 7709 //debugln('TWinControl.ParentFormHandleInitialized A ',DbgSName(Self)); 7710end; 7711 7712{------------------------------------------------------------------------------ 7713 procedure TWinControl.ChildHandlesCreated; 7714 7715 Called after all children handles are created. 7716 ------------------------------------------------------------------------------} 7717procedure TWinControl.ChildHandlesCreated; 7718begin 7719 Exclude(FWinControlFlags,wcfCreatingChildHandles); 7720end; 7721 7722function TWinControl.GetMouseCapture: Boolean; 7723begin 7724 Result:=HandleAllocated and (GetCaptureControl=Self); 7725end; 7726 7727function TWinControl.GetParentBackground: Boolean; 7728begin 7729 Result := csParentBackground in ControlStyle; 7730end; 7731 7732{------------------------------------------------------------------------------ 7733 function TWinControl.ParentHandlesAllocated: boolean; 7734 7735 Checks if all Handles of all Parents are created. 7736 ------------------------------------------------------------------------------} 7737function TWinControl.ParentHandlesAllocated: boolean; 7738var 7739 CurControl: TWinControl; 7740begin 7741 Result:=false; 7742 CurControl:=Self; 7743 while CurControl<>nil do begin 7744 if (not CurControl.HandleAllocated) 7745 or (csDestroying in CurControl.ComponentState) 7746 or (csDestroyingHandle in CurControl.ControlState) then 7747 exit; 7748 CurControl:=CurControl.Parent; 7749 end; 7750 Result:=true; 7751end; 7752 7753{------------------------------------------------------------------------------ 7754 procedure TWinControl.Loaded; 7755 ------------------------------------------------------------------------------} 7756procedure TWinControl.Loaded; 7757var 7758 CachedText: string; 7759 i: Integer; 7760 AChild: TControl; 7761 LoadedClientSize: TSize; 7762 CurControl: TWinControl; 7763begin 7764 //DebugLn(['TWinControl.Loaded START ',DbgSName(Self),' cfWidthLoaded=',cfWidthLoaded in FControlFlags,' cfHeightLoaded=',cfHeightLoaded in FControlFlags,' ']); 7765 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.Loaded'){$ENDIF}; 7766 try 7767 //DebugLn(['TWinControl.Loaded ',DbgSName(Self),' cfWidthLoaded=',cfWidthLoaded in FControlFlags,' cfHeightLoaded=',cfHeightLoaded in FControlFlags,' ']); 7768 if cfClientWidthLoaded in FControlFlags then 7769 LoadedClientSize.cx:=FLoadedClientSize.cx 7770 else begin 7771 CurControl:=Self; 7772 while CurControl<>nil do begin 7773 LoadedClientSize.cx:=CurControl.ClientWidth; 7774 if LoadedClientSize.cx>0 then break; 7775 LoadedClientSize.cx:=CurControl.Width; 7776 if LoadedClientSize.cx>0 then break; 7777 CurControl:=CurControl.Parent; 7778 end; 7779 end; 7780 if cfClientHeightLoaded in FControlFlags then 7781 LoadedClientSize.cy:=FLoadedClientSize.cy 7782 else begin 7783 CurControl:=Self; 7784 while CurControl<>nil do begin 7785 LoadedClientSize.cy:=CurControl.ClientHeight; 7786 if LoadedClientSize.cy>0 then break; 7787 LoadedClientSize.cy:=CurControl.Height; 7788 if LoadedClientSize.cy>0 then break; 7789 CurControl:=CurControl.Parent; 7790 end; 7791 end; 7792 for i:=0 to ControlCount-1 do begin 7793 AChild:=Controls[i]; 7794 if AChild=nil then ; 7795 AChild.FBaseParentClientSize:=LoadedClientSize; 7796 //DebugLn(['TWinControl.Loaded Self=',DbgSName(Self),' AChild=',AChild,' AChild.FBaseParentClientSize=',dbgs(AChild.FBaseParentClientSize)]); 7797 end; 7798 if HandleAllocated then 7799 begin 7800 // Set cached caption 7801 if GetCachedText(CachedText) then 7802 WSSetText(CachedText); 7803 InvalidatePreferredSize; 7804 7805 if wcfColorChanged in FWinControlFlags then 7806 begin 7807 TWSWinControlClass(WidgetSetClass).SetColor(Self); 7808 NotifyControls(CM_PARENTCOLORCHANGED); 7809 Exclude(FWinControlFlags, wcfColorChanged); 7810 end; 7811 if wcfFontChanged in FWinControlFlags then 7812 begin 7813 TWSWinControlClass(WidgetSetClass).SetFont(Self,Font); 7814 NotifyControls(CM_PARENTFONTCHANGED); 7815 FWinControlFlags:=FWinControlFlags-[wcfFontChanged]; 7816 end; 7817 end; 7818 7819 inherited Loaded; 7820 7821 FixupTabList; 7822 7823 finally 7824 //DebugLn(['TWinControl.Loaded enableautosizing ',DbgSName(Self),' ',dbgs(BoundsRect)]); 7825 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.Loaded'){$ENDIF}; 7826 //DebugLn(['TWinControl.Loaded END ',DbgSName(Self),' ',dbgs(BoundsRect)]); 7827 end; 7828end; 7829 7830procedure TWinControl.FormEndUpdated; 7831var 7832 i: Integer; 7833begin 7834 inherited FormEndUpdated; 7835 for i:=0 to ControlCount-1 do 7836 Controls[i].FormEndUpdated; 7837end; 7838 7839{------------------------------------------------------------------------------ 7840 Method: TWinControl.DestroyWnd 7841 Params: None 7842 Returns: Nothing 7843 7844 Destroys the interface object. 7845 ------------------------------------------------------------------------------} 7846procedure TWinControl.DestroyWnd; 7847var 7848 i: integer; 7849begin 7850 if HandleAllocated then 7851 begin 7852 //DebugLn(['TWinControl.DestroyWnd ',DbgSName(Self)]); 7853 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DestroyWnd'){$ENDIF}; 7854 try 7855 FinalizeWnd; 7856 7857 if FControls <> nil then 7858 for i := 0 to FControls.Count - 1 do 7859 TControl(FControls[i]).DoOnParentHandleDestruction; 7860 7861 TWSWinControlClass(WidgetSetClass).DestroyHandle(Self); 7862 Handle := 0; 7863 Exclude(FWinControlFlags,wcfBoundsRealized); 7864 // Maybe handle is not needed at moment but later it will be created once 7865 // again. To propely initialize control after we need to restore color 7866 // and font. Request update. 7867 FWinControlFlags := FWinControlFlags + [wcfColorChanged, wcfFontChanged]; 7868 if (CaptureControl=Self) then 7869 SetCaptureControl(nil); 7870 finally 7871 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DestroyWnd'){$ENDIF}; 7872 end; 7873 end; 7874end; 7875 7876{------------------------------------------------------------------------------ 7877 Method: TWinControl.HandleNeeded 7878 Params: None 7879 Returns: Nothing 7880 7881 Description of the procedure for the class. 7882 ------------------------------------------------------------------------------} 7883procedure TWinControl.HandleNeeded; 7884begin 7885 if (not HandleAllocated) and (not (csDestroying in ComponentState)) then 7886 begin 7887 if Parent = Self 7888 then begin 7889 //DebugLn(Format('Trace:[TWinControl.HandleNeeded] Somebody set Parent := Self in %s. DONT DO THAT !!', [Classname])); 7890 end 7891 else begin 7892 if (Parent <> nil) then 7893 begin 7894 Parent.HandleNeeded; 7895 // has parent triggered us to create our handle ? 7896 if HandleAllocated then 7897 exit; 7898 end; 7899 end; 7900 CreateHandle; 7901 end; 7902end; 7903 7904function TWinControl.BrushCreated: Boolean; 7905begin 7906 Result := Assigned(FBrush); 7907end; 7908 7909{------------------------------------------------------------------------------ 7910 Method: TWinControl.BeginUpdateBounds 7911 Params: None 7912 Returns: Nothing 7913 7914 increases the BoundsLockCount 7915 ------------------------------------------------------------------------------} 7916procedure TWinControl.BeginUpdateBounds; 7917begin 7918 inc(FBoundsLockCount); 7919end; 7920 7921procedure TWinControl.InvalidateBoundsRealized; 7922begin 7923 FBoundsRealized := Rect(0, 0, 0, 0); 7924end; 7925 7926{------------------------------------------------------------------------------ 7927 Method: TControl.EndUpdateBounds 7928 Params: None 7929 Returns: Nothing 7930 7931 decreases the BoundsLockCount 7932 ------------------------------------------------------------------------------} 7933procedure TWinControl.EndUpdateBounds; 7934begin 7935 if FBoundsLockCount <= 0 then 7936 raise EInvalidOperation.CreateFmt('TWinControl.EndUpdateBounds %s too many calls.', [DbgSName(Self)]); 7937 dec(FBoundsLockCount); 7938 if FBoundsLockCount = 0 then 7939 SetBounds(Left, Top, Width, Height); 7940end; 7941 7942procedure TWinControl.LockRealizeBounds; 7943begin 7944 inc(FRealizeBoundsLockCount); 7945end; 7946 7947procedure TWinControl.UnlockRealizeBounds; 7948begin 7949 if FRealizeBoundsLockCount<=0 then 7950 RaiseGDBException('UnlockRealizeBounds'); 7951 dec(FRealizeBoundsLockCount); 7952 if (FRealizeBoundsLockCount=0) 7953 and (not AutoSizeDelayed) and (caspRealizingBounds in AutoSizePhases) 7954 then 7955 RealizeBounds; 7956end; 7957 7958{------------------------------------------------------------------------------ 7959 procedure TWinControl.DockDrop(DockObject: TDragDockObject; X, Y: Integer); 7960 7961 Docks the DockObject.Control onto this control. 7962 X, Y are only default values. More important is the DockObject.DropAlign 7963 property, which defines how to align DockObject.Control. 7964 ------------------------------------------------------------------------------} 7965procedure TWinControl.DockDrop(DragDockObject: TDragDockObject; X, Y: Integer); 7966begin 7967 if DoDockClientMsg(DragDockObject, Point(X, Y)) and Assigned(FOnDockDrop) then 7968 FOnDockDrop(Self, DragDockObject, X, Y); 7969end; 7970 7971{------------------------------------------------------------------------------ 7972 Method: TControl.GetIsResizing 7973 Params: None 7974 Returns: Nothing 7975 7976 decreases the BoundsLockCount 7977 ------------------------------------------------------------------------------} 7978function TWinControl.GetIsResizing: boolean; 7979begin 7980 Result:=BoundsLockCount>0; 7981end; 7982 7983{------------------------------------------------------------------------------ 7984 function TWinControl.GetTabOrder: TTabOrder; 7985 ------------------------------------------------------------------------------} 7986function TWinControl.GetTabOrder: TTabOrder; 7987begin 7988 if FParent <> nil then 7989 Result := ListIndexOf(FParent.FTabList,Self) 7990 else 7991 Result := FTabOrder; 7992end; 7993 7994{------------------------------------------------------------------------------ 7995 function TWinControl.GetVisibleDockClientCount: Integer; 7996 ------------------------------------------------------------------------------} 7997function TWinControl.GetVisibleDockClientCount: Integer; 7998var 7999 i: integer; 8000begin 8001 Result := 0; 8002 if FDockClients=nil then exit; 8003 for i:=FDockClients.Count-1 downto 0 do 8004 if TControl(FDockClients[I]).Visible then inc(Result); 8005end; 8006 8007{------------------------------------------------------------------------------ 8008 procedure TWinControl.SetChildSizing(const AValue: TControlChildSizing); 8009 ------------------------------------------------------------------------------} 8010procedure TWinControl.SetChildSizing(const AValue: TControlChildSizing); 8011begin 8012 if (FChildSizing=AValue) then exit; 8013 FChildSizing.Assign(AValue); 8014end; 8015 8016{------------------------------------------------------------------------------ 8017 procedure TWinControl.SetDockSite(const NewDockSite: Boolean); 8018 8019 If NewDockSite=true it means, this control can dock other controls. 8020 ------------------------------------------------------------------------------} 8021procedure TWinControl.SetDockSite(const NewDockSite: Boolean); 8022begin 8023 if FDockSite=NewDockSite then exit; 8024 FDockSite := NewDockSite; 8025 if not (csDesigning in ComponentState) then begin 8026 DragManager.RegisterDockSite(Self,NewDockSite); 8027 if not NewDockSite then begin 8028 FreeAndNil(FDockClients); 8029 FDockClients := nil; 8030 DockManager := nil; 8031 end 8032 else begin 8033 if FDockClients = nil then FDockClients := TFPList.Create; 8034 DockManager := CreateDockManager; 8035 end; 8036 end; 8037end; 8038 8039procedure TWinControl.SetDoubleBuffered(Value: Boolean); 8040var 8041 AChanged: Boolean; 8042begin 8043 AChanged := FDoubleBuffered <> Value; 8044 FDoubleBuffered := Value; 8045 FParentDoubleBuffered := False; 8046 if AChanged then 8047 Perform(CM_DOUBLEBUFFEREDCHANGED, 0, 0); 8048end; 8049 8050function TWinControl.DoDockClientMsg(DragDockObject: TDragDockObject; 8051 aPosition: TPoint): boolean; 8052var 8053 DestRect: TRect; 8054 Form: TCustomForm; 8055begin 8056 with DragDockObject do begin 8057 DestRect := DockRect; 8058 DisableAlign; 8059 try 8060 {$IFDEF VerboseDocking} 8061 Debugln(['TWinControl.DoDockClientMsg ',DbgSName(Self),' Control=',DbgSName(DragDockObject.Control),' DestRect=',dbgs(DestRect)]); 8062 {$ENDIF} 8063 DragDockObject.Control.Dock(Self, DestRect); 8064 if FUseDockManager and (DockManager <> nil) then 8065 DockManager.InsertControl(DragDockObject); 8066 finally 8067 EnableAlign; 8068 end; 8069 Form := GetParentForm(Self); 8070 if Form <> nil then Form.BringToFront; 8071 Result := true; 8072 end; 8073end; 8074 8075function TWinControl.DoUndockClientMsg(NewTarget, Client: TControl): boolean; 8076begin 8077 Result := True; 8078 {$IFDEF VerboseDocking} 8079 DebugLn(['TWinControl.DoUnDockClientMsg ',DbgSName(Self),' Client=',DbgSName(Client),' Client.Parent=',DbgSName(Client.Parent)]); 8080 {$ENDIF} 8081 if FUseDockManager and (DockManager <> nil) then 8082 DockManager.RemoveControl(Client); 8083end; 8084 8085{------------------------------------------------------------------------------ 8086 Method: TWinControl.SetBounds 8087 Params: aLeft, aTop, aWidth, aHeight 8088 Returns: Nothing 8089 8090 Sets the bounds of the control. 8091 ------------------------------------------------------------------------------} 8092procedure TWinControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer); 8093 8094 procedure CheckDesignBounds; 8095 begin 8096 if FRealizeBoundsLockCount > 0 then Exit; 8097 // the user changed the bounds 8098 if AWidth < 0 then 8099 raise EInvalidOperation.CreateFmt('TWinControl.SetBounds (%s): Negative width %d not allowed.', [DbgSName(Self), AWidth]); 8100 if AHeight < 0 then 8101 raise EInvalidOperation.CreateFmt('TWinControl.SetBounds (%s): Negative height %d not allowed.', [DbgSName(Self), AHeight]); 8102 end; 8103 8104var 8105 NewBounds, OldBounds: TRect; 8106begin 8107 {$IFDEF CHECK_POSITION} 8108 //if csDesigning in ComponentState then 8109 if CheckPosition(Self) then 8110 DebugLn(['[TWinControl.SetBounds] START ',DbgSName(Self), 8111 ' Old=',dbgs(Bounds(Left,Top,Width,Height)), 8112 ' -> New=',dbgs(Bounds(ALeft,ATop,AWidth,AHeight)), 8113 ' Lock=',BoundsLockCount, 8114 ' Realized=',dbgs(FBoundsRealized) 8115 ]); 8116 {$ENDIF} 8117 if BoundsLockCount <> 0 then 8118 Exit; 8119 OldBounds := BoundsRect; 8120 NewBounds := Bounds(ALeft, ATop, AWidth, AHeight); 8121 8122 if not CompareRect(@NewBounds, @OldBounds) then 8123 begin 8124 if [csDesigning,csDestroying,csLoading]*ComponentState=[csDesigning] then 8125 CheckDesignBounds; 8126 // LCL bounds are not up2date -> process new bounds 8127 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.SetBounds'){$ENDIF}; 8128 try 8129 {$IFDEF CHECK_POSITION} 8130 //if csDesigning in ComponentState then 8131 if CheckPosition(Self) then 8132 DebugLn(['[TWinControl.SetBounds] Set LCL Bounds ',DbgSName(Self), 8133 ' OldBounds=',Dbgs(Bounds(Left,Top,Width,Height)), 8134 ' -> New=',Dbgs(Bounds(ALeft,ATop,AWidth,AHeight))]); 8135 {$ENDIF} 8136 inherited SetBounds(ALeft, ATop, AWidth, AHeight); 8137 //DebugLn(['TWinControl.SetBounds ',DbgSName(Self),' FUseDockManager=',FUseDockManager,' ',DbgSName(DockManager)]); 8138 finally 8139 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.SetBounds'){$ENDIF}; 8140 end; 8141 end; 8142end; 8143 8144{------------------------------------------------------------------------------ 8145 procedure TWinControl.CalculatePreferredSize(var PreferredWidth, 8146 PreferredHeight: integer; WithThemeSpace" Boolean); 8147 8148 Calculates the default/preferred width and height for a TWinControl, which is 8149 used by the LCL autosizing algorithms as default size. Only positive values 8150 are valid. Negative or 0 are treated as undefined and the LCL uses other sizes 8151 instead (exception: csAutoSize0x0). 8152 TWinControl overrides this: 8153 If there are children, their total preferred size is calculated. 8154 If this value can not be computed (e.g. the children depend too much on their 8155 parent clientrect), then the interface is asked for the preferred size. 8156 For example the preferred size of a TButton is the size, where the label fits 8157 exactly. This depends heavily on the current theme and widgetset. 8158 8159 This value is independent of constraints and siblings, only the inner parts 8160 are relevant. 8161 8162 WithThemeSpace: If true, adds space for stacking. For example: TRadioButton 8163 has a minimum size. But for stacking multiple TRadioButtons there should be 8164 some space around. This space is theme dependent, so it passed parameter to 8165 the widgetset. 8166 ------------------------------------------------------------------------------} 8167procedure TWinControl.CalculatePreferredSize(var PreferredWidth, 8168 PreferredHeight: integer; WithThemeSpace: Boolean); 8169 8170 {$IFDEF VerboseCalculatePreferredSize} 8171 procedure trav(aControl: TControl; Prefix: string); 8172 var 8173 w: integer; 8174 h: integer; 8175 i: Integer; 8176 begin 8177 if not aControl.IsVisible then exit; 8178 if aControl<>Self then begin 8179 aControl.GetPreferredSize(w,h,true,true); 8180 debugln([Prefix,'Child ',DbgSName(aControl),' ',dbgs(aControl.BoundsRect),' Pref=',w,'x',h]); 8181 end; 8182 if aControl is TWinControl then 8183 for i:=0 to TWinControl(aControl).ControlCount-1 do 8184 trav(TWinControl(aControl).Controls[i],Prefix+' '); 8185 end; 8186 8187 function IsVerbose: boolean; 8188 begin 8189 Result:=(Name='MainScrollBox'); 8190 end; 8191 {$ENDIF} 8192 8193var 8194 Layout: TAutoSizeCtrlData; 8195 NewClientWidth: Integer; 8196 NewClientHeight: Integer; 8197 NewMoveLeft, NewMoveRight: integer; 8198 FrameWidth: integer; 8199 FrameHeight: integer; 8200begin 8201 inherited CalculatePreferredSize(PreferredWidth,PreferredHeight,WithThemeSpace); 8202 8203 if HandleAllocated then begin 8204 TWSWinControlClass(WidgetSetClass).GetPreferredSize(Self, 8205 PreferredWidth, PreferredHeight, WithThemeSpace); 8206 {$IFDEF VerboseCalculatePreferredSize} 8207 if IsVerbose then debugln(['TWinControl.CalculatePreferredSize Widget ',DbgSName(Self),' ',DbgSName(WidgetSetClass),' Pref=',PreferredWidth,'x',PreferredHeight]); 8208 {$ENDIF} 8209 end; 8210 8211 if ControlCount>0 then begin 8212 // Beware: ControlCount>0 does not mean that there are visible children 8213 8214 // get the size requirements for the child controls 8215 Layout:=nil; 8216 try 8217 Layout:=TAutoSizeCtrlData.Create(Self); 8218 Layout.ComputePreferredClientArea(false,false,NewMoveLeft,NewMoveRight, 8219 NewClientWidth,NewClientHeight); 8220 //if (Name='OtherInfoGroupBox') or (Name='ProjectVersionInfoOptionsFrame') then 8221 // debugln(['TWinControl.CalculatePreferredSize NewClientWidth=',NewClientWidth,' NewClientHeight=',NewClientHeight]); 8222 if (NewMoveLeft<>0) or (NewMoveRight<>0) then ; 8223 finally 8224 Layout.Free; 8225 end; 8226 8227 // add clientarea frame 8228 GetPreferredSizeClientFrame(FrameWidth,FrameHeight); 8229 8230 {$IF defined(VerboseAutoSize) or defined(VerboseAllAutoSize) or defined(VerboseCalculatePreferredSize)} 8231 {$IFDEF VerboseCalculatePreferredSize} 8232 if IsVerbose then 8233 trav(Self,' '); 8234 if IsVerbose then 8235 {$ENDIF} 8236 //if (Name='OtherInfoGroupBox') or (Name='ProjectVersionInfoOptionsFrame') then 8237 debugln(['TWinControl.CalculatePreferredSize ',DbgSName(Self), 8238 ' HandleAllocated=',HandleAllocated, 8239 ' Cur=',Width,'x',Height, 8240 ' Client=',ClientWidth,'x',ClientHeight, 8241 ' PrefClient=',NewClientWidth,'x',NewClientHeight]); 8242 {$ENDIF} 8243 if NewClientWidth>0 then 8244 PreferredWidth:=Max(PreferredWidth,NewClientWidth+FrameWidth); 8245 if NewClientHeight>0 then 8246 PreferredHeight:=Max(PreferredHeight,NewClientHeight+FrameHeight); 8247 end; 8248 8249 // add borderspacing 8250 if (PreferredWidth>0) 8251 or ((PreferredWidth=0) and (csAutoSize0x0 in ControlStyle)) then 8252 inc(PreferredWidth,BorderSpacing.InnerBorder*2); 8253 if (PreferredHeight>0) 8254 or ((PreferredHeight=0) and (csAutoSize0x0 in ControlStyle)) then 8255 inc(PreferredHeight,BorderSpacing.InnerBorder*2); 8256 {$IF defined(VerboseAutoSize) or defined(VerboseCalculatePreferredSize)} 8257 {$IFDEF VerboseCalculatePreferredSize} 8258 if IsVerbose then 8259 {$ENDIF} 8260 debugln(['TWinControl.CalculatePreferredSize ',DbgSName(Self), 8261 ' HandleAllocated=',dbgs(HandleAllocated), 8262 ' ClientFrame=',FrameWidth,'x',FrameHeight, 8263 ' Preferred=',dbgs(PreferredWidth),'x',dbgs(PreferredHeight)]); 8264 {$ENDIF} 8265end; 8266 8267procedure TWinControl.GetPreferredSizeClientFrame(out aWidth, aHeight: integer); 8268begin 8269 aWidth:=Width-ClientWidth; 8270 aHeight:=Height-ClientHeight; 8271end; 8272 8273{------------------------------------------------------------------------------ 8274 Method: TWinControl.RealGetText 8275 Params: None 8276 Returns: The text 8277 8278 Gets the text/caption of a control 8279 ------------------------------------------------------------------------------} 8280function TWinControl.RealGetText: TCaption; 8281begin 8282 Result := ''; 8283 {$IFDEF VerboseTWinControlRealText} 8284 DebugLn(['TWinControl.RealGetText ',DbgSName(Self),' HandleAllocated=',HandleAllocated,' csLoading=',csLoading in ComponentState,' ']); 8285 if not HandleAllocated 8286 or (csLoading in ComponentState) then begin 8287 DebugLn(['TWinControl.RealGetText using inherited RealGetText']); 8288 Result := inherited RealGetText; 8289 end else begin 8290 DebugLn(['TWinControl.RealGetText using ',DbgSName(WidgetSetClass),' GetText']); 8291 if (not TWSWinControlClass(WidgetSetClass).GetText(Self, Result)) then begin 8292 DebugLn(['TWinControl.RealGetText FAILED, using RealGetText']); 8293 Result := inherited RealGetText; 8294 end; 8295 end; 8296 DebugLn(['TWinControl.RealGetText Result="',Result,'"']); 8297 {$ELSE} 8298 if not HandleAllocated 8299 or (csLoading in ComponentState) 8300 or (not TWSWinControlClass(WidgetSetClass).GetText(Self, Result)) 8301 then Result := inherited RealGetText; 8302 {$ENDIF} 8303end; 8304 8305{------------------------------------------------------------------------------ 8306 Method: TWinControl.GetTextLen 8307 Params: None 8308 Returns: The length of the text 8309 8310 Gets the length of the text/caption of a control 8311 ------------------------------------------------------------------------------} 8312function TWinControl.GetTextLen: Integer; 8313begin 8314 Result := 0; 8315 if not HandleAllocated 8316 or (csLoading in ComponentState) 8317 or not TWSWinControlClass(WidgetSetClass).GetTextLen(Self, Result) 8318 then Result := inherited GetTextLen; 8319end; 8320 8321{------------------------------------------------------------------------------ 8322 Method: TWinControl.RealSetText 8323 Params: Value: the text to be set 8324 Returns: Nothing 8325 8326 Sets the text/caption of a control 8327 ------------------------------------------------------------------------------} 8328procedure TWinControl.RealSetText(const AValue: TCaption); 8329begin 8330 {$IFDEF VerboseTWinControlRealText} 8331 DebugLn(['TWinControl.RealSetText ',DbgSName(Self),' AValue="',AValue,'" HandleAllocated=',HandleAllocated,' csLoading=',csLoading in ComponentState]); 8332 {$ENDIF} 8333 if HandleAllocated and (not (csLoading in ComponentState)) then 8334 begin 8335 WSSetText(AValue); 8336 InvalidatePreferredSize; 8337 inherited RealSetText(AValue); 8338 AdjustSize; 8339 end 8340 else inherited RealSetText(AValue); 8341 {$IFDEF VerboseTWinControlRealText} 8342 DebugLn(['TWinControl.RealSetText ',DbgSName(Self),' END']); 8343 {$ENDIF} 8344end; 8345 8346{------------------------------------------------------------------------------ 8347 Method: TWinControl.GetDeviceContext 8348 Params: WindowHandle: the windowhandle of this control 8349 Returns: a Devicecontext 8350 8351 Get the devicecontext for this WinControl. 8352 ------------------------------------------------------------------------------} 8353function TWinControl.GetDeviceContext(var WindowHandle: HWND): HDC; 8354begin 8355 Result := GetDC(Handle); 8356 //DebugLn('[TWinControl.GetDeviceContext] ',ClassName,' DC=',DbgS(Result,8),' Handle=',DbgS(FHandle)); 8357 if Result = 0 then 8358 raise EOutOfResources.CreateFmt(rsErrorCreatingDeviceContext, [Name, ClassName]); 8359 8360 WindowHandle := Handle; 8361end; 8362 8363{------------------------------------------------------------------------------ 8364 Method: TWinControl.CMVisibleChanged 8365 Params: Message : not used 8366 Returns: nothing 8367 8368 Performs actions when visibility has changed 8369 ------------------------------------------------------------------------------} 8370procedure TWinControl.CMVisibleChanged(var Message : TLMessage); 8371begin 8372 if not FVisible and Assigned(Parent) then 8373 RemoveFocus(False); 8374 8375 if not (csDesigning in ComponentState) or (csNoDesignVisible in ControlStyle) then 8376 UpdateControlState; 8377end; 8378 8379procedure TWinControl.CMEnter(var Message: TLMessage); 8380begin 8381 DoEnter; 8382end; 8383 8384procedure TWinControl.CMExit(var Message: TLMessage); 8385begin 8386 DoExit; 8387end; 8388 8389procedure TWinControl.CMParentDoubleBufferedChanged(var Message: TLMessage); 8390begin 8391 if FParentDoubleBuffered then 8392 begin 8393 if Assigned(FParent) then 8394 DoubleBuffered := FParent.DoubleBuffered; // call CM_DOUBLEBUFFEREDCHANGED 8395 FParentDoubleBuffered := True; 8396 end; 8397end; 8398 8399procedure TWinControl.WMContextMenu(var Message: TLMContextMenu); 8400var 8401 Child: TControl; 8402begin 8403 // Check if at the click place we have a control and if so then pass the 8404 // message to it. 8405 // Don't check csDesigning here - let a child control check it. 8406 if (Message.Result <> 0) then 8407 Exit; 8408 8409 if Message.XPos <> -1 then 8410 begin 8411 // don't allow disabled and don't search wincontrols - they receive their 8412 // message themself 8413 Child := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), []); 8414 if Assigned(Child) then 8415 with Message do 8416 begin 8417 Result := Child.Perform(Msg, WParam(hWnd), LParam(Integer(Pos))); 8418 if (Result <> 0) then 8419 Exit; 8420 end; 8421 end; 8422 8423 inherited; 8424end; 8425 8426procedure TWinControl.DoSendShowHideToInterface; 8427var 8428 NewVisible: Boolean; 8429begin 8430 NewVisible := HandleObjectShouldBeVisible; 8431 if NewVisible <> (wcfHandleVisible in FWinControlFlags) then 8432 begin 8433 if NewVisible then 8434 Include(FWinControlFlags, wcfHandleVisible) 8435 else 8436 Exclude(FWinControlFlags, wcfHandleVisible); 8437 {$IF defined(VerboseNewAutoSize) or defined(VerboseIntfSizing) or defined(VerboseShowing)} 8438 DebugLn(['TWinControl.DoSendShowHideToInterface ',DbgSName(Self),' FBoundsRealized=',dbgs(FBoundsRealized),' New=',HandleObjectShouldBeVisible]); 8439 {$ENDIF} 8440 TWSWinControlClass(WidgetSetClass).ShowHide(Self); 8441 end; 8442end; 8443 8444procedure TWinControl.ControlsAligned; 8445begin 8446 8447end; 8448 8449procedure TWinControl.DoSendBoundsToInterface; 8450var 8451 NewBounds: TRect; 8452 OldClientRect: TRect; 8453 NewClientRect: TRect; 8454 {$IF defined(VerboseResizeFlicker) or defined(VerboseSizeMsg)} 8455 OldBounds: TRect; 8456 {$ENDIF} 8457begin 8458 if (Parent = nil) and (not HandleObjectShouldBeVisible) then 8459 begin 8460 { do not move invisible forms 8461 Reason: It is common to do this: 8462 Form1:=TForm1.Create(nil); 8463 Form1.Top:=100; 8464 Form1.Left:=100; 8465 Form1.Show; 8466 This moves the form around and confuses some windowmanagers. 8467 Only send the last bounds. } 8468 Exit; 8469 end; 8470 NewBounds := Bounds(Left, Top, Width, Height); 8471 {$IF defined(VerboseResizeFlicker) or defined(VerboseSizeMsg)} 8472 if HandleAllocated then begin 8473 GetWindowRelativePosition(Handle,OldBounds.Left,OldBounds.Top); 8474 GetWindowSize(Handle,OldBounds.Right,OldBounds.Bottom); 8475 inc(OldBounds.Right,OldBounds.Left); 8476 inc(OldBounds.Bottom,OldBounds.Top); 8477 end else 8478 OldBounds:=NewBounds; 8479 DebugLn(['[TWinControl.DoSendBoundsToInterface] ',DbgSName(Self), 8480 ' Old=',dbgs(OldBounds), 8481 ' New=',dbgs(NewBounds), 8482 ' PosChanged=',(OldBounds.Left<>NewBounds.Left) or (OldBounds.Top<>NewBounds.Top), 8483 ' SizeChanged=w',(OldBounds.Right-OldBounds.Left<>NewBounds.Right-NewBounds.Left), 8484 ',h', (OldBounds.Bottom-OldBounds.Top<>NewBounds.Bottom-NewBounds.Top), 8485 ' CurClient=',FClientWidth,'x',FClientHeight 8486 ]); 8487 {$ENDIF} 8488 {$IFDEF CHECK_POSITION} 8489 if CheckPosition(Self) then 8490 DebugLn('[TWinControl.DoSendBoundsToInterface] A ',DbgSName(Self), 8491 ' OldRelBounds=',dbgs(FBoundsRealized), 8492 ' -> NewBounds=',dbgs(NewBounds), 8493 ' ClientRect=',dbgs(ClientRect)); 8494 {$ENDIF} 8495 8496 {$IFDEF VerboseClientRectBugFix} 8497 //if Name=CheckClientRectName then 8498 DebugLn('[TWinControl.DoSendBoundsToInterface] A ',DbgSName(Self), 8499 ' OldRelBounds=',dbgs(FBoundsRealized), 8500 ' -> NewBounds=',dbgs(NewBounds) 8501 //,' Parent.Bounds=',dbgs(Parent.BoundsRect) 8502 //,' Parent.ClientRect=',dbgs(Parent.ClientRect) 8503 ); 8504 {$ENDIF} 8505 8506 {$IFDEF VerboseIntfSizing} 8507 if Visible then begin 8508 DebugLn('[TWinControl.DoSendBoundsToInterface] A ',DbgSName(Self), 8509 ' OldRelBounds=',dbgs(FBoundsRealized), 8510 ' -> NewBounds=',dbgs(NewBounds)); 8511 end; 8512 {$ENDIF} 8513 FBoundsRealized := NewBounds; 8514 OldClientRect := ClientRect; // during a resize this is the anticipated new ClientRect 8515 Include(FWinControlFlags, wcfBoundsRealized); // Note: set before calling widgetset, because used in WMSize 8516 //if Parent=nil then DebugLn(['TWinControl.DoSendBoundsToInterface ',DbgSName(Self),' ',dbgs(BoundsRect)]); 8517 // this can trigger WMSize messages 8518 TWSWinControlClass(WidgetSetClass).SetBounds(Self, Left, Top, Width, Height); 8519 NewClientRect := ClientRect; 8520 if Visible and (not CompareRect(@OldClientRect,@NewClientRect)) then 8521 begin 8522 // the widgetset has changed the clientrect in an unexpected way 8523 {$IFDEF VerboseIntfSizing} 8524 debugln(['TWinControl.DoSendBoundsToInterface WS has changed ClientRect in an unexpected way: ', 8525 DbgSName(Self),' Bounds=',dbgs(BoundsRect),' ExpectedClientRect=',dbgs(OldClientRect),' New=',dbgs(NewClientRect)]); 8526 {$ENDIF} 8527 //DebugLn(['TWinControl.DoSendBoundsToInterface ',DbgSName(Self),' Bounds=',dbgs(BoundsRect),' OldClientRect=',dbgs(OldClientRect),' NewClientRect=',dbgs(NewClientRect)]); 8528 AdjustSize; 8529 end; 8530end; 8531 8532procedure TWinControl.RealizeBounds; 8533 8534 procedure Check; 8535 var 8536 c: TWinControl; 8537 begin 8538 c:=Self; 8539 while c<>nil do begin 8540 DebugLn(['Check ',DbgSName(c),' ',c.HandleAllocated, 8541 ' wcfCreatingHandle=',wcfCreatingHandle in FWinControlFlags, 8542 ' wcfInitializing=',wcfInitializing in FWinControlFlags, 8543 ' wcfCreatingChildHandles=',wcfCreatingChildHandles in FWinControlFlags, 8544 '']); 8545 c:=c.Parent; 8546 end; 8547 RaiseGDBException(''); 8548 end; 8549 8550var 8551 NewBounds: TRect; 8552begin 8553 NewBounds:=Bounds(Left, Top, Width, Height); 8554 if HandleAllocated 8555 and ([csLoading,csDestroying]*ComponentState=[]) 8556 and (not (csDestroyingHandle in ControlState)) 8557 and (not CompareRect(@NewBounds,@FBoundsRealized)) 8558 then begin 8559 // the new bounds were not yet sent to the InterfaceObject -> send them 8560 {$IFDEF CHECK_POSITION} 8561 //if csDesigning in ComponentState then 8562 if CheckPosition(Self) then 8563 DebugLn('[TWinControl.RealizeBounds] A ',DbgSName(Self), 8564 ' OldRelBounds=',dbgs(FBoundsRealized), 8565 ' -> NewBounds=',dbgs(NewBounds)); 8566 {$ENDIF} 8567 BeginUpdateBounds; 8568 try 8569 DoSendBoundsToInterface; 8570 finally 8571 EndUpdateBounds; 8572 end; 8573 end else begin 8574 {$IFDEF CHECK_POSITION} 8575 if CheckPosition(Self) then begin 8576 DbgOut('[TWinControl.RealizeBounds] NOT REALIZING ',DbgSName(Self), 8577 ' OldRelBounds=',dbgs(FBoundsRealized), 8578 ' -> NewBounds=',dbgs(NewBounds), 8579 ', because '); 8580 if not HandleAllocated then debugln('not HandleAllocated'); 8581 if (csLoading in ComponentState) then debugln('csLoading'); 8582 if (csDestroying in ComponentState) then debugln('csDestroying'); 8583 if (CompareRect(@NewBounds,@FBoundsRealized)) then debugln('bounds not changed'); 8584 end; 8585 {$ENDIF} 8586 if not HandleAllocated then Check; 8587 end; 8588end; 8589 8590procedure TWinControl.RealizeBoundsRecursive; 8591var 8592 i: Integer; 8593 OldRealizing: boolean; 8594 AControl: TControl; 8595begin 8596 if not HandleAllocated then exit; 8597 OldRealizing:=wcfRealizingBounds in FWinControlFlags; 8598 Include(FWinControlFlags,wcfRealizingBounds); 8599 try 8600 if FControls<>nil then begin 8601 for i:=0 to FControls.Count-1 do begin 8602 AControl:=TControl(FControls[i]); 8603 if (AControl is TWinControl) then 8604 TWinControl(AControl).RealizeBoundsRecursive; 8605 end; 8606 end; 8607 RealizeBounds; 8608 finally 8609 if not OldRealizing then 8610 Exclude(FWinControlFlags,wcfRealizingBounds); 8611 end; 8612end; 8613 8614{------------------------------------------------------------------------------ 8615 Method: TWinControl.CMShowingChanged 8616 Params: Message : not used 8617 Returns: nothing 8618 8619 Shows or hides a control 8620 Called by UpdateShowing 8621 ------------------------------------------------------------------------------} 8622procedure TWinControl.CMShowingChanged(var Message: TLMessage); 8623begin 8624 {$IFDEF VerboseShowing} 8625 DebugLn(['TWinControl.CMShowingChanged ',DbgSName(Self),' HandleAllocated=',HandleAllocated,' ',dbgs(ComponentState)]); 8626 {$ENDIF} 8627 if HandleAllocated and ([csDestroying,csLoading]*ComponentState=[]) then 8628 DoSendShowHideToInterface 8629 else 8630 Exclude(FWinControlFlags, wcfHandleVisible); 8631end; 8632 8633{------------------------------------------------------------------------------ 8634 Method: TWinControl.ShowControl 8635 Params: AControl: Control to show 8636 Returns: nothing 8637 8638 Called by a child control (in TControl.Show), before setting Visible=true. 8639 Asks to show the child control and recursively shows the parents. 8640 ------------------------------------------------------------------------------} 8641procedure TWinControl.ShowControl(AControl: TControl); 8642begin 8643 if Parent <> nil then Parent.ShowControl(Self); 8644end; 8645 8646{ TWinControlEnumerator } 8647 8648function TWinControlEnumerator.GetCurrent: TControl; 8649begin 8650 if (FIndex>=0) and (FIndex<FParent.ControlCount) then 8651 Result:=FParent.Controls[FIndex] 8652 else 8653 Result:=nil; 8654end; 8655 8656constructor TWinControlEnumerator.Create(Parent: TWinControl; 8657 aLowToHigh: boolean); 8658begin 8659 FParent:=Parent; 8660 FLowToHigh:=aLowToHigh; 8661 if FLowToHigh then 8662 FIndex:=-1 8663 else 8664 FIndex:=FParent.ControlCount; 8665end; 8666 8667function TWinControlEnumerator.GetEnumerator: TWinControlEnumerator; 8668begin 8669 Result:=Self; 8670end; 8671 8672function TWinControlEnumerator.MoveNext: Boolean; 8673begin 8674 if FLowToHigh then 8675 begin 8676 inc(FIndex); 8677 Result:=FIndex<FParent.ControlCount; 8678 end 8679 else begin 8680 dec(FIndex); 8681 Result:=FIndex>=0 8682 end; 8683end; 8684 8685{ $UNDEF CHECK_POSITION} 8686 8687{$IFDEF ASSERT_IS_ON} 8688 {$UNDEF ASSERT_IS_ON} 8689 {$C-} 8690{$ENDIF} 8691