paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-27 19:20:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: don't directly set the mouse cursor in Twin32WSWinControl.SetCursor but do this through the window procedures

Browse Source 
git-svn-id: trunk@27721 -
This commit is contained in:
paul 2010-10-16 16:01:00 +00:00
parent d6d4003fe6
commit cfc294acab
1 changed files with 11 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
lcl/interfaces/win32/win32wscontrols.pp
View File

@ -515,64 +515,31 @@ begin
{$endif}
end;
class procedure TWin32WSWinControl.SetCursor(const AWinControl: TWinControl;
const ACursor: HCursor);
function WndClassName(Wnd: HWND): String; inline;
var
winClassName: array[0..19] of char;
begin
GetClassName(Wnd, @winClassName, 20);
Result := winClassName;
end;
class procedure TWin32WSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCursor);
var
P: TPoint;
lControl: TControl;
BoundsOffset: TRect;
CursorPos, P: TPoint;
h: HWND;
c: HCURSOR;
HitTestCode: LResult;
begin
// in win32 controls have no cursor property. they can change their cursor
// by listening WM_SETCURSOR and adjusting global cursor
if csDesigning in AWinControl.ComponentState then
begin
Windows.SetCursor(ACursor);
exit;
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;
Windows.GetCursorPos(CursorPos);
// BoundsOffset also corrects for tabbed controls
// -capfHasScrollOffset only corrects scrolled controls
if GetLCLClientBoundsOffset(aWinControl, BoundsOffset) then
begin
Dec(P.X, BoundsOffset.Left);
Dec(P.Y, BoundsOffset.Top);
end;
h := AWinControl.Handle;
P := CursorPos;
Windows.ScreenToClient(h, @P);
h := Windows.ChildWindowFromPointEx(h, Windows.POINT(P), CWP_SKIPINVISIBLE or CWP_SKIPDISABLED);
lControl := AWinControl.ControlAtPos(P, [capfOnlyClientAreas, capfHasScrollOffset,
capfAllowWinControls, capfRecursive]);
if (lControl = nil) then
lControl := AWinControl;
if lControl.Cursor = crDefault then
begin
// comboboxes, groupboxes,... may have internal child handles
h := Windows.ChildWindowFromPointEx(AWinControl.Handle, Windows.POINT(p), CWP_SKIPINVISIBLE or CWP_SKIPDISABLED);
if h = 0 then exit;
c := HCURSOR(GetClassLong(h, GCL_HCURSOR));
if c <> 0 then
begin
Windows.SetCursor(c);
exit;
end;
end;
Windows.SetCursor(Screen.Cursors[lControl.Cursor]);
HitTestCode := SendMessage(h, WM_NCHITTEST, 0, LParam((CursorPos.X and $FFFF) or (CursorPos.Y shl 16)));
SendMessage(h, WM_SETCURSOR, h, MakeLong(HitTestCode, WM_MOUSEMOVE));
end;
class procedure TWin32WSWinControl.SetShape(const AWinControl: TWinControl;