paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-01 23:06:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

Windows console mouse - scroll up and down events

Browse Source
This commit is contained in:
Margers 2024-09-24 10:41:54 +00:00 committed by Michael Van Canneyt
parent a348dfc806
commit ede78f682b
2 changed files with 20 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/rtl-console/src/inc/mouseh.inc
View File

@ -35,6 +35,8 @@ const
MouseMiddleButton = $04; { Middle mouse button }
MouseButton4 = $08;
MouseButton5 = $10;
MouseXButton1 = $20;
MouseXButton2 = $40;
MouseEventBufSize = 16; { Size of event queue }

18
packages/rtl-console/src/win/mouse.pp
View File

@ -53,6 +53,10 @@ procedure MouseEventHandler(var ir:INPUT_RECORD);
e.buttons:=e.buttons or MouseMiddleButton;
if (ir.Event.MouseEvent.dwButtonState and RIGHTMOST_BUTTON_PRESSED<>0) then
e.buttons:=e.buttons or MouseRightButton;
if (ir.Event.MouseEvent.dwButtonState and $FF880000=$FF880000) then
e.buttons:=e.buttons or MouseButton5;
if (ir.Event.MouseEvent.dwButtonState and $00780000=$00780000) then
e.buttons:=e.buttons or MouseButton4;
if (Lasthandlermouseevent.x<>e.x) or (LasthandlerMouseEvent.y<>e.y) then
e.Action:=MouseActionMove;
@ -94,6 +98,20 @@ procedure MouseEventHandler(var ir:INPUT_RECORD);
end;
PutMouseEvent(e);
if (e.buttons and (MouseButton4 or MouseButton5))<>0 then
begin
{fake mouse Up for Scroll Up and Scroll Down}
e.buttons := e.buttons and not (MouseButton4 or MouseButton5);
e.Action := MouseActionUp;
LastHandlermouseEvent:=e;
while PendingMouseEvents>=MouseEventBufSize do
begin
LeaveCriticalSection(ChangeMouseEvents);
sleep(0);
EnterCriticalSection(ChangeMouseEvents);
end;
PutMouseEvent(e);
end;
end;
// this should be done in PutMouseEvent, now it is PM
// inc(PendingMouseEvents);