pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

richmemo: win32: speedup the scrolling speed. bug #36636

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7323 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2020-01-29 20:48:45 +00:00
parent 20199c9a4c
commit 6f4d0213ea
1 changed files with 40 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
components/richmemo/win32/win32richmemo.pas
View File

@ -347,6 +347,24 @@ begin
end; end;
end; end;
function KeysToShiftState(Keys: PtrUInt): TShiftState;
begin
Result := [];
if Keys and MK_Shift <> 0 then Include(Result, ssShift);
if Keys and MK_Control <> 0 then Include(Result, ssCtrl);
if Keys and MK_LButton <> 0 then Include(Result, ssLeft);
if Keys and MK_RButton <> 0 then Include(Result, ssRight);
if Keys and MK_MButton <> 0 then Include(Result, ssMiddle);
if Keys and MK_XBUTTON1 <> 0 then Include(Result, ssExtra1);
if Keys and MK_XBUTTON2 <> 0 then Include(Result, ssExtra2);
if Keys and MK_DOUBLECLICK <> 0 then Include(Result, ssDouble);
if Keys and MK_TRIPLECLICK <> 0 then Include(Result, ssTriple);
if Keys and MK_QUADCLICK <> 0 then Include(Result, ssQuad);
if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then Include(Result, ssMeta);
end;
function RichEditProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; function RichEditProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall; LParam: Windows.LParam): LResult; stdcall;
var var
@ -354,6 +372,7 @@ var
NcHandled : Boolean; // NCPaint has painted by itself NcHandled : Boolean; // NCPaint has painted by itself
r: TRect; r: TRect;
PrevWndProc: Windows.WNDPROC; PrevWndProc: Windows.WNDPROC;
P: TPoint;
begin begin
case Msg of case Msg of
WM_PAINT : begin WM_PAINT : begin
@ -390,6 +409,27 @@ begin
end else end else
Result:=WindowProc(Window, Msg, WParam, LParam); Result:=WindowProc(Window, Msg, WParam, LParam);
end; end;
// The handling is needed, due to LCL scrolling is making everything slow
// for whatever reason. (because it doesn't pass the message to WinAPI?)
WM_MOUSEWHEEL, WM_MOUSEHWHEEL:
begin
WindowInfo := GetWin32WindowInfo(Window);
// WinAPI sends Screen Coordinates, LCL expects client coordinates
p := Point(GET_X_LPARAM(LParam), GET_Y_LPARAM(LParam));
if Assigned(WindowInfo^.WinControl) then
p := WindowInfo^.WinControl.ScreenToClient(p);
Result := LCLSendMouseWheelMsg(WindowInfo^.WinControl,
p.x, p.y,
SmallInt(HIWORD(Integer(WParam))),
KeysToShiftState(LOWORD(Integer(WParam))));
// Non zero value is returned, if LCL marked the message as Handeld
if Result = 0 then
Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
end;
else else
Result := WindowProc(Window, Msg, WParam, LParam); Result := WindowProc(Window, Msg, WParam, LParam);
end; end;