paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-14 21:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 47814 #ed5fd30d67 from trunk:

Browse Source 
LCL: issue #0014257 - SetCursor faulty under GTK2 - changes cursor for
                      wrong control

files controls.pp and include/graphiccontrol.inc
........

git-svn-id: branches/fixes_1_4@47847 -
This commit is contained in:
maxim 2015-02-16 23:56:06 +00:00
parent 55bfe9b2f6
commit 5ab0a1eeae
2 changed files with 16 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

@ -2222,6 +2222,7 @@ type
procedure DoOnChangeBounds; override;
procedure DoOnParentHandleDestruction; override;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
procedure CMCursorChanged(var Message: TLMessage); message CM_CURSORCHANGED;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

15
lcl/include/graphiccontrol.inc
View File

@ -105,5 +105,20 @@ begin
TControlCanvas(Canvas).FreeHandle;
end;
procedure TGraphicControl.CMCursorChanged(var Message: TLMessage);
var
Pt: TPoint;
Ct: TControl;
begin
if not Visible then exit;
if Parent <> nil then begin
// execute only if the cursor is actually over the control
Pt := Parent.ScreenToClient(Mouse.CursorPos);
Ct := Parent.ControlAtPos(Pt, True);
if (Self = Ct) then
SetTempCursor(FCursor);
end;
end;
// included by controls.pp