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

LCL-Win32: Implement TScrollbar.ScrollBy_WS. Issue #40108, patch by Andrew Haines.

Browse Source
This commit is contained in:
Juha 2023-03-11 16:40:25 +02:00
parent 9822443fd6
commit e4a334e330
1 changed files with 60 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -45,6 +45,7 @@ type
const AParams: TCreateParams): HWND; override;
class function GetDoubleBuffered(const AWinControl: TWinControl): Boolean; override;
class procedure SetParams(const AScrollBar: TCustomScrollBar); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TWin32WSCustomGroupBox }
@ -555,6 +556,65 @@ begin
end;
end;
class procedure TWin32WSScrollBar.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
var
Scrollbar: TCustomScrollBar absolute AWinControl;
lPos: Integer;
lScrollInfo: TScrollInfo;
Msg: TLMVScroll;
begin
if AWinControl.HandleAllocated then
begin
lScrollInfo.cbSize:=SizeOf(lScrollInfo);
lScrollInfo.fMask := {SIF_PAGE or }SIF_POS{ or SIF_RANGE};
GetScrollInfo(AWinControl.Handle, SB_CTL, lScrollInfo);
lPos := lScrollInfo.nPos;
if Scrollbar.Kind = sbHorizontal then
lPos -= DeltaX
else
lPos -= DeltaY;
lScrollInfo.nPos:=lPos;
// send our desired new position
SetScrollInfo(AWinControl.Handle, SB_CTL, lScrollInfo, True);
// retrieve the actual accepted position
GetScrollInfo(AWinControl.Handle, SB_CTL, lScrollInfo);
// this seems to be the best way to update the LCL scrollbar. It's identical
// to what gtk sends.
//LM_VSCROLL = LM_HSCROLL + 1;
Msg.Msg:=LM_HSCROLL + Ord(Scrollbar.Kind); // sbHorizontal = 0 sbVertical = 1;
with Msg do
begin
Pos := lPos;
if Pos < High(SmallPos) then
SmallPos := Pos
else
SmallPos := High(SmallPos);
end;
Msg.ScrollBar:=AWinControl.Handle;
// begin move
Msg.ScrollCode := SB_THUMBTRACK;
DeliverMessage(AWinControl, Msg);
// moved
Msg.ScrollCode := SB_THUMBPOSITION;
DeliverMessage(AWinControl, Msg);
// done moving
Msg.ScrollCode:=SB_ENDSCROLL;
DeliverMessage(AWinControl, Msg);
end;
end;
{ TWin32WSCustomGroupBox }
function GroupBoxWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;