paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-03 12:19:27 +01:00
Code Issues Packages Projects Releases Wiki Activity

Gtk2: fixed TScrollBar.ScrollBy_WS error. Patch by Andrew Haines

Browse Source
This commit is contained in:
Željan Rikalo 2023-02-01 15:06:28 +01:00
parent f823854588
commit 2ffedf7545
1 changed files with 32 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
lcl/interfaces/gtk2/gtk2wsstdctrls.pp
View File

@ -71,6 +71,7 @@ type
class procedure SetKind(const AScrollBar: TCustomScrollBar; const {%H-}AIsHorizontal: Boolean); override;
class procedure SetParams(const AScrollBar: TCustomScrollBar); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TGtk2WSCustomGroupBox }
@ -2777,6 +2778,37 @@ begin
AWinControl.HandleObjectShouldBeVisible);
end;
class procedure TGtk2WSScrollBar.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
var
Scrolled: PGtkRange;
Adjustment: PGtkAdjustment;
NewPos, v: gdouble;
Delta: Integer;
begin
if not AWinControl.HandleAllocated then exit;
Scrolled := GTK_RANGE({%H-}Pointer(AWinControl.Handle));
if not GTK_IS_SCROLLBAR(Scrolled) then
exit;
if GTK_IS_HSCROLLBAR(Scrolled) then
Delta := DeltaX
else
Delta := DeltaY;
Adjustment := gtk_range_get_adjustment(Scrolled);
if (Adjustment <> nil) then
begin
v := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if v - Delta <= NewPos then
NewPos := v - Delta;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
// gtk doesn't emit a signal when we change the value manually
Gtk2RangeScrollCB(Scrolled, GTK_SCROLL_JUMP, NewPos, GetWidgetInfo(Scrolled));
end;
{ TGtk2WSRadioButton }
class function TGtk2WSRadioButton.CreateHandle(const AWinControl: TWinControl;