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

Qt5,Qt6: fixed scrollCode messaging. issue #41566

Browse Source
This commit is contained in:
zeljan1 2025-04-05 13:50:43 +02:00
parent 28c9e339ab
commit b3c7e1ddd6
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

@ -9345,7 +9345,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);
@ -9356,8 +9359,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;
@ -9396,9 +9405,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
@ -9406,6 +9425,7 @@ begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
end;
LMScroll.ScrollCode := SB_ENDSCROLL;
end;
QAbstractSliderSliderSingleStepAdd:
@ -9438,6 +9458,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
@ -9448,7 +9475,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);
@ -9461,14 +9488,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;
@ -9514,8 +9542,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
@ -9546,9 +9576,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

@ -9301,7 +9301,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);
@ -9312,8 +9315,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;
@ -9352,9 +9361,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
@ -9362,6 +9381,7 @@ begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
end;
LMScroll.ScrollCode := SB_ENDSCROLL;
end;
QAbstractSliderSliderSingleStepAdd:
@ -9394,6 +9414,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
@ -9404,7 +9431,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);
@ -9417,14 +9444,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;
@ -9470,8 +9498,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
@ -9502,9 +9532,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;