LCL: fixed updating control scrollbars, remaining bug: win32 intf moves controls when scrolling

git-svn-id: trunk@10317 -

lcl/forms.pp

@@ -88,6 +88,8 @@ type
     FRange: Integer;
     FSmooth : Boolean;
     FVisible: Boolean;
+    FOldScrollInfo: TScrollInfo;
+    FOldScrollInfoValid: Boolean;
   protected
     FControl: TWinControl;
     function ControlAutoScroll: boolean; virtual;
@@ -113,6 +115,7 @@ type
     procedure SetSmooth(const Value: Boolean); virtual;
     procedure SetVisible(const Value: Boolean); virtual;
     procedure UpdateScrollBar; virtual;
+    procedure InvalidateScollInfo;
   public
     constructor Create(AControl: TWinControl; AKind: TScrollBarKind);
     procedure Assign(Source: TPersistent); override;
@@ -153,19 +156,21 @@ type
     procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
     procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
     procedure ScrollBy(DeltaX, DeltaY: Integer);
-    procedure ComputeScrollbars; virtual;
+    function ComputeScrollbars: Boolean; virtual;
-    procedure ScrollbarHandler(p_ScrollKind: TScrollBarKind; p_OldPosition: Integer); virtual;
+    procedure ScrollbarHandler(ScrollKind: TScrollBarKind;
+                               OldPosition: Integer); virtual;
+    procedure Loaded; override;
   public
-    Constructor Create(AOwner : TComponent); Override;
+    constructor Create(TheOwner : TComponent); override;
-    Destructor Destroy; Override;
+    destructor Destroy; override;
     procedure UpdateScrollbars;
     function HasVisibleScrollbars: boolean; virtual;
   published
     property AutoScroll: Boolean read FAutoScroll write SetAutoScroll;
     property HorzScrollBar: TControlScrollBar
-      read FHorzScrollBar write SetHorzScrollBar stored StoreScrollBars;
+              read FHorzScrollBar write SetHorzScrollBar stored StoreScrollBars;
     property VertScrollBar: TControlScrollBar
-      read FVertScrollBar write SetVertScrollBar stored StoreScrollBars;
+              read FVertScrollBar write SetVertScrollBar stored StoreScrollBars;
   end;
 
 

lcl/include/controlscrollbar.inc

@@ -32,16 +32,28 @@ begin
       AutoCalcRange;
 
     if Value > FAutoRange then begin
+      {$IFDEF VerboseScrollingWinControl}
+      if Kind=sbHorizontal then
+        DebugLn(['TControlScrollBar.SetPosition FAutoRange Value=',Value,' > AutoRange=',FAutoRange]);
+      {$ENDIF}
       SetPosition(FAutoRange);
       exit;
     end;
   end;
 
   if Value>Range then begin
+    {$IFDEF VerboseScrollingWinControl}
+    if Kind=sbHorizontal then
+      DebugLn(['TControlScrollBar.SetPosition Range Value=',Value,' > Range=',Range]);
+    {$ENDIF}
     SetPosition(Range);
     exit;
   end;
 
+  {$IFDEF VerboseScrollingWinControl}
+  if Kind=sbHorizontal then
+    DebugLn(['TControlScrollBar.SetPosition Value=',Value,' FPosition=',FPosition]);
+  {$ENDIF}
   if Value=FPosition then exit;
 
   // scroll content of FControl
@@ -52,8 +64,14 @@ begin
 
   // check that the new position is also set on the scrollbar
   if HandleAllocated
-  and (GetScrollPos(ControlHandle, IntfBarKind[Kind]) <> FPosition) then
+  and (GetScrollPos(ControlHandle, IntfBarKind[Kind]) <> FPosition) then begin
+    InvalidateScollInfo;
+    {$IFDEF VerboseScrollingWinControl}
+    if Kind=sbHorizontal then
+      DebugLn(['TControlScrollBar.SetPosition FPosition=',FPosition]);
+    {$ENDIF}
     SetScrollPos(ControlHandle, IntfBarKind[Kind], FPosition, Visible);
+  end;
 end;
 
 function TControlScrollBar.SmoothIsStored: boolean;
@@ -72,6 +90,7 @@ begin
   if HandleAllocated and (not (FControl is TScrollingWinControl)) then begin
     ScrollInfo.fMask:=SIF_PAGE;
     GetScrollInfo(ControlHandle,IntfBarKind[Kind],ScrollInfo);
+    InvalidateScollInfo;
     FPage:=ScrollInfo.nPage;
   end;
   Result:=FPage;
@@ -83,6 +102,7 @@ begin
   if HandleAllocated and (not (FControl is TScrollingWinControl)) then begin
     ScrollInfo.fMask:=SIF_POS;
     GetScrollInfo(ControlHandle,IntfBarKind[Kind],ScrollInfo);
+    InvalidateScollInfo;
     FPosition:=ScrollInfo.nPos;
   end;
   Result:=FPosition;
@@ -94,6 +114,7 @@ begin
   if HandleAllocated and (not (FControl is TScrollingWinControl)) then begin
     ScrollInfo.fMask:=SIF_Range+SIF_Page;
     GetScrollInfo(ControlHandle,IntfBarKind[Kind],ScrollInfo);
+    InvalidateScollInfo;
     FRange:=ScrollInfo.nMax-ScrollInfo.nMin-integer(ScrollInfo.nPage);
   end;
   Result:=FRange;
@@ -107,6 +128,7 @@ end;
 function TControlScrollBar.GetVisible: Boolean;
 begin
   if HandleAllocated and (not (FControl is TScrollingWinControl)) then begin
+    InvalidateScollInfo;
     FVisible:=GetScrollbarVisible(Controlhandle,IntfBarKind[Kind]);
   end;
   Result:=FVisible;
@@ -138,9 +160,10 @@ begin
     KindID:=SM_CXHSCROLL
   else
     KindID:=SM_CXVSCROLL;
-  if HandleAllocated then
+  if HandleAllocated then begin
-    Result:=LCLIntf.GetScrollBarSize(ControlHandle,KindID)
+    Result:=LCLIntf.GetScrollBarSize(ControlHandle,KindID);
-  else
+    InvalidateScollInfo;
+  end else
     Result:=GetSystemMetrics(KindID);
 end;
 
@@ -152,6 +175,10 @@ begin
   end;
   if FRange=Value then exit;
   FRange := Value;
+  {$IFDEF VerboseScrollingWinControl}
+  if Kind=sbHorizontal then
+    DebugLn(['TControlScrollBar.SetRange ',Self,' fRange=',FRange]);
+  {$ENDIF}
   ControlUpdateScrollBars;
 end;
 
@@ -179,14 +206,12 @@ procedure TControlScrollBar.AutoCalcRange;
   var
     I : Integer;
     TmpRange : Longint;
-    IncludeControl : Boolean;
   begin
     TmpRange := 0;
     For I := 0 to FControl.ControlCount - 1 do
       With FControl.Controls[I] do
-        if Visible then begin
+        if IsControlVisible then begin
-          IncludeControl := (Align = alTop) or (Align = alNone);
+          If (Align = alTop) or (Align = alNone) then
-          If IncludeControl then
             TmpRange := Max(TmpRange, Top + Height);
         end;
     Range := TmpRange;
@@ -204,13 +229,10 @@ procedure TControlScrollBar.AutoCalcRange;
       c := FControl.Controls[I];
       if not C.IsControlVisible then Continue;
       if (c.Align <> alLeft) and (c.Align <> alNone) then Continue;
-      
+      {$IFDEF VerboseScrollingWinControl}
-      // the left of a control is negative when it is scrolled to the left,
+      DebugLn(['AutoCalcHRange ',DbgSName(c),' Left=',c.Left]);
-      // so add FPosition
+      {$ENDIF}
-      // MWE: temporary disabled until WM_MOVE messages are send for all gtklayout childs
+      TmpRange := Max(TmpRange, c.Left + c.Width);
-      TmpRange := Max(TmpRange, {FPosition +} c.Left + c.Width);
-      {if c.Left < 0
-      then DebugLn('Child.Left = %d, Control.Left = %d', [c.Left, FControl.Left]);}
     end;
     Range := TmpRange;
   end;
@@ -223,37 +245,50 @@ begin
     else
       AutoCalcHRange;
   end;
-  ControlUpdateScrollBars;
 end;
 
 procedure TControlScrollBar.UpdateScrollBar;
 var
   ScrollInfo: TScrollInfo;
 begin
-  //todo: probably needs to be moved somewhere else.
+  if HandleAllocated
-  FAutoRange := 0;
+  and (FControl is TScrollingWinControl) then begin
-
+    FillChar(ScrollInfo,SizeOf(ScrollInfo),0);
-  if FControl is TScrollingWinControl then begin
     ScrollInfo.cbSize := SizeOf(ScrollInfo);
     ScrollInfo.fMask := SIF_ALL;
     ScrollInfo.nMin := 0;
     ScrollInfo.nMax := FRange;
     ScrollInfo.nPos := FPosition;
+    ScrollInfo.nPage := FPage;
     ScrollInfo.nTrackPos := FPosition;
-    if HandleAllocated then
+    if (not FOldScrollInfoValid)
+    or (not CompareMem(@ScrollInfo,@FOldScrollInfo,SizeOf(TScrollInfo))) then
+    begin
+      FOldScrollInfo:=ScrollInfo;
+      FOldScrollInfoValid:=true;
       SetScrollInfo(FControl.Handle, IntfBarKind[Kind], ScrollInfo, FVisible);
+    end;
+    {$IFDEF VerboseScrollingWinControl}
+    if Kind=sbHorizontal then
+      DebugLn(['TControlScrollBar.UpdateScrollBar ',DbgSName(FControl),' ',DbgSName(Self),' FVisible=',FVisible,' Range=',FRange,' FPosition=',FPosition,' FPage=',FPage,' FAutoRange=',FAutoRange]);
+    {$ENDIF}
   end;
 
-  SetPosition(ScrollInfo.nTrackPos);
+  SetPosition(FPosition);
 
   if FControl is TScrollingWinControl then begin
-    // I am not positive that this is right, but it apeared to be when I
+    // I am not positive that this is right, but it appeared to be when I
     // compared results to Delphi 4
     if FSmooth then
       FIncrement := FPage div 10;
   end;
 end;
 
+procedure TControlScrollBar.InvalidateScollInfo;
+begin
+  FOldScrollInfoValid:=false;
+end;
+
 function TControlScrollBar.ControlAutoScroll: boolean;
 begin
   if FControl is TScrollingWinControl then
@@ -288,21 +323,26 @@ begin
   else
     Exit;
   end;
+  {$IFDEF VerboseScrollingWinControl}
+  DebugLn(['TControlScrollBar.ScrollHandler Message.ScrollCode=',Message.ScrollCode,' FPosition=',FPosition,' NewPos=',NewPos,' Range=',Range]);
+  {$ENDIF}
   if NewPos < 0 then NewPos := 0;
   if NewPos > Range then NewPos := Range;
+  InvalidateScollInfo;
   SetPosition(NewPos);
 end;
 
 procedure TControlScrollBar.ControlUpdateScrollBars;
 begin
-  if csLoading in FControl.ComponentState then exit;
+  if ([csLoading,csDestroying]*FControl.ComponentState<>[]) then exit;
+  if not HandleAllocated then exit;
   if FControl is TScrollingWinControl then
     TScrollingWinControl(FControl).UpdateScrollBars;
 end;
 
 function TControlScrollBar.HandleAllocated: boolean;
 begin
-  Result:=(FControl<>nil) and (FControl.HandleAllocated)
+  Result:=(FControl<>nil) and (FControl.HandleAllocated);
 end;
 
 function TControlScrollBar.ControlHandle: HWnd;

lcl/include/scrollingwincontrol.inc

@@ -17,15 +17,13 @@
 
 procedure TScrollingWinControl.SetAutoScroll(Value: Boolean);
 begin
-  if FAutoScroll <> Value then
+  if FAutoScroll = Value then exit;
-  begin
+  FAutoScroll := Value;
-    FAutoScroll := Value;
+  if Value then begin
-    if Value then begin
+    HorzScrollBar.AutoCalcRange;
-      HorzScrollBar.AutoCalcRange;
+    VertScrollBar.AutoCalcRange;
-      VertScrollBar.AutoCalcRange;
-    end;
-    UpdateScrollBars;
   end;
+  UpdateScrollBars;
 end;
 
 procedure TScrollingWinControl.CreateWnd;
@@ -49,11 +47,11 @@ procedure TScrollingWinControl.AlignControls(AControl: TControl;
   var ARect: TRect);
 begin
   if (HorzScrollBar=nil) or (VertScrollBar=nil) then exit;
+  inherited AlignControls(AControl, ARect);
   HorzScrollBar.AutoCalcRange;
   VertScrollBar.AutoCalcRange;
-  If not AutoScroll then
+  if not AutoScroll then
     UpdateScrollBars;
-  inherited AlignControls(AControl, ARect);
 end;
 
 procedure TScrollingWinControl.DoOnResize;
@@ -74,16 +72,20 @@ begin
   FVertScrollbar.Assign(Value);
 end;
 
-procedure TScrollingWinControl.ComputeScrollbars;
+function TScrollingWinControl.ComputeScrollbars: Boolean;
+// true if something changed
+// update Page, AutoRange, Visible
 
   procedure UpdateRange(p_Bar: TControlScrollBar);
   var
     SBSize: Longint;
     OtherScrollbar: TControlScrollBar;
+    OldAutoRange: LongInt;
   begin
+    OldAutoRange:=p_Bar.FAutoRange;
     p_Bar.FAutoRange := 0;
     OtherScrollbar := p_Bar.GetOtherScrollBar;
-    If OtherScrollbar.FVisible then
+    if OtherScrollbar.FVisible then
       SBSize := OtherScrollbar.Size
     else
       SBSize := 0;
@@ -95,43 +97,66 @@ procedure TScrollingWinControl.ComputeScrollbars;
       p_Bar.FAutoRange := (p_Bar.FRange - SBSize)
     else
       p_Bar.FAutoRange := 0;
+    {$IFDEF VerboseScrollingWinControl}
+    if p_Bar.Kind = sbHorizontal then
+      DebugLn(['UpdateRange p_Bar.fRange=',p_Bar.fRange,' SBSize=',SBSize,' ClientWidth=',ClientWidth,' FAutoRange=',p_Bar.FAutoRange]);
+    {$ENDIF}
+    if OldAutoRange<>p_Bar.FAutoRange then
+      Result:=true;
   end;
   
   procedure UpdateVisible(p_Bar: TControlScrollBar);
   var
     CurMax: Integer;
+    OldVisible: Boolean;
   begin
+    OldVisible:=p_Bar.FVisible;
     if p_Bar.Kind = sbVertical then
       CurMax := Height
     else
       CurMax := Width;
-    If (p_Bar.FVisible and not FAutoScroll)
+    if (p_Bar.FVisible and not FAutoScroll)
       or (FAutoScroll and (p_Bar.FRange > 0) and (p_Bar.FRange > CurMax))
     then
       p_Bar.FVisible := True
     else
       p_Bar.FVisible := False;
+    if OldVisible<>p_Bar.FVisible then
+      Result:=true;
   end;
   
+var
+  NewPage: Integer;
 begin
-  //todo: why doesn't it simply use ClientWidth/Height?
+  Result:=false;
   // page
-  HorzScrollbar.FPage := Min(ClientWidth -1, High(HorzScrollbar.FPage));
+  NewPage:=Max(1,Min(ClientWidth -1, High(HorzScrollbar.FPage)));
-  VertScrollbar.FPage := Min(ClientHeight -1, High(VertScrollbar.FPage));
+  if NewPage<>HorzScrollbar.FPage then begin
+    HorzScrollbar.FPage := NewPage;
+    Result:=true;
+  end;
+  NewPage := Max(1,Min(ClientHeight -1, High(VertScrollbar.FPage)));
+  if NewPage<>VertScrollbar.FPage then begin
+    VertScrollbar.FPage := NewPage;
+    Result:=true;
+  end;
   // range
-  UpdateRange(VertScrollbar);
+  UpdateRange(HorzScrollbar);
   UpdateRange(VertScrollbar);
   // visible
   UpdateVisible(HorzScrollbar);
   UpdateVisible(VertScrollbar);
 end;
 
-Procedure TScrollingWinControl.UpdateScrollbars;
+procedure TScrollingWinControl.UpdateScrollbars;
 begin
-  If FIsUpdating then exit;
+  if ([csLoading,csDestroying]*ComponentState<>[]) then exit;
+  if not HandleAllocated then exit;
+  
+  if FIsUpdating then exit;
   FIsUpdating := True;
   try
-    ComputeScrollbars;
+    ComputeScrollbars; // page, autorange, visible
     FVertScrollbar.UpdateScrollbar;
     FHorzScrollbar.UpdateScrollbar;
   finally
@@ -154,32 +179,38 @@ procedure TScrollingWinControl.ScrollBy(DeltaX, DeltaY: Integer);
 begin
   if HandleAllocated then begin
     TWSScrollingWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY);
-    //todo: shouldn't call Invalidate. Instead, the TWidgetSet should call it if it needs to.
     Invalidate;
   end;
 end;
 
-procedure TScrollingWinControl.ScrollbarHandler(p_ScrollKind: TScrollBarKind; p_OldPosition: Integer);
+procedure TScrollingWinControl.ScrollbarHandler(ScrollKind: TScrollBarKind;
+  OldPosition: Integer);
 begin
-  if p_ScrollKind = sbVertical then
+  if ScrollKind = sbVertical then
-    ScrollBy(0, FVertScrollBar.Position - p_OldPosition)
+    ScrollBy(0, FVertScrollBar.Position - OldPosition)
   else
-    ScrollBy(FHorzScrollBar.Position - p_OldPosition, 0);
+    ScrollBy(FHorzScrollBar.Position - OldPosition, 0);
 end;
 
-Procedure TScrollingWinControl.WMVScroll(var Message : TLMVScroll);
+procedure TScrollingWinControl.Loaded;
+begin
+  inherited Loaded;
+  UpdateScrollbars;
+end;
+
+procedure TScrollingWinControl.WMVScroll(var Message : TLMVScroll);
 begin
   VertScrollbar.ScrollHandler(Message);
 end;
 
-Procedure TScrollingWinControl.WMHScroll(var Message : TLMHScroll);
+procedure TScrollingWinControl.WMHScroll(var Message : TLMHScroll);
 begin
   HorzScrollbar.ScrollHandler(Message);
 end;
 
-Constructor TScrollingWinControl.Create(AOwner : TComponent);
+constructor TScrollingWinControl.Create(TheOwner : TComponent);
 begin
-  Inherited Create(AOwner);
+  Inherited Create(TheOwner);
 
   FVertScrollbar := TControlScrollBar.Create(Self, sbVertical);
   FHorzScrollbar := TControlScrollBar.Create(Self, sbHorizontal);
@@ -189,7 +220,7 @@ begin
   SetInitialBounds(0,0, 150, 150);
 end;
 
-Destructor TScrollingWinControl.Destroy;
+destructor TScrollingWinControl.Destroy;
 begin
   FreeThenNil(FHorzScrollBar);
   FreeThenNil(FVertScrollBar);

lcl/interfaces/win32/win32proc.pp

@@ -1157,8 +1157,10 @@ begin
 end;
 
 procedure DoInitialization;
+{$ifdef WindowsUnicodeSupport}
 var
   WinVersion: TOSVersionInfo;
+{$endif}
 begin
   FillChar(DefaultWindowInfo, sizeof(DefaultWindowInfo), 0);
   DefaultWindowInfo.DrawItemIndex := -1;

lcl/interfaces/win32/win32winapi.inc

@@ -1114,9 +1114,11 @@ End;
 
  ------------------------------------------------------------------------------}
 function TWin32WidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer;
+{$ifdef WindowsUnicodeSupport}
 var
   s: String;
   w: WideString;
+{$endif}
 begin
   Assert(False, Format('trace:> [TWin32WidgetSet.DrawText] DC:0x%x, Str:''%s'', Count: %d, Rect = %d,%d,%d,%d, Flags:%d',
     [DC, Str, Count, Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, Flags]));
@@ -1278,9 +1280,11 @@ end;
   Draws a character string by using the currently selected font.
  ------------------------------------------------------------------------------}
 function TWin32WidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
+{$ifdef WindowsUnicodeSupport}
 var
   s: String;
   w: WideString;
+{$ENDIF}
 begin
   Assert(False, Format('trace:> [TWin32WidgetSet.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
 
@@ -2108,9 +2112,11 @@ End;
   Computes the width and height of the specified string of text.
  ------------------------------------------------------------------------------}
 Function TWin32WidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; Var Size: TSize): Boolean;
+{$ifdef WindowsUnicodeSupport}
 var
   s: String;
   w: WideString;
+{$ENDIF}
 Begin
   Assert(False, 'Trace:[TWin32WidgetSet.GetTextExtentPoint] - Start');
 {$ifdef WindowsUnicodeSupport}

lcl/lclintf.pas

@@ -39,12 +39,6 @@ unit LCLIntf;
 {$mode objfpc}{$H+}
 {$inline on}
 
-{$IF defined(VER2_0_2) and defined(win32)}
-// FPC <= 2.0.2 compatibility code
-// WINDOWS define was added after FPC 2.0.2
-  {$define WINDOWS}
-{$endif}
-
 interface
 
 uses

lcl/lclproc.pas

@@ -27,12 +27,6 @@ unit LCLProc;
 {$mode objfpc}{$H+}
 {$inline on}
 
-{$IF defined(VER2_0_2) and defined(win32)}
-// FPC <= 2.0.2 compatibility code
-// WINDOWS define was added after FPC 2.0.2
-  {$define WINDOWS}
-{$endif}
-
 interface
 
 uses

lcl/lcltype.pp

@@ -38,12 +38,6 @@ unit LCLType;
 
 {$mode objfpc}{$H+}
 
-{$IF defined(VER2_0_2) and defined(win32)}
-// FPC <= 2.0.2 compatibility code
-// WINDOWS define was added after FPC 2.0.2
-  {$define WINDOWS}
-{$endif}
-
 interface