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

Cocoa: Enable MouseCapture

Browse Source 
git-svn-id: trunk@43939 -
This commit is contained in:
freq 2014-02-07 13:16:50 +00:00
parent af91af27e9
commit b90ff1c48b
5 changed files with 77 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/interfaces/cocoa/cocoaint.pas
View File

@ -64,6 +64,7 @@ type
pool: NSAutoreleasePool;
FNSApp: NSApplication;
FCurrentCursor: HCursor;
FCaptureControl: HWND;
delegate: TCocoaAppDelegate;
protected
FStockNullBrush: HBRUSH;
@ -129,6 +130,7 @@ type
function GetImagePixelData(AImage: CGImageRef; out bitmapByteCount: PtrUInt): Pointer;
property NSApp: NSApplication read FNSApp;
property CurrentCursor: HCursor read FCurrentCursor write FCurrentCursor;
property CaptureControl: HWND read FCaptureControl;
// the winapi compatibility methods
{$I cocoawinapih.inc}
// the extra LCL interface methods

1
lcl/interfaces/cocoa/cocoaobject.inc
View File

@ -87,6 +87,7 @@ begin
inherited Create;
FTerminating := False;
FCurrentCursor:= 0;
FCaptureControl:= 0;
{ Creates the AutoreleasePool }
pool := NSAutoreleasePool.alloc.init;

15
lcl/interfaces/cocoa/cocoawinapi.inc
View File

@ -557,6 +557,11 @@ begin
Result := CLR_INVALID;
end;
function TCocoaWidgetSet.GetCapture: HWND;
begin
Result:=FCaptureControl;
end;
function TCocoaWidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean;
begin
Result := CocoaCaret.GetCaretPos(lpPoint);
@ -1686,6 +1691,11 @@ begin
Result := 0;
end;
function TCocoaWidgetSet.SetCapture(AHandle: HWND): HWND;
begin
FCaptureControl:= AHandle;
end;
function TCocoaWidgetSet.SetCaretPos(X, Y: Integer): Boolean;
begin
Result := CocoaCaret.SetCaretPos(X, Y);
@ -1720,6 +1730,11 @@ begin
Result := IntersectRect(R, ARect, CGRectToRect(ClipBox));
end;
function TCocoaWidgetSet.ReleaseCapture : Boolean;
begin
FCaptureControl:=0;
end;
function TCocoaWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
var
ctx: TCocoaContext;

6
lcl/interfaces/cocoa/cocoawinapih.inc
View File

@ -83,7 +83,7 @@ function FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer; override;
function GetActiveWindow: HWND; override;
{function GetBitmapBits(Bitmap: HBITMAP; Count: Longint; Bits: Pointer): Longint; override;}
function GetBkColor(DC: HDC): TColorRef; override;
{function GetCapture: HWND; override;}
function GetCapture: HWND; override;
function GetCaretPos(var lpPoint: TPoint): Boolean; override;
function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; override;
function GetClientBounds(handle : HWND; var ARect : TRect) : Boolean; override;
@ -147,7 +147,7 @@ function PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam; lParam: LParam
function Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; override;
function RectVisible(dc : hdc; const ARect: TRect) : Boolean; override;
{function ReleaseCapture : Boolean; override;}
function ReleaseCapture : Boolean; override;
function ReleaseDC(hWnd: HWND; DC: HDC): Integer; override;
function RestoreDC(DC: HDC; SavedDC: Integer): Boolean; override;
function RoundRect(DC: HDC; X1, Y1, X2, Y2: Integer; RX, RY : Integer): Boolean; override;
@ -160,7 +160,7 @@ function SendMessage(Handle: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam
function SetActiveWindow(Handle: HWND): HWND; override;
function SetBKColor(DC: HDC; Color: TColorRef): TColorRef; override;
function SetBkMode(DC: HDC; bkMode : Integer) : Integer; override;
{function SetCapture(AHandle: HWND): HWND; override;}
function SetCapture(AHandle: HWND): HWND; override;
function SetCaretPos(X, Y: Integer): Boolean; override;
function SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean; override;
function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; override;

77
lcl/interfaces/cocoa/cocoawscommon.pas
View File

@ -29,6 +29,7 @@ type
FTarget: TWinControl;
FBoundsReportedToChildren: boolean;
FIsOpaque:boolean;
FIsEventRouting:boolean;
function CheckMouseButtonDown(Event: NSEvent; AButton: Integer): Cardinal;
function GetHasCaret: Boolean;
procedure SetHasCaret(AValue: Boolean);
@ -250,6 +251,7 @@ begin
FPropStorage.Duplicates := dupAccept;
FBoundsReportedToChildren:=false;
FIsOpaque:=false;
FIsEventRouting:=false;
end;
destructor TLCLCommonCallback.Destroy;
@ -685,6 +687,8 @@ var
MsgContext: TLMContextMenu;
MousePos: NSPoint;
MButton: NSInteger;
obj:NSObject;
callback: ICommonCallback;
begin
Result := False; // allow cocoa to handle message
@ -692,6 +696,20 @@ begin
if Assigned(Target) and (not (csDesigning in Target.ComponentState) and not Owner.lclIsEnabled) then
Exit;
//debugln('MouseUpDownEvent '+Target.name);
if CocoaWidgetSet.CaptureControl<>0 then // check if to route event to capture control
begin
obj:=NSObject(CocoaWidgetSet.CaptureControl);
if (obj<>Owner) and not FIsEventRouting then
begin
FIsEventRouting:=true;
callback:=obj.lclGetCallback;
Result:=callback.MouseUpDownEvent(Event);
FIsEventRouting:=false;
exit;
end;
end;
// idea of multi click implementation is taken from gtk
FillChar(Msg, SizeOf(Msg), #0);
@ -775,32 +793,49 @@ begin
rect:=Owner.lclClientFrame;
targetControl:=nil;
if assigned(Target.Parent) and not PtInRect(rect, mp) then
targetControl:=Target.Parent // outside myself then go to parent
else
for i:=Target.ComponentCount-1 downto 0 do // otherwise check, if over child
if Target.Components[i] is TWinControl then
begin
childControl:=TWinControl(Target.Components[i]);
rect:=childControl.BoundsRect;
if PtInRect(rect, mp) then
begin
targetControl:=childControl;
break;
end;
end;
if CocoaWidgetSet.CaptureControl<>0 then // check if to route event to capture control
begin
obj:=NSObject(CocoaWidgetSet.CaptureControl);
if (obj<>Owner) and not FIsEventRouting then
begin
FIsEventRouting:=true;
callback:=obj.lclGetCallback;
result:=callback.MouseMove(Event);
FIsEventRouting:=false;
exit;
end;
end
else
begin
if assigned(Target.Parent) and not PtInRect(rect, mp) then
targetControl:=Target.Parent // outside myself then route to parent
else
for i:=Target.ComponentCount-1 downto 0 do // otherwise check, if over child and route to child
if Target.Components[i] is TWinControl then
begin
childControl:=TWinControl(Target.Components[i]);
rect:=childControl.BoundsRect;
if PtInRect(rect, mp) then
begin
targetControl:=childControl;
break;
end;
end;
end;
if assigned(targetControl) then
if assigned(targetControl) and not FIsEventRouting then
begin
//debugln(Target.name+' -> '+targetControl.Name+'- is parent:'+dbgs(targetControl=Target.Parent)+' Point: '+dbgs(mp)+' Rect'+dbgs(rect));
obj:=NSView(targetControl.Handle);
callback:=obj.lclGetCallback;
result:=callback.MouseMove(Event);
exit;
FIsEventRouting:=true;
// debugln(Target.name+' -> '+targetControl.Name+'- is parent:'+dbgs(targetControl=Target.Parent)+' Point: '+dbgs(mp)+' Rect'+dbgs(rect));
obj:=NSView(targetControl.Handle);
callback:=obj.lclGetCallback;
result:=callback.MouseMove(Event);
FIsEventRouting:=false;
exit;
end;
//debugln('Send to: '+Target.name+' Point: '+dbgs(mp));
// debugln('Send to: '+Target.name+' Point: '+dbgs(mp));
FillChar(Msg, SizeOf(Msg), #0);
Msg.Msg := LM_MOUSEMOVE;