paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 23:38:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

Qt5,Qt6: fixed scrollCode messaging. issue #41566

Browse Source 
(cherry picked from commit b3c7e1ddd6)

Co-authored-by: zeljan1 <zeljko@holobit.hr>
This commit is contained in:
Željan Rikalo 2025-04-05 21:01:19 +02:00 committed by Željan Rikalo
parent 7f2a8ae7dc
commit 56ff701754
2 changed files with 120 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
lcl/interfaces/qt5/qtwidgets.pas
View File

@ -9344,7 +9344,10 @@ begin
LMScroll.Msg := LM_VSCROLL;
LMScroll.Pos := p1;
LMScroll.ScrollCode := SIF_POS;
if getTracking and getSliderDown then
LMScroll.ScrollCode := SB_THUMBTRACK
else
LMScroll.ScrollCode := SB_THUMBPOSITION;
if not InUpdate then
DeliverMessage(LMScroll);
@ -9355,8 +9358,14 @@ begin
begin
if b and (FChildOfComplexWidget = ccwAbstractScrollArea) and
not InUpdate and getVisible then
begin
if p1 = getMin then
QAbstractSlider_triggerAction(QAbstractSliderH(Widget),
QAbstractSliderSliderToMinimum)
else
QAbstractSlider_triggerAction(QAbstractSliderH(Widget),
QAbstractSliderSliderToMaximum);
end;
end;
end;
@ -9395,9 +9404,19 @@ begin
SliderAction := SliderActions[Action];
if not SliderPressed and not SliderReleased and (SliderAction = QAbstractSliderSliderMove) then
begin
if LMScroll.Pos = getMin then
SliderAction := QAbstractSliderSliderToMinimum
else
if LMScroll.Pos = getMax then
SliderAction := QAbstractSliderSliderToMaximum;
end;
case SliderAction of
QAbstractSliderSliderNoAction:
begin
exit; // issue #41566
// this is called from mouse release while qt still thinks that
// slider is pressed, we must update position.issue #14728, #21610
if getSliderDown then
@ -9405,6 +9424,7 @@ begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
end;
LMScroll.ScrollCode := SB_ENDSCROLL;
end;
QAbstractSliderSliderSingleStepAdd:
@ -9437,6 +9457,13 @@ begin
end;
QAbstractSliderSliderToMinimum:
begin
// send update for SB_THUMBPOSITION
if not SliderPressed and not SliderReleased then
begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
end;
if LMScroll.Msg = LM_HSCROLL then
LMScroll.ScrollCode := SB_LEFT
else
@ -9447,7 +9474,7 @@ begin
// issue #21610
// if we are reaching maximum with eg. mouse wheel
// and our parent is TScrollingWinControl then update thumbposition.
if not getSliderDown then
if not SliderPressed and not SliderReleased then
begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
@ -9460,14 +9487,15 @@ begin
end;
QAbstractSliderSliderMove:
begin
if getTracking then
if getTracking and getSliderDown then
LMScroll.ScrollCode := SB_THUMBTRACK
else
if not getSliderDown then
LMScroll.ScrollCode := SB_THUMBPOSITION;
if not SliderPressed and not SliderReleased then
LMScroll.ScrollCode := SB_THUMBPOSITION
else
exit; //ValueChange will trigger.
end;
end;
DeliverMessage(LMScroll);
end;
@ -9513,8 +9541,10 @@ procedure TQtScrollBar.SlotSliderReleased; cdecl;
var
AValue: Integer;
LMScroll: TLMScroll;
SentThumbPosition: boolean;
begin
inherited SlotSliderReleased;
SentThumbPosition := False;
if
{$IFDEF QTSCROLLABLEFORMS}
((ChildOfComplexWidget = ccwAbstractScrollArea) and (FOwner <> nil) and
@ -9545,9 +9575,33 @@ begin
LMScroll.ScrollCode := SB_THUMBPOSITION
else
LMScroll.ScrollCode := SB_THUMBTRACK;
SentThumbPosition := LMScroll.ScrollCode = SB_THUMBPOSITION;
DeliverMessage(LMScroll);
end;
end;
// issue #41566 - must send SB_ENDSCROLL
FillChar(LMScroll{%H-}, SizeOf(LMScroll), #0);
LMScroll.ScrollBar := PtrUInt(Self);
if QAbstractSlider_orientation(QAbstractSliderH(Widget)) = QtHorizontal then
LMScroll.Msg := LM_HSCROLL
else
LMScroll.Msg := LM_VSCROLL;
LMScroll.Pos := getSliderPosition;
if not SentThumbPosition then
begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
LMScroll.Result := 0;
end;
FSliderReleased := False;
LMScroll.ScrollCode := SB_ENDSCROLL;
DeliverMessage(LMScroll);
end;
function TQtScrollBar.EventFilter(Sender: QObjectH; Event: QEventH): Boolean;

66
lcl/interfaces/qt6/qtwidgets.pas
View File

@ -9300,7 +9300,10 @@ begin
LMScroll.Msg := LM_VSCROLL;
LMScroll.Pos := p1;
LMScroll.ScrollCode := SIF_POS;
if getTracking and getSliderDown then
LMScroll.ScrollCode := SB_THUMBTRACK
else
LMScroll.ScrollCode := SB_THUMBPOSITION;
if not InUpdate then
DeliverMessage(LMScroll);
@ -9311,8 +9314,14 @@ begin
begin
if b and (FChildOfComplexWidget = ccwAbstractScrollArea) and
not InUpdate and getVisible then
begin
if p1 = getMin then
QAbstractSlider_triggerAction(QAbstractSliderH(Widget),
QAbstractSliderSliderToMinimum)
else
QAbstractSlider_triggerAction(QAbstractSliderH(Widget),
QAbstractSliderSliderToMaximum);
end;
end;
end;
@ -9351,9 +9360,19 @@ begin
SliderAction := SliderActions[Action];
if not SliderPressed and not SliderReleased and (SliderAction = QAbstractSliderSliderMove) then
begin
if LMScroll.Pos = getMin then
SliderAction := QAbstractSliderSliderToMinimum
else
if LMScroll.Pos = getMax then
SliderAction := QAbstractSliderSliderToMaximum;
end;
case SliderAction of
QAbstractSliderSliderNoAction:
begin
exit; // issue #41566
// this is called from mouse release while qt still thinks that
// slider is pressed, we must update position.issue #14728, #21610
if getSliderDown then
@ -9361,6 +9380,7 @@ begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
end;
LMScroll.ScrollCode := SB_ENDSCROLL;
end;
QAbstractSliderSliderSingleStepAdd:
@ -9393,6 +9413,13 @@ begin
end;
QAbstractSliderSliderToMinimum:
begin
// send update for SB_THUMBPOSITION
if not SliderPressed and not SliderReleased then
begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
end;
if LMScroll.Msg = LM_HSCROLL then
LMScroll.ScrollCode := SB_LEFT
else
@ -9403,7 +9430,7 @@ begin
// issue #21610
// if we are reaching maximum with eg. mouse wheel
// and our parent is TScrollingWinControl then update thumbposition.
if not getSliderDown then
if not SliderPressed and not SliderReleased then
begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
@ -9416,14 +9443,15 @@ begin
end;
QAbstractSliderSliderMove:
begin
if getTracking then
if getTracking and getSliderDown then
LMScroll.ScrollCode := SB_THUMBTRACK
else
if not getSliderDown then
LMScroll.ScrollCode := SB_THUMBPOSITION;
if not SliderPressed and not SliderReleased then
LMScroll.ScrollCode := SB_THUMBPOSITION
else
exit; //ValueChange will trigger.
end;
end;
DeliverMessage(LMScroll);
end;
@ -9469,8 +9497,10 @@ procedure TQtScrollBar.SlotSliderReleased; cdecl;
var
AValue: Integer;
LMScroll: TLMScroll;
SentThumbPosition: boolean;
begin
inherited SlotSliderReleased;
SentThumbPosition := False;
if
{$IFDEF QTSCROLLABLEFORMS}
((ChildOfComplexWidget = ccwAbstractScrollArea) and (FOwner <> nil) and
@ -9501,9 +9531,33 @@ begin
LMScroll.ScrollCode := SB_THUMBPOSITION
else
LMScroll.ScrollCode := SB_THUMBTRACK;
SentThumbPosition := LMScroll.ScrollCode = SB_THUMBPOSITION;
DeliverMessage(LMScroll);
end;
end;
// issue #41566 - must send SB_ENDSCROLL
FillChar(LMScroll{%H-}, SizeOf(LMScroll), #0);
LMScroll.ScrollBar := PtrUInt(Self);
if QAbstractSlider_orientation(QAbstractSliderH(Widget)) = QtHorizontal then
LMScroll.Msg := LM_HSCROLL
else
LMScroll.Msg := LM_VSCROLL;
LMScroll.Pos := getSliderPosition;
if not SentThumbPosition then
begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
LMScroll.Result := 0;
end;
FSliderReleased := False;
LMScroll.ScrollCode := SB_ENDSCROLL;
DeliverMessage(LMScroll);
end;
function TQtScrollBar.EventFilter(Sender: QObjectH; Event: QEventH): Boolean;