← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/include/wincontrol.inc

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lcl/include/wincontrol.inc
1
1
{%MainUnit ../controls.pp}
2
 
{  $Id: wincontrol.inc 31422 2011-06-28 08:31:19Z vincents $  }
3
2
 
4
3
{******************************************************************************
5
4
                                  TWinControl
848
847
      // this is a non aligned control
849
848
      //DebugLn(['TAutoSizeCtrlData.DoMoveNonAlignedChilds Child=',DbgSName(Child),' Side=',dbgs(Side)]);
850
849
      if FindMinimum then begin
851
 
        AddSpace:=Child.BorderSpacing.GetSpace(Side);
 
850
        AddSpace:=Child.BorderSpacing.GetSideSpace(Side);
852
851
        if Side=akLeft then
853
852
          AddSpace:=Max(AddSpace,WinControl.ChildSizing.LeftRightSpacing)
854
853
        else
1706
1705
  i: Integer;
1707
1706
  Child: TAutoSizeBox;
1708
1707
  CurLeftTop: Integer;
 
1708
  s: LongInt;
1709
1709
begin
1710
1710
  CurLeftTop:=0;
1711
1711
  for i:=0 to ChildCount[Orientation]-1 do begin
1714
1714
      inc(CurLeftTop,Child.BorderLeftTop[Orientation]);
1715
1715
    Child.LeftTop[Orientation]:=CurLeftTop;
1716
1716
    inc(CurLeftTop,Child.PreferredSize[Orientation]);
1717
 
    inc(CurLeftTop,Child.BorderRightBottom[Orientation]);
 
1717
    s:=Child.BorderRightBottom[Orientation];
 
1718
    if i<ChildCount[Orientation]-1 then
 
1719
      s:=Max(s,Children[Orientation][i+1].BorderLeftTop[Orientation]);
 
1720
    inc(CurLeftTop,s);
1718
1721
  end;
1719
1722
end;
1720
1723
 
1735
1738
  var
1736
1739
    i: Integer;
1737
1740
    Child: TAutoSizeBox;
 
1741
    s: LongInt;
1738
1742
  begin
1739
1743
    Result:=0;
1740
1744
    for i:=0 to ChildCount[Orientation]-1 do begin
1744
1748
      if Child.PreferredSize[Orientation]<1 then
1745
1749
        Child.PreferredSize[Orientation]:=1;
1746
1750
      inc(Result,Child.PreferredSize[Orientation]);
1747
 
      inc(Result,Child.BorderRightBottom[Orientation]);
 
1751
      s:=Child.BorderRightBottom[Orientation];
 
1752
      if i<ChildCount[Orientation]-1 then
 
1753
        s:=Max(s,Children[Orientation][i+1].BorderLeftTop[Orientation]);
 
1754
      inc(Result,s);
1748
1755
    end;
1749
1756
  end;
1750
1757
  
2380
2387
  {$ENDIF}
2381
2388
end;
2382
2389
 
2383
 
function TWinControl.AutoSizeCheckParent: Boolean;
2384
 
begin
2385
 
  Result := (Parent <> nil) or (ParentWindow <> 0);
 
2390
function TWinControl.AutoSizeDelayedReport: string;
 
2391
begin
 
2392
  if csDestroyingHandle in ControlState then
 
2393
    Result:='csDestroyingHandle'
 
2394
  else
 
2395
    Result:=inherited AutoSizeDelayedReport;
 
2396
end;
 
2397
 
 
2398
{------------------------------------------------------------------------------
 
2399
  TWinControl AutoSizeDelayedHandle
 
2400
 
 
2401
  Returns true if AutoSize should be skipped / delayed because of its handle.
 
2402
  A TWinControl needs a parent handle.
 
2403
------------------------------------------------------------------------------}
 
2404
function TWinControl.AutoSizeDelayedHandle: Boolean;
 
2405
begin
 
2406
  Result := (Parent = nil) and (ParentWindow = 0);
2386
2407
end;
2387
2408
 
2388
2409
{------------------------------------------------------------------------------
2640
2661
    {$IFDEF CHECK_POSITION}
2641
2662
    if CheckPosition(Control) then
2642
2663
    with Control do
2643
 
      DebugLn('[TWinControl.AlignControls.DoPosition] A Control=',dbgsName(Control),' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height),' recalculate the anchors=',dbgs(Control.Anchors <> AnchorAlign[AAlign]),' Align=',AlignNames[AAlign]);
 
2664
      DebugLn('[TWinControl.AlignControls.DoPosition] A Control=',dbgsName(Control),' ',
 
2665
              dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height),
 
2666
              ' recalculate the anchors=',dbgs(Control.Anchors <> AnchorAlign[AAlign]),
 
2667
              ' Align=',DbgS(AAlign));
2644
2668
    {$ENDIF}
2645
2669
 
2646
2670
    with Control do begin
2805
2829
      with Control do begin
2806
2830
        DebugLn(['[TWinControl.AlignControls.DoPosition] After Anchoring',
2807
2831
          ' Self=',DbgSName(Self),
2808
 
          ' Align=',AlignNames[AAlign],
 
2832
          ' Align=',DbgS(AAlign),
2809
2833
          ' Control=',dbgsName(Control),
2810
2834
          ' Old= l=',Left,',t=',Top,',w=',Width,',h=',Height,
2811
2835
          ' New= l=',NewLeft,',t=',NewTop,',w=',NewWidth,',h=',NewHeight,
2937
2961
          with Control do
2938
2962
            DebugLn('[TWinControl.AlignControls.DoPosition] After Aligning',
2939
2963
            ' ',Name,':',ClassName,
2940
 
            ' Align=',AlignNames[AAlign],
 
2964
            ' Align=',DbgS(AAlign),
2941
2965
            ' Control=',Name,':',ClassName,
2942
2966
            ' Old=',DbgS(Left,Top,Width,Height),
2943
2967
            ' New=',DbgS(NewLeft,NewTop,NewWidth,NewHeight),
3045
3069
      DebugLn('[TWinControl.AlignControls.DoPosition] END Control=',
3046
3070
        Name,':',ClassName,
3047
3071
        ' ',DbgS(Left,Top,Width,Height),
3048
 
        ' Align=',AlignNames[AAlign],
 
3072
        ' Align=',DbgS(AAlign),
3049
3073
        //' ARect=',ARect.Left,',',ARect.Top,',',ARect.Right-ARect.Left,',',ARect.Bottom-ARect.Top,
3050
3074
        '');
3051
3075
    {$ENDIF}
3063
3087
      if AlignList.Count>0 then
3064
3088
      begin
3065
3089
        DbgOut('[TWinControl.AlignControls.DoAlign] Self=',DbgSName(Self),' Control=',dbgsName(AControl),
3066
 
          ' current align=',AlignNames[AAlign],' AlignList=[');
 
3090
          ' current align=',DbgS(AAlign),' AlignList=[');
3067
3091
        for i:=0 to AlignList.Count-1 do
3068
3092
        begin
3069
3093
          if i>0 then DbgOut(',');
3292
3316
  {$ENDIF}
3293
3317
  if not (caspComputingBounds in AutoSizePhases) then begin
3294
3318
    {$IFDEF VerboseAllAutoSize}
3295
 
    DebugLn(['TWinControl.DoAutoSize DELAYED AutoSizePhase=',AutoSizePhaseNames[AutoSizePhase]]);
 
3319
    DebugLn(['TWinControl.DoAutoSize DELAYED AutoSizePhases=',dbgs(AutoSizePhases)]);
3296
3320
    {$ENDIF}
3297
3321
    AdjustSize;
3298
3322
    exit;
3489
3513
      inc(UpdateShowingCounter);
3490
3514
      // make child handles visible
3491
3515
      {$IFDEF VerboseAllAutoSize}
3492
 
      DebugLn(['TWinControl.DoAllAutoSize UPDATESHOWING ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]);
 
3516
      DebugLn(['TWinControl.DoAllAutoSize UPDATESHOWING children ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]);
3493
3517
      {$ENDIF}
3494
3518
      Include(FWinControlFlags,wcfUpdateShowing);
3495
3519
      try
3509
3533
  // make handle visible => this can trigger events like Form.OnShow where
3510
3534
  // application does arbitrary stuff
3511
3535
  {$IFDEF VerboseAllAutoSize}
3512
 
  DebugLn(['TWinControl.DoAllAutoSize UPDATESHOWING ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]);
 
3536
  DebugLn(['TWinControl.DoAllAutoSize UPDATESHOWING self ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]);
3513
3537
  {$ENDIF}
3514
3538
  if not (wcfUpdateShowing in FWinControlFlags) then
3515
3539
  begin
3516
3540
    Include(FWinControlFlags, wcfUpdateShowing);
3517
3541
    try
3518
3542
      if HandleObjectShouldBeVisible and not Showing then
3519
 
        UpdateShowing;
 
3543
        UpdateShowing
 
3544
      else begin
 
3545
        {$IFDEF VerboseAllAutoSize}
 
3546
        DebugLn(['TWinControl.DoAllAutoSize not UPDATESHOWING self ',DbgSName(Self),' because HandleObjectShouldBeVisible=',HandleObjectShouldBeVisible,' Showing=',Showing]);
 
3547
        {$ENDIF}
 
3548
      end;
3520
3549
    finally
3521
3550
      Exclude(FWinControlFlags, wcfUpdateShowing);
3522
3551
    end;
3759
3788
    Controls[i].WriteLayoutDebugReport(Prefix+'  ');
3760
3789
end;
3761
3790
 
 
3791
procedure TWinControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
 
3792
  const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: Integer);
 
3793
var
 
3794
  i: Integer;
 
3795
begin
 
3796
  inherited AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth);
 
3797
 
 
3798
  for i:=0 to ControlCount-1 do
 
3799
    Controls[i].AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth);
 
3800
end;
 
3801
 
3762
3802
{------------------------------------------------------------------------------
3763
3803
  TWinControl.CanTab
3764
3804
------------------------------------------------------------------------------}
3894
3934
    end;
3895
3935
  end;
3896
3936
 
 
3937
  procedure GetDefaults(var r: TRect);
 
3938
  begin
 
3939
    r:=inherited GetClientRect;
 
3940
    if csLoading in ComponentState then begin
 
3941
      if cfClientWidthLoaded in FControlFlags then
 
3942
        r.Right:=FLoadedClientSize.cx;
 
3943
      if cfClientHeightLoaded in FControlFlags then
 
3944
        r.Bottom:=FLoadedClientSize.cy;
 
3945
    end;
 
3946
  end;
 
3947
 
3897
3948
var
3898
3949
  InterfaceWidth, InterfaceHeight: integer;
3899
3950
begin
3904
3955
    then begin
3905
3956
      // the LCL interface provided a ClientRect
3906
3957
    end
3907
 
    else if HandleAllocated and (wcfBoundsRealized in FWinControlFlags) then
 
3958
    else if HandleAllocated then
3908
3959
    begin
3909
3960
      // update clientrect from interface
3910
3961
      LCLIntf.GetClientRect(Handle, Result);
3925
3976
      //if Name=CheckClientRectName then
3926
3977
        debugln('TWinControl.GetClientRect ',DbgSName(Self),' InterfaceSize=',dbgs(InterfaceWidth),',',dbgs(InterfaceHeight),' Result=',dbgs(Result),' Bounds=',dbgs(BoundsRect));
3927
3978
      {$ENDIF}
3928
 
 
3929
 
      Result.Right:=Width-(InterfaceWidth-Result.Right);
3930
 
      Result.Bottom:=Height-(InterfaceHeight-Result.Bottom);
 
3979
      if (Width<>InterfaceWidth)
 
3980
      or (Height<>InterfaceHeight) then
 
3981
      begin
 
3982
        // the LCL is not in sync with the interface
 
3983
        if wcfBoundsRealized in FWinControlFlags then
 
3984
        begin
 
3985
          // no bounds were sent yet to the interface and it didn't initialize
 
3986
          // them on its own
 
3987
          // => the client bounds from the interface are not yet ready
 
3988
          // they will probably change
 
3989
          // to avoid resizes it is better use the defaults
 
3990
          GetDefaults(Result);
 
3991
        end else begin
 
3992
          // -> adjust client rect based on LCL bounds
 
3993
          // for example: if the Width in LCL differ from the Width of the Interface
 
3994
          // object, then adjust the clientwidth accordingly
 
3995
          // this often anticipates later LM_SIZE messages from the interface
 
3996
          // and reduces resizes
 
3997
          inc(Result.Right,Width-InterfaceWidth);
 
3998
          inc(Result.Bottom,Height-InterfaceHeight);
 
3999
        end;
 
4000
      end;
3931
4001
    end else begin
3932
4002
      // no handle and no interface help => use defaults
3933
 
      Result:=inherited GetClientRect;
3934
 
      if csLoading in ComponentState then begin
3935
 
        if cfClientWidthLoaded in FControlFlags then
3936
 
          Result.Right:=FLoadedClientSize.cx;
3937
 
        if cfClientHeightLoaded in FControlFlags then
3938
 
          Result.Bottom:=FLoadedClientSize.cy;
3939
 
      end;
 
4003
      GetDefaults(Result);
3940
4004
    end;
3941
4005
    Result.Right:=Max(Result.Left,Result.Right);
3942
4006
    Result.Bottom:=Max(Result.Top,Result.Bottom);
4134
4198
begin
4135
4199
  if FTabStop = NewTabStop then
4136
4200
    Exit;
4137
 
 
4138
4201
  FTabStop := NewTabStop;
4139
4202
  UpdateTabOrder(FTabOrder);
4140
4203
  Perform(CM_TABSTOPCHANGED, 0, 0);
4151
4214
  begin
4152
4215
    FTabOrder := GetTabOrder;
4153
4216
    Count := ListCount(FParent.FTabList);
4154
 
    if NewTabOrder < 0 then NewTabOrder := Count;
4155
 
    if FTabOrder = -1 then Inc(Count);
4156
 
    if NewTabOrder >= Count then NewTabOrder := Count - 1;
 
4217
    if NewTabOrder < 0 then
 
4218
      NewTabOrder := Count;
 
4219
    if FTabOrder = -1 then
 
4220
      Inc(Count);
 
4221
    if NewTabOrder > Count then
 
4222
      NewTabOrder := Count;
4157
4223
    if NewTabOrder <> FTabOrder then
4158
4224
    begin
4159
4225
      if FTabOrder <> - 1 then
4160
4226
        ListDelete(FParent.FTabList,FTabOrder);
4161
4227
      if NewTabOrder <> -1 then
4162
4228
      begin
4163
 
        ListInsert(FParent.FTabList,NewTabOrder,Self);
 
4229
        if NewTabOrder = Count then
 
4230
          ListAdd(FParent.FTabList,Self)
 
4231
        else
 
4232
          ListInsert(FParent.FTabList,NewTabOrder,Self);
4164
4233
        FTabOrder := NewTabOrder;
4165
4234
      end;
4166
4235
    end;
4250
4319
begin
4251
4320
  bShow := HandleObjectShouldBeVisible;
4252
4321
 
4253
 
  if bShow then begin
 
4322
  if bShow then
 
4323
  begin
4254
4324
    if not HandleAllocated then CreateHandle;
4255
 
    if FControls <> nil
4256
 
    then begin
 
4325
    if Assigned(FControls) then
 
4326
    begin
4257
4327
      for n := 0 to FControls.Count - 1 do
4258
4328
        if TObject(FControls[n]) is TWinControl then
4259
4329
          TWinControl(FControls[n]).UpdateShowing;
4260
4330
    end;
4261
4331
  end;
4262
 
  if not HandleAllocated then begin
 
4332
  if not HandleAllocated then
 
4333
  begin
4263
4334
    {$IFDEF VerboseShowing}
4264
4335
    if bShow then
4265
4336
      DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' handle not allocated']);
4268
4339
  end;
4269
4340
 
4270
4341
  if FShowing = bShow then Exit;
4271
 
  //DebugLn('TWinControl.UpdateShowing A ',dbgsName(Self),' FShowing=',dbgs(FShowing),' bShow=',dbgs(bShow));
 
4342
  //DebugLn(['TWinControl.UpdateShowing ',dbgsName(Self),' FShowing=',dbgs(FShowing),' bShow=',dbgs(bShow), ' IsWindowVisible=', IsWindowVisible(FHandle)]);
4272
4343
  if bShow then
4273
4344
  begin
4274
4345
    // the Handle should become visible
4276
4347
    if AutoSizeDelayed or (not (caspShowing in AutoSizePhases)) then
4277
4348
    begin
4278
4349
      {$IFDEF VerboseShowing}
4279
 
      if AutoSizeDelayed then DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' SKIPPING because AutoSizeDelayed']);
 
4350
      if AutoSizeDelayed then DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' SKIPPING because AutoSizeDelayed: ',AutoSizeDelayedReport]);
4280
4351
      if (not (caspShowing in AutoSizePhases)) then DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' SKIPPING because wrong phase']);
4281
4352
      {$ENDIF}
4282
4353
      exit;
4483
4554
 
4484
4555
procedure TWinControl.FixupTabList;
4485
4556
var
4486
 
  Count, I, J: Integer;
 
4557
  I, J: Integer;
 
4558
  Control: TWinControl;
4487
4559
  List: TFPList;
4488
 
  Control: TWinControl;
4489
4560
  WinControls: TFPList;
4490
4561
begin
4491
4562
  if FControls <> nil then
4495
4566
    try
4496
4567
      for i:=0 to FControls.Count-1 do
4497
4568
        if TObject(FControls[i]) is TWinControl then
4498
 
          WinControls.Add(TWinControl(FControls[i]));
4499
 
      Count := WinControls.Count;
4500
 
      List.Count := Count;
4501
 
      for I := 0 to Count - 1 do
 
4569
          WinControls.Add(FControls[i]);
 
4570
      List.Count := WinControls.Count;
 
4571
      for I := 0 to WinControls.Count - 1 do
4502
4572
      begin
4503
4573
        Control := TWinControl(WinControls[I]);
4504
4574
        J := Control.FTabOrder;
4505
 
        if (J >= 0) and (J < Count) then List[J] := Control;
 
4575
        if (J >= 0) and (J < WinControls.Count) then
 
4576
          List[J] := Control;
4506
4577
      end;
4507
 
      for I := 0 to Count - 1 do
 
4578
      for I := 0 to List.Count - 1 do
4508
4579
      begin
4509
4580
        Control := TWinControl(List[I]);
4510
 
        if Control <> nil then Control.UpdateTabOrder(TTabOrder(I));
 
4581
        if Control <> nil then
 
4582
          Control.UpdateTabOrder(TTabOrder(I));
4511
4583
      end;
4512
4584
    finally
4513
4585
      List.Free;
4665
4737
    DebugLn('TWinControl.PaintHandler A ',Name,':',ClassName);
4666
4738
  {$ENDIF}
4667
4739
 
4668
 
  Assert(False, Format('Trace:> [TWinControl.PaintHandler] %s --> Msg.DC: 0x%x', [ClassName, TheMessage.DC]));
 
4740
  //DebugLn(Format('Trace:> [TWinControl.PaintHandler] %s --> Msg.DC: 0x%x', [ClassName, TheMessage.DC]));
4669
4741
  DC := TheMessage.DC;
4670
4742
  if DC = 0 then
4671
4743
    DC := BeginPaint(Handle, PS);
4711
4783
    if TheMessage.DC = 0 then
4712
4784
      EndPaint(Handle, PS);
4713
4785
  end;
4714
 
  Assert(False, Format('Trace:< [TWinControl.PaintHandler] %s', [ClassName]));
 
4786
  //DebugLn(Format('Trace:< [TWinControl.PaintHandler] %s', [ClassName]));
4715
4787
//DebugLn('[TWinControl.PaintHandler] END  ',Name,':',ClassName,'  DC=',DbgS(Message.DC,8));
4716
4788
end;
4717
4789
 
5155
5227
  Form: TCustomForm;
5156
5228
begin
5157
5229
  //debugln(['TWinControl.WndProc ',DbgSName(Self),' ',Message.Msg]);
5158
 
//  Assert(False, Format('Trace:[TWinControl.WndPRoc] %s(%s) --> Message = %d', [ClassName, Name, Message.Msg]));
 
5230
  //DebugLn(Format('Trace:[TWinControl.WndPRoc] %s(%s) --> Message = %d', [ClassName, Name, Message.Msg]));
5159
5231
  case Message.Msg of
5160
5232
    LM_SETFOCUS:
5161
5233
      begin
5162
 
        Assert(False, Format('Trace:[TWinControl.WndPRoc] %s --> LM_SETFOCUS', [ClassName]));
 
5234
        //DebugLn(Format('Trace:[TWinControl.WndPRoc] %s --> LM_SETFOCUS', [ClassName]));
5163
5235
        {$IFDEF VerboseFocus}
5164
5236
        DebugLn('TWinControl.WndProc LM_SetFocus ',DbgSName(Self));
5165
5237
        {$ENDIF}
5166
5238
        Form := GetParentForm(Self);
5167
5239
        if Assigned(Form) and not (csDestroyingHandle in ControlState) and not (csDestroying in ComponentState) then
5168
5240
        begin
5169
 
          if not Form.SetFocusedControl(Self) then Exit;
 
5241
          if not Form.SetFocusedControl(Self) then
 
5242
          begin
 
5243
            {$IFDEF VerboseFocus}
 
5244
            DebugLn('TWinControl.WndProc LM_SetFocus ',DbgSName(Self),' form=',DbgSName(Form),' Form.SetFocusedControl FAILED');
 
5245
            {$ENDIF}
 
5246
            Exit;
 
5247
          end;
5170
5248
          Message.Result := 0;
5171
5249
        end;
 
5250
        {$IFDEF VerboseFocus}
 
5251
        DebugLn('TWinControl.WndProc AFTER form LM_SetFocus ',DbgSName(Self));
 
5252
        {$ENDIF}
5172
5253
      end;
5173
5254
 
5174
5255
    LM_KILLFOCUS:
5175
5256
      begin
5176
 
        Assert(False, Format('Trace:[TWinControl.WndPRoc] %s --> _KILLFOCUS', [ClassName]));
5177
 
        if csFocusing in ControlState then begin
 
5257
        //DebugLn(Format('Trace:[TWinControl.WndPRoc] %s --> _KILLFOCUS', [ClassName]));
 
5258
        if csFocusing in ControlState then
 
5259
        begin
5178
5260
          {$IFDEF VerboseFocus}
5179
5261
          DebugLn('TWinControl.WndProc LM_KillFocus during focusing ',Name,':',ClassName);
5180
5262
          {$ENDIF}
5186
5268
    LM_NCHITTEST:
5187
5269
      begin
5188
5270
        inherited WndPRoc(Message);
5189
 
        if (Message.Result = HTTRANSPARENT)
5190
 
        and (ControlAtPos(ScreenToClient(SmallPointToPoint(TLMNCHitTest(Message).Pos)),
5191
 
                          False) <> nil)
5192
 
        then  Message.Result := HTCLIENT;
 
5271
        if (Message.Result = HTTRANSPARENT) and
 
5272
           Assigned(ControlAtPos(ScreenToClient(SmallPointToPoint(TLMNCHitTest(Message).Pos)), False)) then
 
5273
          Message.Result := HTCLIENT;
5193
5274
        Exit;
5194
5275
      end;
5195
5276
 
5446
5527
 ------------------------------------------------------------------------------}
5447
5528
procedure TWinControl.MainWndProc(var Msg: TLMessage);
5448
5529
begin
5449
 
  Assert(False, Format('Trace:[TWinControl.MainWndPRoc] %s(%s) --> Message = %d', [ClassName, Name, Msg.Msg]));
 
5530
  //DebugLn(Format('Trace:[TWinControl.MainWndPRoc] %s(%s) --> Message = %d', [ClassName, Name, Msg.Msg]));
5450
5531
end;
5451
5532
 
5452
5533
{------------------------------------------------------------------------------
5529
5610
end;
5530
5611
 
5531
5612
{------------------------------------------------------------------------------
5532
 
  Method: TWinControl.WantsKey
5533
 
  Params: CharCode - the key to inspect whether it is wanted
5534
 
  Returns: true if key is wanted before the interface handles it.
5535
 
 
5536
 
  Checks if control wants the passed key to handle before the interface.
5537
 
 ------------------------------------------------------------------------------}
5538
 
function TWinControl.WantsKeyBeforeInterface(Key: word; Shift: TShiftState
5539
 
  ): boolean;
5540
 
var
5541
 
  lWantKeys: dword;
5542
 
{ values for lWantKeys
5543
 
           0 - if not wanted
5544
 
           1 - if wanted, but is special (arrow)
5545
 
           2 - if wanted, but is special (tab)
5546
 
           4 - if wanted, but is special (all)
5547
 
           8 - if wanted, is normal key
5548
 
}
5549
 
begin
5550
 
  // For Delphi compatibility we send a LM_GETDLGCODE message to the control
5551
 
  // asking if it wants to handle the key.
5552
 
  // We don't define a default handler for LM_GETDLGCODE,
5553
 
  // so the default return is 0.
5554
 
  // Note: Contrary to Delphi/win32api, we don't know what keys are special,
5555
 
  // different widgetsets may have different sets of special keys;
5556
 
  lWantKeys := Perform(LM_GETDLGCODE, 0, 0);
5557
 
  if (lWantKeys and DLGC_WANTALLKEYS) <> 0 then
5558
 
  begin
5559
 
    lWantKeys := DLGC_WANTALLKEYS;
5560
 
  end else begin
5561
 
    case Key of
5562
 
    VK_TAB: 
5563
 
      lWantKeys := lWantKeys and DLGC_WANTTAB;
5564
 
    VK_UP, VK_LEFT, VK_DOWN, VK_RIGHT:
5565
 
      lWantKeys := lWantKeys and DLGC_WANTARROWS;
5566
 
    end;
5567
 
  end;  
5568
 
  Result := (lWantKeys<>0);
5569
 
end;
5570
 
 
5571
 
{------------------------------------------------------------------------------
5572
5613
  TWinControl DoKeyDownBeforeInterface
5573
5614
  
5574
5615
  returns true if handled
5578
5619
  function IsShortCut: Boolean;
5579
5620
  var
5580
5621
    AParent: TWinControl;
 
5622
    APopupMenu: TPopupMenu;
5581
5623
  begin
5582
5624
    Result := False;
5583
5625
    // check popup menu
5584
 
    if Assigned(FPopupMenu) and FPopupMenu.IsShortCut(Message) then
 
5626
    APopupMenu := PopupMenu;
 
5627
    if Assigned(APopupMenu) and APopupMenu.IsShortCut(Message) then
5585
5628
      Exit(True);
5586
5629
 
5587
5630
    if IsRecurseCall then
5613
5656
  begin
5614
5657
    if CharCode = VK_UNKNOWN then Exit;
5615
5658
    ShiftState := KeyDataToShiftState(KeyData);
5616
 
    
5617
 
    // let application handle the key
5618
 
    if not IsRecurseCall and Assigned(Application) then
5619
 
    begin
5620
 
      Application.NotifyKeyDownBeforeHandler(Self, CharCode, ShiftState);
5621
 
      if CharCode = VK_UNKNOWN then Exit;
5622
 
    end;
5623
5659
 
5624
 
    // let each parent form with keypreview handle the key
5625
5660
    if not IsRecurseCall then
5626
5661
    begin
 
5662
      // let application handle the key
 
5663
      if Assigned(Application) then
 
5664
      begin
 
5665
        Application.NotifyKeyDownBeforeHandler(Self, CharCode, ShiftState);
 
5666
        if CharCode = VK_UNKNOWN then Exit;
 
5667
      end;
 
5668
 
 
5669
      // let each parent form with keypreview handle the key
5627
5670
      AParent := Parent;
5628
5671
      while Assigned(AParent) do
5629
5672
      begin
5997
6040
  AdjustSize;
5998
6041
end;
5999
6042
 
 
6043
procedure TWinControl.ScrollBy(DeltaX, DeltaY: Integer);
 
6044
var
 
6045
  i: Integer;
 
6046
begin
 
6047
  // scroll inner controls
 
6048
  for i := 0 to ControlCount - 1 do
 
6049
    with Controls[i] do
 
6050
      SetBounds(Left + DeltaX, Top + DeltaY, Width, Height);
 
6051
end;
 
6052
 
6000
6053
{------------------------------------------------------------------------------
6001
6054
  TWinControl Remove
6002
6055
------------------------------------------------------------------------------}
6004
6057
begin
6005
6058
  if AControl <> nil then
6006
6059
  begin
6007
 
    Assert(False, Format('trace:[TWinControl.Remove] %s(%S) --> Remove: %s(%s)', [ClassName, Name, AControl.ClassName, AControl.Name]));
 
6060
    //DebugLn(Format('trace:[TWinControl.Remove] %s(%S) --> Remove: %s(%s)', [ClassName, Name, AControl.ClassName, AControl.Name]));
6008
6061
    if AControl is TWinControl then
6009
6062
      ListRemove(FTabList, AControl);
6010
6063
    ListRemove(FControls, AControl);
6063
6116
begin
6064
6117
  inherited WSRegisterClass;
6065
6118
  RegisterWinControl;
 
6119
  RegisterPropertyToSkip(TWinControl, 'ParentDoubleBuffered', 'VCL compatibility property', '');
 
6120
  RegisterPropertyToSkip(TWinControl, 'ImeMode', 'VCL compatibility property', '');
 
6121
  RegisterPropertyToSkip(TWinControl, 'ImeName', 'VCL compatibility property', '');
6066
6122
end;
6067
6123
 
6068
6124
function TWinControl.IsClientHeightStored: boolean;
6091
6147
{------------------------------------------------------------------------------
6092
6148
  TWinControl UpdateControlState
6093
6149
 
6094
 
  Called by: RecreateWnd, TCustomNotebook.ShowCurrentPage,
 
6150
  Called by: RecreateWnd, TCustomTabControl.ShowCurrentPage,
6095
6151
    TWinControl.SetParentWindow, TWinControl.InsertControl,
6096
6152
    TWinControl.CMVisibleChanged
6097
6153
------------------------------------------------------------------------------}
6361
6417
  begin
6362
6418
    Control := Controls[n - 1];
6363
6419
    //DebugLn('[TWinControl.Destroy] C  ',Name,':',ClassName,' ',Control.Name,':',Control.ClassName);
6364
 
    Remove(Control);
 
6420
    Remove(Control); // this sets Control.Parent to nil
6365
6421
    //DebugLn(['TWinControl.Destroy ',DbgSName(Control.HostDockSite)]);
6366
6422
    if Control.HostDockSite = Self then
6367
6423
      Control.HostDockSite := nil;
6368
 
    // don't free the control just set parent to nil
6369
 
    // controls are freed by the owner
6370
 
    //Control.Free;
6371
 
    Control.Parent := nil;
 
6424
    // don't free the control, controls are freed by the owner
6372
6425
    n := ControlCount;
6373
6426
  end;
6374
6427
 
6455
6508
    //if (not Enabled) then debugln('TWinControl.CMEnabledChanged disable ',Name,':',CLassName);
6456
6509
    EnableWindow(Handle, Enabled);
6457
6510
  end;
 
6511
  inherited;
6458
6512
end;
6459
6513
 
6460
6514
{------------------------------------------------------------------------------
6495
6549
 ------------------------------------------------------------------------------}
6496
6550
procedure TWinControl.WMSetFocus(var Message: TLMSetFocus);
6497
6551
begin
6498
 
  //DebugLn('TWinControl.WMSetFocus A ',Name,':',ClassName);
 
6552
  {$IFDEF VerboseFocus}
 
6553
  DebugLn('TWinControl.WMSetFocus A ',Name,':',ClassName);
 
6554
  {$ENDIF}
6499
6555
end;
6500
6556
 
6501
6557
{------------------------------------------------------------------------------
6510
6566
  ParentForm: TCustomForm;
6511
6567
begin
6512
6568
  //DebugLn('TWinControl.WMKillFocus A ',Name,':',ClassName);
6513
 
  Assert(False, Format('Trace: %s', [ClassName]));
 
6569
  //DebugLn(Format('Trace: %s', [ClassName]));
6514
6570
  if [csLoading,csDestroying,csDesigning]*ComponentState=[] then
6515
6571
  begin
6516
6572
    ParentForm := GetParentForm(Self);
6549
6605
    DebugLn('TWinControl.WMPaint A ',Name,':',ClassName);
6550
6606
  {$ENDIF}
6551
6607
 
6552
 
  Assert(False, Format('Trace:> [TWinControl.WMPaint] %s Msg.DC: 0x%x', [ClassName, Msg.DC]));
 
6608
  //DebugLn(Format('Trace:> [TWinControl.WMPaint] %s Msg.DC: 0x%x', [ClassName, Msg.DC]));
6553
6609
  if (Msg.DC <> 0) or not DoubleBuffered then
6554
6610
  begin
6555
6611
    if not (csCustomPaint in ControlState) and (ControlCount = 0) then
6607
6663
{$ENDIF}
6608
6664
    end;
6609
6665
  end;
6610
 
  Assert(False, Format('Trace:< [TWinControl.WMPaint] %s', [ClassName]));
 
6666
  //DebugLn(Format('Trace:< [TWinControl.WMPaint] %s', [ClassName]));
6611
6667
//DebugLn('[TWinControl.WMPaint] END ',Name,':',ClassName);
6612
6668
end;
6613
6669
 
6620
6676
 ------------------------------------------------------------------------------}
6621
6677
procedure TWinControl.WMDestroy(var Message: TLMDestroy);
6622
6678
begin
6623
 
  Assert(False, Format('Trace: [TWinControl.LMDestroy] %s', [ClassName]));
 
6679
  //DebugLn(Format('Trace: [TWinControl.LMDestroy] %s', [ClassName]));
6624
6680
  //DebugLn('TWinControl.WMDestroy ',Name,':',ClassName);
6625
6681
  // Our widget/window doesn't exist anymore
6626
6682
  Handle := 0;
6670
6726
    if CompareRect(@NewBoundsRealized,@FBoundsRealized) then exit;
6671
6727
 
6672
6728
    TopParent:=GetTopParent;
6673
 
    if (TopParent is TWinControl)
6674
 
      and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags)
6675
 
    then
 
6729
    if (TopParent is TWinControl) and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags) then
6676
6730
      RaiseLoop;
6677
6731
 
6678
6732
    FBoundsRealized := NewBoundsRealized;
6679
 
    if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[])
6680
 
    then begin
 
6733
    if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[]) then
 
6734
    begin
6681
6735
      // while the LCL is creating handles the widgetset may send default bounds
6682
6736
      // we have not yet told the widgetset the final bounds
6683
6737
      // => the InvalidatePreferredSize and the InvalidateClientRectCache
6689
6743
      exit;
6690
6744
    end;
6691
6745
  end;
6692
 
  if Parent<>nil then
 
6746
  if Assigned(Parent) then
6693
6747
    SetBoundsKeepBase(Message.XPos, Message.YPos, NewWidth, NewHeight)
6694
6748
  else
6695
6749
    SetBounds(Message.XPos, Message.YPos, NewWidth, NewHeight);
6730
6784
  {$IFDEF CHECK_POSITION}
6731
6785
  if CheckPosition(Self) then
6732
6786
  {$ENDIF}
6733
 
   if (Message.SizeType and Size_SourceIsInterface)>0 then
 
6787
   if (Message.SizeType and Size_SourceIsInterface) > 0 then
6734
6788
    DebugLn(['TWinControl.WMSize A ',Name,':',ClassName,' Message=',Message.Width,',',Message.Height,
6735
6789
      ' BoundsRealized=',dbgs(FBoundsRealized),
6736
6790
      ' WChg=',FBoundsRealized.Right-FBoundsRealized.Left<>Message.Width,
6738
6792
      ' FromIntf=',(Message.SizeType and Size_SourceIsInterface)>0,' ClientRectInvalid=',ClientRectNeedsInterfaceUpdate]);
6739
6793
  {$ENDIF}
6740
6794
 
6741
 
  NewLeft:=Left;
6742
 
  NewTop:=Top;
 
6795
  NewLeft := Left;
 
6796
  NewTop := Top;
6743
6797
  if ((Message.SizeType and Size_SourceIsInterface) > 0) then
6744
6798
  begin
6745
6799
    // interface widget has resized
6763
6817
      GetWindowRelativePosition(Handle, NewLeft, NewTop);
6764
6818
    //DebugLn('TWinControl.WMSize B ',Name,':',ClassName,' ',NewLeft,',',NewTop);
6765
6819
    NewBoundsRealized := Bounds(NewLeft, NewTop, Message.Width, Message.Height);
6766
 
    OldClientSize:=Size(0,0);
6767
 
    NewClientSize:=Size(0,0);
6768
 
    if CompareRect(@NewBoundsRealized,@FBoundsRealized) then begin
6769
 
      if not (wcfClientRectNeedsUpdate in FWinControlFlags) then begin
6770
 
        OldClientSize:=Size(FClientWidth,FClientHeight);
6771
 
        NewClientSize:=Size(ClientWidth,ClientHeight);
6772
 
        if (OldClientSize.cx=NewClientSize.cx)
6773
 
        and (OldClientSize.cy=NewClientSize.cy) then exit;
 
6820
    OldClientSize := Size(0, 0);
 
6821
    NewClientSize := Size(0, 0);
 
6822
    if CompareRect(@NewBoundsRealized, @FBoundsRealized) then
 
6823
    begin
 
6824
      if not (wcfClientRectNeedsUpdate in FWinControlFlags) then
 
6825
      begin
 
6826
        OldClientSize := Size(FClientWidth, FClientHeight);
 
6827
        NewClientSize := Size(ClientWidth, ClientHeight);
 
6828
        if (OldClientSize.cx = NewClientSize.cx) and
 
6829
           (OldClientSize.cy = NewClientSize.cy) then
 
6830
           Exit;
6774
6831
      end;
6775
6832
    end;
6776
6833
    {$IFDEF VerboseAllAutoSize}
6779
6836
      ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]);
6780
6837
    {$ENDIF}
6781
6838
 
6782
 
    TopParent:=GetTopParent;
6783
 
    if (TopParent is TWinControl)
6784
 
      and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags)
6785
 
    then
 
6839
    TopParent := GetTopParent;
 
6840
    if (TopParent is TWinControl) and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags) then
6786
6841
      RaiseLoop;
6787
6842
 
6788
6843
    FBoundsRealized := NewBoundsRealized;
6789
6844
    //DebugLn(['TWinControl.WMSize ',DbgSName(Self),' phases=',dbgs(AutoSizePhases)]);
6790
 
    if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[])
6791
 
    then begin
 
6845
    if ([caspCreatingHandles, caspComputingBounds] * AutoSizePhases <> []) then
 
6846
    begin
6792
6847
      // while the LCL is creating handles the widgetset may send default bounds
6793
6848
      // we have not yet told the widgetset the final bounds
6794
6849
      // => the InvalidatePreferredSize and the InvalidateClientRectCache
6797
6852
      // => do not call SetBounds, as this will set the Bounds to the widgetset
6798
6853
      //    default values.
6799
6854
      //DebugLn(['TWinControl.WMSize from intf ignored, because phases=',dbgs(AutoSizePhases),' boundsrealized=',wcfBoundsRealized in FWinControlFlags]);
6800
 
      exit;
 
6855
      Exit;
6801
6856
    end;
6802
6857
 
6803
 
    if Parent<>nil then
 
6858
    if Assigned(Parent) then
6804
6859
      InvalidatePreferredSize;
6805
6860
  end;
6806
6861
 
6807
 
  if Parent<>nil then
 
6862
  if Assigned(Parent) then
6808
6863
    SetBoundsKeepBase(NewLeft, NewTop, Message.Width, Message.Height)
6809
6864
  else
6810
6865
    SetBounds(NewLeft, NewTop, Message.Width, Message.Height);
6811
 
  if ((Message.SizeType and Size_SourceIsInterface) > 0)
6812
 
  and ClientRectNeedsInterfaceUpdate then
 
6866
  if ((Message.SizeType and Size_SourceIsInterface) > 0) and ClientRectNeedsInterfaceUpdate then
6813
6867
    DoAdjustClientRectChange;
6814
6868
  {$IFDEF VerboseClientRectBugFix}
6815
6869
  //if Name=CheckClientRectName then
6842
6896
  end;
6843
6897
 
6844
6898
begin
6845
 
  if Message.WindowPos=nil then exit;
 
6899
  if not Assigned(Message.WindowPos) or
 
6900
    ((Message.WindowPos^.flags and SWP_SourceIsInterface) = 0) then
 
6901
  begin
 
6902
    inherited WMWindowPosChanged(Message);
 
6903
    Exit;
 
6904
  end;
6846
6905
 
6847
6906
  {$IFDEF VerboseAllAutoSize}
6848
6907
  DebugLn(DbgSName(Self) + ' : ' + DbgSWindowPosFlags(Message.WindowPos^.flags));
6861
6920
    ' BoundsRealized=',dbgs(FBoundsRealized),' FromIntf=',(Message.WindowPos^.flags and SWP_SourceIsInterface)>0,' ClientRectInvalid=',ClientRectNeedsInterfaceUpdate]);
6862
6921
  {$ENDIF}
6863
6922
 
6864
 
  if (Message.WindowPos=nil)
6865
 
  or ((Message.WindowPos^.flags and SWP_SourceIsInterface) = 0) then begin
6866
 
    inherited WMWindowPosChanged(Message);
6867
 
    exit;
6868
 
  end;
6869
 
 
6870
6923
  // interface widget has moved/resized
6871
6924
  // -> update realized bounds
6872
6925
  {$IFDEF VerboseAllAutoSize}
6986
7039
  c: TUTF8Char;
6987
7040
begin
6988
7041
  //debugln('TWinControl.CNChar B ',DbgSName(Self),' ',dbgs(Message.CharCode),' ',dbgs(IntfSendsUTF8KeyPress));
6989
 
  if not IntfSendsUTF8KeyPress then
 
7042
  if Widgetset.GetLCLCapability(lcSendsUTF8KeyPress) = LCL_CAPABILITY_NO then
6990
7043
  begin
6991
7044
    // current interface does not (yet) send UTF8 key press notifications
6992
7045
    // -> emulate
7050
7103
 ------------------------------------------------------------------------------}
7051
7104
procedure TWinControl.WMShowWindow(var Message: TLMShowWindow);
7052
7105
begin
7053
 
  Assert(False, Format('Trace: TODO: [TWinControl.LMShowWindow] %s', [ClassName]));
 
7106
  // DebugLn(['TWinControl.LMShowWindow ', dbgsName(self)]);
7054
7107
end;
7055
7108
 
7056
7109
{------------------------------------------------------------------------------
7062
7115
 ------------------------------------------------------------------------------}
7063
7116
procedure TWinControl.WMEnter(var Message: TLMEnter);
7064
7117
begin
7065
 
  Assert(False, Format('Trace: TODO: [TWinControl.LMEnter] %s', [ClassName]));
 
7118
  //DebugLn(Format('Trace: TODO: [TWinControl.LMEnter] %s', [ClassName]));
7066
7119
end;
7067
7120
 
7068
7121
{------------------------------------------------------------------------------
7090
7143
 ------------------------------------------------------------------------------}
7091
7144
procedure TWinControl.WMExit(var Message: TLMExit);
7092
7145
begin
7093
 
  Assert(False, Format('Trace: TODO: [TWinControl.LMExit] %s', [ClassName]));
 
7146
  //DebugLn(Format('Trace: TODO: [TWinControl.LMExit] %s', [ClassName]));
7094
7147
end;
7095
7148
 
7096
7149
{------------------------------------------------------------------------------
7106
7159
  //debugln('TWinControl.WMChar ',DbgSName(Self),' ',dbgs(Message.CharCode));
7107
7160
  if SendDialogChar(Message) then
7108
7161
    Message.Result := 1;
7109
 
  Assert(False, Format('Trace:[TWinControl.WMChar] %s', [ClassName]));
 
7162
  //DebugLn(Format('Trace:[TWinControl.WMChar] %s', [ClassName]));
7110
7163
end;
7111
7164
 
7112
7165
{------------------------------------------------------------------------------
7199
7252
 
7200
7253
begin
7201
7254
  //DebugLn('[TWinControl.CreateWnd] START ',DbgSName(Self));
7202
 
  if (csDestroying in ComponentState)
7203
 
  or (Parent<>nil) and (csDestroying in Parent.ComponentState) then begin
 
7255
  if (csDestroying in ComponentState) or Assigned(Parent) and (csDestroying in Parent.ComponentState) then
 
7256
  begin
7204
7257
    DebugLn('[TWinControl.CreateWnd] NOTE: csDestroying ',DbgSName(Self));
7205
7258
    RaiseGDBException('');
7206
7259
    exit;
7207
7260
  end;
7208
7261
 
7209
 
  if wcfInitializing in FWinControlFlags
7210
 
  then begin
 
7262
  if wcfInitializing in FWinControlFlags then
 
7263
  begin
7211
7264
    DebugLn('[WARNING] Recursive call to CreateWnd for ',DbgSName(Self), ' while initializing');
7212
7265
    RaiseGDBException('');
7213
7266
    Exit;
7214
7267
  end;
7215
7268
 
7216
 
  if wcfCreatingHandle in FWinControlFlags
7217
 
  then begin
 
7269
  if wcfCreatingHandle in FWinControlFlags then
 
7270
  begin
7218
7271
    DebugLn('[WARNING] Recursive call to CreateWnd for ',DbgSName(Self), ' while creating handle');
7219
7272
    RaiseGDBException('');
7220
7273
    Exit;
7221
7274
  end;
7222
7275
 
7223
 
  if wcfCreatingChildHandles in FWinControlFlags
7224
 
  then begin
 
7276
  if wcfCreatingChildHandles in FWinControlFlags then
 
7277
  begin
7225
7278
    DebugLn('[WARNING] Recursive call to CreateWnd for ',DbgSName(Self), ' while creating children');
7226
7279
    RaiseGDBException('');
7227
7280
    Exit;
7228
7281
  end;
7229
7282
  
7230
 
  if [csLoading,csDesigning]*ComponentState=[csLoading] then begin
 
7283
  if [csLoading,csDesigning]*ComponentState=[csLoading] then
 
7284
  begin
7231
7285
    DebugLn('[HINT] TWinControl.CreateWnd creating Handle during loading ',DbgSName(Self),' csDesigning=',dbgs(csDesigning in ComponentState));
7232
7286
    //DumpStack;
7233
7287
    //RaiseGDBException('');
7234
7288
  end;
7235
7289
 
7236
 
  FBoundsRealized:=Rect(0,0,0,0);
7237
 
  Exclude(FWinControlFlags,wcfBoundsRealized);
 
7290
  FBoundsRealized := Rect(0,0,0,0);
 
7291
  Exclude(FWinControlFlags, wcfBoundsRealized);
7238
7292
 
7239
7293
  DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.CreateWnd'){$ENDIF};
7240
7294
  try
7241
 
    if (Parent<>nil) and (not Parent.HandleAllocated) then
 
7295
    if Assigned(Parent) and not Parent.HandleAllocated then
7242
7296
    begin
7243
7297
      // first create the parent handle
7244
7298
      Parent.HandleNeeded;
7249
7303
    FShowing := False;
7250
7304
    Exclude(FWinControlFlags, wcfHandleVisible);
7251
7305
 
7252
 
    Include(FWinControlFlags,wcfCreatingHandle);
 
7306
    Include(FWinControlFlags, wcfCreatingHandle);
7253
7307
    try
7254
7308
      CreateParams(Params);
7255
7309
      with Params do
7263
7317
 
7264
7318
      //DebugLn(['TWinControl.CreateWnd Creating handle ... ',DbgSName(WidgetSetClass),' ',DbgSName(Self)]);
7265
7319
      FHandle := TWSWinControlClass(WidgetSetClass).CreateHandle(Self, Params);
7266
 
      if not HandleAllocated then begin
 
7320
      if not HandleAllocated then
 
7321
      begin
7267
7322
        if WidgetSet.LCLPlatform=lpNoGUI then
7268
7323
          RaiseGDBException('TWinControl.CreateWnd: The nogui widgetset does not support visual controls.')
7269
7324
        else
7278
7333
      TWSWinControlClass(WidgetSetClass).ConstraintsChange(Self);
7279
7334
 
7280
7335
      //WriteClientRect('A');
7281
 
      if Parent <> nil then
 
7336
      if Assigned(Parent) then
7282
7337
        AddControl
7283
7338
      else
7284
7339
      if ParentWindow <> 0 then
7316
7371
    end;
7317
7372
 
7318
7373
    InvalidatePreferredSize;
7319
 
    if FControls<>nil then
7320
 
      for i:=0 to FControls.Count-1 do
 
7374
    if Assigned(FControls) then
 
7375
      for i := 0 to FControls.Count - 1 do
7321
7376
        TControl(FControls[i]).InvalidatePreferredSize;
7322
7377
    // size this control
7323
7378
    AdjustSize;
7348
7403
var
7349
7404
  CachedText: string;
7350
7405
begin
7351
 
  Assert(False, Format('Trace:[TWinControl.InitializeWnd]  %s', [ClassName]));
 
7406
  //DebugLn(Format('Trace:[TWinControl.InitializeWnd]  %s', [ClassName]));
7352
7407
  // set all cached properties
7353
7408
 
7354
7409
  //DebugLn('[TWinControl.InitializeWnd] ',Name,':',ClassName,':', FCaption,' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height));
7368
7423
    begin
7369
7424
      // replace by update style call
7370
7425
      TWSWinControlClass(WidgetSetClass).SetColor(Self);
7371
 
      FWinControlFlags:=FWinControlFlags-[wcfColorChanged];
 
7426
      Exclude(FWinControlFlags, wcfColorChanged);
7372
7427
    end;
7373
7428
    if wcfFontChanged in FWinControlFlags then
7374
7429
    begin
7375
7430
      // replace by update style call
7376
7431
      TWSWinControlClass(WidgetSetClass).SetFont(Self,Font);
7377
 
      FWinControlFlags:=FWinControlFlags-[wcfFontChanged];
 
7432
      Exclude(FWinControlFlags, wcfFontChanged);
7378
7433
    end;
7379
7434
 
7380
7435
    if not (csDesigning in ComponentState) then
7388
7443
      InvalidatePreferredSize;
7389
7444
    end;
7390
7445
 
7391
 
    if csDesigning in ComponentState
7392
 
    then TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[crDefault])
7393
 
    else TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[Cursor]);
 
7446
    if csDesigning in ComponentState then
 
7447
      TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[crDefault])
 
7448
    else
 
7449
      TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[Cursor]);
7394
7450
  finally
7395
7451
    EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.InitializeWnd'){$ENDIF};
7396
7452
  end;
7597
7653
  begin
7598
7654
    if Parent = Self
7599
7655
    then begin
7600
 
      Assert(False, Format('Trace:[TWinControl.HandleNeeded] Somebody set Parent := Self in %s. DONT DO THAT !!', [Classname]));
 
7656
      //DebugLn(Format('Trace:[TWinControl.HandleNeeded] Somebody set Parent := Self in %s. DONT DO THAT !!', [Classname]));
7601
7657
    end
7602
7658
    else begin
7603
7659
      if (Parent <> nil) then
7608
7664
          exit;
7609
7665
      end;
7610
7666
    end;
7611
 
  
7612
 
    Assert(not ParentDestroyingHandle, Format('WARNING:[TWinControl.HandleNeeded] creating handle for %s while destroying handles!', [ClassName]));
7613
7667
    CreateHandle;
7614
7668
  end;
7615
7669
end;
7616
7670
 
7617
7671
function TWinControl.BrushCreated: Boolean;
7618
7672
begin
7619
 
  Result := FBrush <> nil;
 
7673
  Result := Assigned(FBrush);
7620
7674
end;
7621
7675
 
7622
7676
{------------------------------------------------------------------------------
8034
8088
 ------------------------------------------------------------------------------}
8035
8089
procedure TWinControl.CMVisibleChanged(var Message : TLMessage);
8036
8090
begin
8037
 
  if not FVisible and (Parent <> nil) then
 
8091
  if not FVisible and Assigned(Parent) then
8038
8092
    RemoveFocus(False);
8039
8093
 
8040
8094
  if not (csDesigning in ComponentState) or (csNoDesignVisible in ControlStyle) then
8057
8111
begin
8058
8112
  // find if at the click place we have a control and if so then pass the message
8059
8113
  // to it
8060
 
 
8061
8114
  // don't check csDesigning here - let a child control to check it
8062
8115
  if (Message.Result <> 0) then
8063
8116
    Exit;
8064
8117
 
8065
8118
  if Message.XPos <> -1 then
8066
8119
  begin
8067
 
    // don't allow disabled and don't search wincontrols - they recieve their
 
8120
    // don't allow disabled and don't search wincontrols - they receive their
8068
8121
    // message themself
8069
8122
    Child := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), []);
8070
8123
    if Assigned(Child) then
8083
8136
var
8084
8137
  NewVisible: Boolean;
8085
8138
begin
8086
 
  NewVisible:=HandleObjectShouldBeVisible;
8087
 
  if NewVisible<>(wcfHandleVisible in FWinControlFlags) then begin
 
8139
  NewVisible := HandleObjectShouldBeVisible;
 
8140
  if NewVisible <> (wcfHandleVisible in FWinControlFlags) then
 
8141
  begin
8088
8142
    if NewVisible then
8089
 
      Include(FWinControlFlags,wcfHandleVisible)
 
8143
      Include(FWinControlFlags, wcfHandleVisible)
8090
8144
    else
8091
 
      Exclude(FWinControlFlags,wcfHandleVisible);
 
8145
      Exclude(FWinControlFlags, wcfHandleVisible);
8092
8146
    {$IF defined(VerboseNewAutoSize) or defined(VerboseIntfSizing) or defined(VerboseShowing)}
8093
8147
    DebugLn(['TWinControl.DoSendShowHideToInterface ',DbgSName(Self),' FBoundsRealized=',dbgs(FBoundsRealized),' New=',HandleObjectShouldBeVisible]);
8094
8148
    {$ENDIF}
8110
8164
  OldBounds: TRect;
8111
8165
  {$ENDIF}
8112
8166
begin
8113
 
  if (Parent=nil) and (not HandleObjectShouldBeVisible) then begin
 
8167
  if (Parent = nil) and (not HandleObjectShouldBeVisible) then
 
8168
  begin
8114
8169
    { do not move invisible forms
8115
8170
       Reason: It is common to do this:
8116
8171
            Form1:=TForm1.Create(nil);
8119
8174
            Form1.Show;
8120
8175
       This moves the form around and confuses some windowmanagers.
8121
8176
       Only send the last bounds. }
8122
 
    exit;
 
8177
    Exit;
8123
8178
  end;
8124
 
  NewBounds:=Bounds(Left, Top, Width, Height);
 
8179
  NewBounds := Bounds(Left, Top, Width, Height);
8125
8180
  {$IF defined(VerboseResizeFlicker) or defined(VerboseSizeMsg)}
8126
8181
  if HandleAllocated then begin
8127
8182
    GetWindowRelativePosition(Handle,OldBounds.Left,OldBounds.Top);
8164
8219
    ' -> NewBounds=',dbgs(NewBounds));
8165
8220
  end;
8166
8221
  {$ENDIF}
8167
 
  FBoundsRealized:=NewBounds;
8168
 
  OldClientRect:=ClientRect;
8169
 
  Include(FWinControlFlags,wcfBoundsRealized); // Note: set before calling widgetset, because used in WMSize
 
8222
  FBoundsRealized := NewBounds;
 
8223
  OldClientRect := ClientRect;
 
8224
  Include(FWinControlFlags, wcfBoundsRealized); // Note: set before calling widgetset, because used in WMSize
8170
8225
  //if Parent=nil then DebugLn(['TWinControl.DoSendBoundsToInterface ',DbgSName(Self),' ',dbgs(BoundsRect)]);
8171
8226
  // this can trigger WMSize messages
8172
8227
  TWSWinControlClass(WidgetSetClass).SetBounds(Self, Left, Top, Width, Height);
8173
 
  NewClientRect:=ClientRect;
8174
 
  if not CompareRect(@OldClientRect,@NewClientRect) then begin
 
8228
  NewClientRect := ClientRect;
 
8229
  if not CompareRect(@OldClientRect,@NewClientRect) then
 
8230
  begin
8175
8231
    // the widgetset has changed the clientrect
8176
8232
    //DebugLn(['TWinControl.DoSendBoundsToInterface ',DbgSName(Self),' Bounds=',dbgs(BoundsRect),' OldClientRect=',dbgs(OldClientRect),' NewClientRect=',dbgs(NewClientRect)]);
8177
8233
    AdjustSize;
8240
8296
var
8241
8297
  i: Integer;
8242
8298
  OldRealizing: boolean;
8243
 
  AWinControl: TWinControl;
 
8299
  AControl: TControl;
8244
8300
begin
8245
8301
  if not HandleAllocated then exit;
8246
8302
  OldRealizing:=wcfRealizingBounds in FWinControlFlags;
8248
8304
  try
8249
8305
    if FControls<>nil then begin
8250
8306
      for i:=0 to FControls.Count-1 do begin
8251
 
        AWinControl:=TWinControl(FControls[i]);
8252
 
        if (AWinControl is TWinControl) then
8253
 
          TWinControl(FControls[i]).RealizeBoundsRecursive;
 
8307
        AControl:=TControl(FControls[i]);
 
8308
        if (AControl is TWinControl) then
 
8309
          TWinControl(AControl).RealizeBoundsRecursive;
8254
8310
      end;
8255
8311
    end;
8256
8312
    RealizeBounds;
8257
8313
  finally
8258
 
    if OldRealizing then
 
8314
    if not OldRealizing then
8259
8315
      Exclude(FWinControlFlags,wcfRealizingBounds);
8260
8316
  end;
8261
8317
end;
8276
8332
  if HandleAllocated and ([csDestroying,csLoading]*ComponentState=[]) then
8277
8333
    DoSendShowHideToInterface
8278
8334
  else
8279
 
    Exclude(FWinControlFlags,wcfHandleVisible);
 
8335
    Exclude(FWinControlFlags, wcfHandleVisible);
8280
8336
end;
8281
8337
 
8282
8338
{------------------------------------------------------------------------------