diff --git a/lcl/forms.pp b/lcl/forms.pp index 8b2e3e3e4d..338b0626bf 100644 --- a/lcl/forms.pp +++ b/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; diff --git a/lcl/include/controlscrollbar.inc b/lcl/include/controlscrollbar.inc index 5ef4866cb1..9b35cf1552 100644 --- a/lcl/include/controlscrollbar.inc +++ b/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; diff --git a/lcl/interfaces/qt/qtwidgets.pas b/lcl/interfaces/qt/qtwidgets.pas index 3e3ffcbd81..df49a610c6 100644 --- a/lcl/interfaces/qt/qtwidgets.pas +++ b/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); diff --git a/lcl/interfaces/qt/qtwinapi.inc b/lcl/interfaces/qt/qtwinapi.inc index d17264b7fa..59d21148ee 100644 --- a/lcl/interfaces/qt/qtwinapi.inc +++ b/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