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

carbon: Patch from bug #21737: Carbon Mouse cursor doesn't change until mousemove

Browse Source 
git-svn-id: trunk@54395 -
This commit is contained in:
sekelsenmat 2017-03-13 06:24:53 +00:00
parent 326cad6133
commit 819d1e72cb
1 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lcl/interfaces/carbon/carbonwscontrols.pp
View File

@ -26,7 +26,7 @@ uses
// libs
MacOSAll, Classes, SysUtils,
// LCL
Forms, Controls, Graphics, LCLType, LCLProc,
Forms, Controls, Graphics, LCLType, LCLProc, LCLIntf,
// widgetset
WSControls, WSLCLClasses,
// LCL Carbon
@ -317,10 +317,27 @@ end;
------------------------------------------------------------------------------}
class procedure TCarbonWSWinControl.SetCursor(const AWinControl: TWinControl;
const ACursor: HCursor);
var
HitControl: ControlRef;
TopWindow: WindowRef;
TopView: HIViewRef;
MousePos: HIPoint;
begin
if not CheckHandle(AWinControl, Self, 'SetCursor') then Exit;
TCarbonWidget(AWinControl.Handle).SetCursor(ACursor);
if (Screen.Cursor <> crDefault) then Exit;
TopWindow := TCarbonWidget(AWinControl.Handle).GetTopParentWindow;
TopView := HIViewGetRoot(TopWindow);
HIGetMousePosition(kHICoordSpaceView, TopView, MousePos);
if OSError(
HIViewGetSubviewHit(TopView, MousePos, True, HitControl),
Self, 'TCarbonWSWinControl.SetCursor', 'GetSubviewHit') then Exit;
if HitControl = TCarbonWidget(AWinControl.Handle).Widget then
LCLIntf.SetCursor(ACursor);
end;
{------------------------------------------------------------------------------