fixed updating TScrollBar.Constraints on chaning Kind

git-svn-id: trunk@7682 -

lcl/controls.pp

@@ -787,6 +787,7 @@ type
     FPopupMenu: TPopupMenu;
     FPreferredWidth: integer;
     FPreferredHeight: integer;
+    FReadBounds: TRect;
     FSessionProperties: string;
     FShowHint: Boolean;
     FSizeLock: integer;
@@ -874,10 +875,6 @@ type
     procedure DoOnChangeBounds; virtual;
     procedure Resize; virtual;
     procedure RequestAlign; dynamic;
-    procedure UpdateBaseBounds(StoreBounds, StoreParentClientSize,
-                               UseLoadedValues: boolean); virtual;
-    procedure LockBaseBounds;
-    procedure UnlockBaseBounds;
     procedure UpdateAnchorRules;
     procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer); virtual;
     procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); virtual;
@@ -1061,13 +1058,19 @@ type
     procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
     procedure SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
     procedure SetBoundsKeepBase(aLeft, aTop, aWidth, aHeight: integer;
-                                Lock: boolean); virtual;
+                                Lock: boolean = true); virtual;
     procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer;
                                Raw: boolean); virtual;
     procedure CNPreferredSizeChanged;
     procedure InvalidatePreferredSize; virtual;
     procedure DisableAutoSizing;
     procedure EnableAutoSizing;
+    procedure UpdateBaseBounds(StoreBounds, StoreParentClientSize,
+                               UseLoadedValues: boolean); virtual;
+    procedure LockBaseBounds;
+    procedure UnlockBaseBounds;
+    property BaseBounds: TRect read FBaseBounds;
+    property ReadBounds: TRect read FReadBounds;
   public
     constructor Create(TheOwner: TComponent);override;
     destructor Destroy; override;

lcl/include/control.inc

@@ -2496,12 +2496,13 @@ begin
   and (NewBaseParentClientSize.X=FBaseParentClientSize.X)
   and (NewBaseParentClientSize.Y=FBaseParentClientSize.Y)
   then exit;
-  {if csDesigning in ComponentState then
-  DebugLn('TControl.UpdateBaseBounds ',Name,':',ClassName,
-    ' OldBounds=',FBaseBounds.Left,',',FBaseBounds.Top,',',FBaseBounds.Right-FBaseBounds.Left,',',FBaseBounds.Bottom-FBaseBounds.Top,
-    ' OldClientSize=',FBaseParentClientSize.X,',',FBaseParentClientSize.Y,
-    ' NewBounds=',NewBaseBounds.Left,',',NewBaseBounds.Top,',',NewBaseBounds.Right-NewBaseBounds.Left,',',NewBaseBounds.Bottom-NewBaseBounds.Top,
-    ' NewClientSize=',NewBaseParentClientSize.X,',',NewBaseParentClientSize.Y,
+  //if csDesigning in ComponentState then
+  {if CompareText(ClassName,'TScrollBar')=0 then
+    DebugLn('TControl.UpdateBaseBounds '+dbgs(Self)+
+    ' OldBounds='+dbgs(FBaseBounds)+
+    ' OldClientSize='+dbgs(FBaseParentClientSize)+
+    ' NewBounds='+dbgs(NewBaseBounds)+
+    ' NewClientSize='+dbgs(NewBaseParentClientSize)+
     '');}
   FBaseBounds:=NewBaseBounds;
   FBaseParentClientSize:=NewBaseParentClientSize;
@@ -2568,6 +2569,10 @@ begin
   {$IFDEF CHECK_POSITION}
   DebugLn('[TControl.SetLeft] ',Name,':',ClassName,' ',Value);
   {$ENDIF}
+  if csLoading in ComponentState then begin
+    inc(FReadBounds.Right,Value-FReadBounds.Left);
+    FReadBounds.Left:=Value;
+  end;
   SetBounds(Value, FTop, FWidth, FHeight);
 end;
 
@@ -2579,6 +2584,10 @@ begin
   {$IFDEF CHECK_POSITION}
   DebugLn('[TControl.SetTop] ',Name,':',ClassName,' ',Value);
   {$ENDIF}
+  if csLoading in ComponentState then begin
+    inc(FReadBounds.Bottom,Value-FReadBounds.Top);
+    FReadBounds.Top:=Value;
+  end;
   SetBounds(FLeft, Value, FWidth, FHeight);
 end;
 
@@ -2602,8 +2611,10 @@ procedure TControl.SetWidth(Value: Integer);
 
 begin
   {$IFDEF CHECK_POSITION}
-  DebugLn('[TControl.SetWidth] ',Name,':',ClassName,' ',Value);
+  DebugLn('[TControl.SetWidth] ',Name,':',ClassName,' ',dbgs(Value));
   {$ENDIF}
+  if csLoading in ComponentState then
+    FReadBounds.Right:=FReadBounds.Left+Value;
   if [csDesigning,csDestroying,csLoading]*ComponentState=[csDesigning] then
     CheckDesignBounds;
   SetBounds(FLeft, FTop, Max(0,Value), FHeight);
@@ -2629,8 +2640,10 @@ procedure TControl.SetHeight(Value: Integer);
 
 begin
   {$IFDEF CHECK_POSITION}
-  DebugLn('[TControl.SetHeight] ',Name,':',ClassName,' ',Value);
+  DebugLn('[TControl.SetHeight] ',Name,':',ClassName,' ',dbgs(Value));
   {$ENDIF}
+  if csLoading in ComponentState then
+    FReadBounds.Bottom:=FReadBounds.Top+Value;
   if [csDesigning,csDestroying,csLoading]*ComponentState=[csDesigning] then
     CheckDesignBounds;
   SetBounds(FLeft, FTop, FWidth, Max(0,Value));

lcl/include/scrollbar.inc

@@ -80,15 +80,23 @@ var
   OldWidth: Integer;
   OldHeight: Integer;
 begin
-  if FKind <> Value then
-  begin
+  if FKind <> Value then begin
     FKind := Value;
     // switch width and height
     OldWidth:=Width;
     OldHeight:=Height;
+    if csLoading in ComponentState then begin
+      if ReadBounds.Right>ReadBounds.Left then
+        OldWidth:=ReadBounds.Right-ReadBounds.Left;
+      if ReadBounds.Bottom>ReadBounds.Top then
+        OldHeight:=ReadBounds.Bottom-ReadBounds.Top;
+      //debugln('TCustomScrollBar.SetKind ',DbgSName(Self),' ',dbgs(ReadBounds),' OldWidth=',dbgs(OldWidth),' OldHeight=',dbgs(OldHeight));
+    end;
     // TODO: Remove RecreateWnd
-    if HandleAllocated
-    then RecreateWnd(Self);
+    if HandleAllocated then
+      RecreateWnd(Self)
+    else
+      Constraints.UpdateInterfaceConstraints;
     SetBounds(Left,Top,OldHeight,OldWidth);
   end;
 end;

lcl/include/wincontrol.inc

@@ -201,7 +201,7 @@ var
 
   begin
     {$IFDEF CHECK_POSITION}
-    if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
+    if CompareText(Control.ClassName,'TScrollBar')=0 then
     with Control do
       DebugLn('[TWinControl.AlignControls.DoPosition] A Control=',Name,':',ClassName,' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height),' recalculate the anchors=',dbgs(Control.Anchors <> AnchorAlign[AAlign]),' Align=',AlignNames[AAlign]);
     {$ENDIF}
@@ -3887,6 +3887,7 @@ begin
     FHandle := TWSWinControlClass(WidgetSetClass).CreateHandle(Self, Params);
     if not HandleAllocated then
       RaiseGDBException('Handle creation failed creating '+DbgSName(Self));
+    //debugln('TWinControl.CreateWnd ',DbgSName(Self));
     Constraints.UpdateInterfaceConstraints;
     InvalidatePreferredSize;
     TWSWinControlClass(WidgetSetClass).ConstraintsChange(Self);
@@ -3932,28 +3933,6 @@ begin
   //WriteClientRect('D');
 end;
 
-{------------------------------------------------------------------------------
-  procedure TWinControl.CreateComponent(TheOwner : TComponent);
-------------------------------------------------------------------------------}
-(*
-procedure TWinControl.CreateComponent(TheOwner : TComponent);
-
-  procedure RaiseError(const Msg: string);
-  begin
-    RaiseGDBException('TWinControl.CreateComponent: '+Name+':'+ClassName+' '+Msg);
-  end;
-
-begin
-  if HandleAllocated then
-    RaiseError('Handle already created');
-  CNSendMessage(LM_CREATE, Self, nil);
-  Constraints.UpdateInterfaceConstraints;
-  FFlags:=FFlags-[wcfColorChanged,wcfFontChanged];
-  if not HandleAllocated then
-    RaiseError('Handle creation failed');
-end;
-*)
-
 {------------------------------------------------------------------------------
   TWinControl Destroy Component
 ------------------------------------------------------------------------------}

lcl/interfaces/gtk/gtklclintf.inc

@@ -168,7 +168,7 @@ begin
         Widget:=GetStyleWidget(lgsVerticalScrollbar);
         MinWidth:=Widget^.requisition.Width;
       end;
-      //DebugLn('TGtkWidgetSet.GetControlConstraints A ',MinWidth,',',MinHeight,' ',TScrollBar(SizeConstraints.Control).Kind=sbHorizontal,' ',TScrollBar(SizeConstraints.Control).Name);
+      //DebugLn('TGtkWidgetSet.GetControlConstraints A '+dbgs(MinWidth)+','+dbgs(MinHeight),' ',dbgs(TScrollBar(SizeConstraints.Control).Kind=sbHorizontal),' ',TScrollBar(SizeConstraints.Control).Name);
       SizeConstraints.SetInterfaceConstraints(MinWidth,MinHeight,
                                               MinWidth,MinHeight);
       exit;