paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 22:00:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

Qt4: fixed scrollCode messages. issue #41566

Browse Source
This commit is contained in:
zeljan1 2025-04-05 17:09:13 +02:00
parent 0d3a623812
commit 6e6cc23a74
1 changed files with 60 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8993,7 +8993,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);
@ -9004,8 +9007,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;
@ -9044,9 +9053,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
@ -9054,6 +9073,7 @@ begin
LMScroll.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(LMScroll);
end;
LMScroll.ScrollCode := SB_ENDSCROLL;
end;
QAbstractSliderSliderSingleStepAdd:
@ -9086,6 +9106,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
@ -9096,7 +9123,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);
@ -9109,14 +9136,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;
@ -9164,8 +9192,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
@ -9196,9 +9226,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;