lcl: implement TControlScrollBar.Tracking for win32, qt and gtk2 (issue #0007981)

git-svn-id: trunk@23596 -

lcl/forms.pp

@@ -92,6 +92,7 @@ type
     FPosition: Integer;
     FRange: Integer;
     FSmooth: Boolean;
+    FTracking: Boolean;
     FVisible: Boolean;
     FOldScrollInfo: TScrollInfo;
     FOldScrollInfoValid: Boolean;
@@ -119,6 +120,7 @@ type
     procedure SetRange(const AValue: Integer); virtual;
     procedure SetSize(const AValue: integer); virtual;
     procedure SetSmooth(const AValue: Boolean); virtual;
+    procedure SetTracking(const AValue: Boolean);
     procedure SetVisible(const AValue: Boolean); virtual;
     procedure UpdateScrollBar; virtual;
     procedure InvalidateScrollInfo;
@@ -141,6 +143,7 @@ type
     property Smooth: Boolean read GetSmooth write SetSmooth default False;
     property Position: Integer read GetPosition write SetPosition default 0;
     property Range: Integer read GetRange write SetRange stored IsRangeStored default 0;
+    property Tracking: Boolean read FTracking write SetTracking default False;
     property Visible: Boolean read GetVisible write SetVisible default True;
   end;
 

lcl/include/controlscrollbar.inc

@@ -22,6 +22,12 @@ const
     SB_VERT
   );
 
+  TrackToPolicyMap: array[Boolean] of integer =
+  (
+   SB_POLICY_DISCONTINUOUS,
+   SB_POLICY_CONTINUOUS
+  );
+
 procedure TControlScrollBar.SetPosition(const Value: Integer);
 var
   OldPosition, MaxPos: Integer;
@@ -298,6 +304,10 @@ begin
       FOldScrollInfo := ScrollInfo;
       FOldScrollInfoValid := True;
       SetScrollInfo(FControl.Handle, IntfBarKind[Kind], ScrollInfo, FVisible);
+      // update policy too
+      ScrollInfo.fMask := SIF_UPDATEPOLICY;
+      ScrollInfo.nTrackPos := TrackToPolicyMap[FTracking];
+      SetScrollInfo(ControlHandle, IntfBarKind[Kind], ScrollInfo, FVisible);
     end;
     NewVisible := Visible and (ScrollInfo.nMax - ScrollInfo.nPage > 0);
     ShowScrollBar(FControl.Handle, IntfBarKind[Kind], NewVisible);
@@ -355,8 +365,11 @@ begin
       Dec(NewPos, FPage);
     SB_PAGEDOWN:
       Inc(NewPos, FPage);
-    SB_THUMBPOSITION, SB_THUMBTRACK:
+    SB_THUMBPOSITION:
       NewPos := Message.Pos;
+    SB_THUMBTRACK:
+      if Tracking then
+        NewPos := Message.Pos;
     SB_TOP:
       NewPos := 0;
     SB_BOTTOM:
@@ -419,6 +432,21 @@ begin
   Result := not GetAutoScroll;
 end;
 
+procedure TControlScrollBar.SetTracking(const AValue: Boolean);
+var
+  ScrollInfo: TScrollInfo;
+begin
+  if FTracking = AValue then Exit;
+  FTracking := AValue;
+  if not HandleAllocated then
+    Exit;
+  FillChar(ScrollInfo,SizeOf(ScrollInfo), 0);
+  ScrollInfo.cbSize := SizeOf(ScrollInfo);
+  ScrollInfo.fMask := SIF_UPDATEPOLICY;
+  ScrollInfo.nTrackPos := TrackToPolicyMap[FTracking];
+  SetScrollInfo(ControlHandle, IntfBarKind[Kind], ScrollInfo, FVisible);
+end;
+
 function TControlScrollBar.ControlHandle: HWnd;
 begin
   Result := FControl.Handle;
@@ -435,6 +463,7 @@ begin
   FPosition := 0;
   FRange := 0;
   FSmooth := False;
+  FTracking := False;
   FVisible := True;
 end;
 

lcl/interfaces/qt/qtwidgets.pas

@@ -5134,7 +5134,7 @@ begin
     LMScroll.Msg := LM_VSCROLL;
 
   LMScroll.Pos := p1;
-  LMScroll.ScrollCode := SIF_POS; { SIF_TRACKPOS }
+  LMScroll.ScrollCode := SIF_TRACKPOS;
 
   if not InUpdate then
     DeliverMessage(LMScroll);

lcl/interfaces/qt/qtwinapi.inc

@@ -1499,7 +1499,6 @@ var
   Region: QRegionH;
   ExRegion: QRegionH;
   QtDC: TQtDeviceContext absolute dc;
-  R: TRect;
 begin
   {$ifdef VerboseQtWinAPI}
     WriteLn('[WinAPI ExcludeClipRect]');
@@ -4946,6 +4945,9 @@ var
       end;
     end;
 
+    if (ScrollInfo.FMask and SIF_UPDATEPOLICY) <> 0 then
+      ScrollBar.setTracking(ScrollInfo.nTrackPos <> SB_POLICY_DISCONTINUOUS);
+
     if (ScrollInfo.FMask and SIF_TRACKPOS) <> 0 then
     begin
       // from MSDN: the SetScrollInfo function ignores this member