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