mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-17 23:59:07 +02:00
LCL: Window, fixed SetCursor to no longer delay action to next mouse-move
git-svn-id: trunk@21090 -
This commit is contained in:
parent
4956fbac7b
commit
344ca971c9
@ -38,7 +38,7 @@ uses
|
|||||||
////////////////////////////////////////////////////
|
////////////////////////////////////////////////////
|
||||||
WSControls, WSLCLClasses, SysUtils, Win32Proc, Win32Extra, WSProc,
|
WSControls, WSLCLClasses, SysUtils, Win32Proc, Win32Extra, WSProc,
|
||||||
{ LCL }
|
{ LCL }
|
||||||
InterfaceBase, LCLType, LCLIntf, LCLProc, Themes;
|
InterfaceBase, LCLType, LCLIntf, LCLProc, Themes, Forms;
|
||||||
|
|
||||||
type
|
type
|
||||||
{ TWin32WSDragImageList }
|
{ TWin32WSDragImageList }
|
||||||
@ -473,10 +473,31 @@ end;
|
|||||||
|
|
||||||
class procedure TWin32WSWinControl.SetCursor(const AWinControl: TWinControl;
|
class procedure TWin32WSWinControl.SetCursor(const AWinControl: TWinControl;
|
||||||
const ACursor: HCursor);
|
const ACursor: HCursor);
|
||||||
|
var
|
||||||
|
P: TPoint;
|
||||||
|
BoundsOffset: TRect;
|
||||||
|
Hnd: HWND;
|
||||||
|
lControl: TControl;
|
||||||
begin
|
begin
|
||||||
// in win32 controls have no cursor property. they can change their cursor
|
// in win32 controls have no cursor property. they can change their cursor
|
||||||
// by listening WM_SETCURSOR and adjusting global cursor
|
// by listening WM_SETCURSOR and adjusting global cursor
|
||||||
if csDesigning in AWinControl.ComponentState then
|
if csDesigning in AWinControl.ComponentState then begin
|
||||||
|
Windows.SetCursor(ACursor);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Screen.Cursor <> crDefault then exit;
|
||||||
|
|
||||||
|
Windows.GetCursorPos(Windows.POINT(P));
|
||||||
|
Windows.ScreenToClient(AWinControl.Handle, Windows.POINT(P));
|
||||||
|
if (P.X < 0) or (P.Y < 0) or
|
||||||
|
(P.X >= AWinControl.Width) or (P.Y > AWinControl.Height)
|
||||||
|
then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
lControl := AWinControl.ControlAtPos(P, [capfOnlyClientAreas,
|
||||||
|
capfAllowWinControls, capfRecursive]);
|
||||||
|
if (lControl = nil) or (lControl = AWinControl) then
|
||||||
Windows.SetCursor(ACursor);
|
Windows.SetCursor(ACursor);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user