paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-30 17:22:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

cocoa: implement ScreenToClient and ClientToScren + various cleanup and formatting

Browse Source 
git-svn-id: trunk@34199 -
This commit is contained in:
paul 2011-12-15 07:22:12 +00:00
parent ed7ffcbdab
commit e162c3f604
6 changed files with 177 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -633,4 +633,3 @@ begin
Result := True;
end;

150
lcl/interfaces/cocoa/cocoaprivate.pp
View File

@ -47,7 +47,8 @@ type
procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:';
procedure lclInvalidate; message 'lclInvalidate';
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::';
procedure lclLocalToScreen(var X,Y: Integer); message 'lclLocalToScreen::';
procedure lclLocalToScreen(var X, Y: Integer); message 'lclLocalToScreen::';
procedure lclScreenToLocal(var X, Y: Integer); message 'lclScreenToLocal::';
function lclParent: id; message 'lclParent';
function lclFrame: TRect; message 'lclFrame';
procedure lclSetFrame(const r: TRect); message 'lclSetFrame:';
@ -61,7 +62,8 @@ type
procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:'; reintroduce;
procedure lclInvalidate; message 'lclInvalidate'; reintroduce;
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::'; reintroduce;
procedure lclLocalToScreen(var X,Y: Integer); message 'lclLocalToScreen::'; reintroduce;
procedure lclLocalToScreen(var X, Y: Integer); message 'lclLocalToScreen::'; reintroduce;
procedure lclScreenToLocal(var X, Y: Integer); message 'lclScreenToLocal::'; reintroduce;
function lclParent: id; message 'lclParent'; reintroduce;
function lclFrame: TRect; message 'lclFrame'; reintroduce;
procedure lclSetFrame(const r: TRect); message 'lclSetFrame:'; reintroduce;
@ -87,7 +89,8 @@ type
procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:'; reintroduce;
procedure lclInvalidate; message 'lclInvalidate'; reintroduce;
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::'; reintroduce;
procedure lclLocalToScreen(var X,Y: Integer); message 'lclLocalToScreen::'; reintroduce;
procedure lclLocalToScreen(var X, Y: Integer); message 'lclLocalToScreen::'; reintroduce;
procedure lclScreenToLocal(var X, Y: Integer); message 'lclScreenToLocal::'; reintroduce;
function lclFrame: TRect; message 'lclFrame'; reintroduce;
procedure lclSetFrame(const r: TRect); message 'lclSetFrame:'; reintroduce;
function lclClientFrame: TRect; message 'lclClientFrame'; reintroduce;
@ -211,6 +214,12 @@ type
TCocoaCustomControl = objcclass(NSControl)
callback: ICommonCallback;
procedure drawRect(dirtyRect: NSRect); override;
procedure mouseDown(event: NSEvent); override;
procedure mouseDragged(event: NSEvent); override;
procedure mouseEntered(event: NSEvent); override;
procedure mouseExited(event: NSEvent); override;
procedure mouseMoved(event: NSEvent); override;
procedure mouseUp(event: NSEvent); override;
procedure resetCursorRects; override;
end;
@ -441,11 +450,11 @@ end;
function TCocoaWindow.windowShouldClose(sender: id): LongBool;
var
canClose : Boolean;
canClose: Boolean;
begin
canClose:=true;
canClose := True;
callback.CloseQuery(canClose);
Result:=canClose;
Result := canClose;
end;
procedure TCocoaWindow.windowWillClose(notification: NSNotification);
@ -475,45 +484,45 @@ end;
function TCocoaWindow.acceptsFirstResponder: Boolean;
begin
Result:=true;
Result := True;
end;
procedure TCocoaWindow.mouseUp(event: NSEvent);
var
mp : NSPoint;
mp: NSPoint;
begin
mp:=event.locationInWindow;
mp.y:=NSView(event.window.contentView).bounds.size.height-mp.y;
mp := event.locationInWindow;
mp.y := NSView(event.window.contentView).bounds.size.height-mp.y;
callback.MouseUp(round(mp.x), round(mp.y));
inherited mouseUp(event);
end;
procedure TCocoaWindow.mouseDown(event: NSEvent);
var
mp : NSPoint;
mp: NSPoint;
begin
mp:=event.locationInWindow;
mp.y:=NSView(event.window.contentView).bounds.size.height-mp.y;
mp := event.locationInWindow;
mp.y := NSView(event.window.contentView).bounds.size.height-mp.y;
callback.MouseDown(round(mp.x), round(mp.y));
inherited mouseDown(event);
end;
procedure TCocoaWindow.mouseDragged(event: NSEvent);
var
mp : NSPoint;
mp: NSPoint;
begin
mp:=event.locationInWindow;
mp.y:=NSView(event.window.contentView).bounds.size.height-mp.y;
mp := event.locationInWindow;
mp.y := NSView(event.window.contentView).bounds.size.height - mp.y;
callback.MouseMove(round(mp.x), round(mp.y));
inherited mouseMoved(event);
end;
procedure TCocoaWindow.mouseMoved(event: NSEvent);
var
mp : NSPoint;
mp: NSPoint;
begin
mp:=event.locationInWindow;
mp.y:=NSView(event.window.contentView).bounds.size.height-mp.y;
mp := event.locationInWindow;
mp.y := NSView(event.window.contentView).bounds.size.height - mp.y;
callback.MouseMove(round(mp.x), round(mp.y));
inherited mouseMoved(event);
end;
@ -549,6 +558,36 @@ begin
callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect);
end;
procedure TCocoaCustomControl.mouseDown(event: NSEvent);
begin
inherited mouseDown(event);
end;
procedure TCocoaCustomControl.mouseDragged(event: NSEvent);
begin
inherited mouseDragged(event);
end;
procedure TCocoaCustomControl.mouseEntered(event: NSEvent);
begin
inherited mouseEntered(event);
end;
procedure TCocoaCustomControl.mouseExited(event: NSEvent);
begin
inherited mouseExited(event);
end;
procedure TCocoaCustomControl.mouseMoved(event: NSEvent);
begin
inherited mouseMoved(event);
end;
procedure TCocoaCustomControl.mouseUp(event: NSEvent);
begin
inherited mouseUp(event);
end;
procedure TCocoaCustomControl.resetCursorRects;
begin
if not callback.resetCursorRects then
@ -588,13 +627,14 @@ end;
procedure LCLObjectExtension.lclRelativePos(var Left,Top:Integer);
begin
Left := 0;
Top := 0;
end;
procedure LCLObjectExtension.lclLocalToScreen(var X,Y:Integer);
begin
end;
procedure LCLObjectExtension.lclScreenToLocal(var X, Y: Integer);
begin
end;
function LCLObjectExtension.lclParent:id;
@ -668,9 +708,40 @@ begin
end;
end;
procedure LCLViewExtension.lclLocalToScreen(var X,Y:Integer);
procedure LCLViewExtension.lclLocalToScreen(var X, Y:Integer);
var
P: NSPoint;
begin
// 1. convert to window base
P.x := X;
P.y := Y;
P := convertPoint_ToView(P, nil);
// 2. convert to screen
with window.frame.origin do
begin
P.x := P.x + x;
P.y := P.y + y;
end;
X := Round(P.x);
Y := Round(window.screen.frame.size.height - P.y);
end;
procedure LCLViewExtension.lclScreenToLocal(var X, Y: Integer);
var
P: NSPoint;
begin
// 1. convert from screen to window
P.x := X;
P.y := window.screen.frame.size.height - Y;
with window.frame.origin do
begin
P.x := P.x - x;
P.y := P.y - y;
end;
// 2. convert from window to local
P := convertPoint_FromView(P, nil);
X := Round(P.x);
Y := Round(P.y);
end;
function LCLViewExtension.lclParent:id;
@ -751,15 +822,27 @@ begin
end;
end;
procedure LCLWindowExtension.lclLocalToScreen(var X,Y:Integer);
procedure LCLWindowExtension.lclLocalToScreen(var X, Y:Integer);
var
f: NSRect;
begin
if Assigned(screen) then
begin
f := frame;
x := Round(f.origin.x + x);
y := Round(screen.frame.size.height - f.size.height - f.origin.y);
inc(X, Round(f.origin.x));
inc(Y, Round(screen.frame.size.height - f.size.height - f.origin.y));
end;
end;
procedure LCLWindowExtension.lclScreenToLocal(var X, Y: Integer);
var
f: NSRect;
begin
if Assigned(screen) then
begin
f := frame;
dec(X, Round(f.origin.x));
dec(Y, Round(screen.frame.size.height - f.size.height - f.origin.y));
end;
end;
@ -782,19 +865,18 @@ begin
setFrame_display(ns, isVisible);
end;
function LCLWindowExtension.lclClientFrame:TRect;
function LCLWindowExtension.lclClientFrame: TRect;
var
wr: NSRect;
b: CGGeometry.CGRect;
wFrame, cFrame: NSRect;
begin
wr := frame;
b := contentView.frame;
wFrame := frame;
cFrame := contentRectForFrameRect(wFrame);
with Result do
begin
Left := Round(b.origin.x);
Top := Round(wr.size.height - b.origin.y);
Right := Round(b.origin.x + b.size.width);
Bottom := Round(Result.Top + b.size.height);
Left := Round(cFrame.origin.x - wFrame.origin.x);
Top := Round(wFrame.origin.y + wFrame.size.height - cFrame.origin.y - cFrame.size.height);
Right := Left + Round(cFrame.size.width);
Bottom := Top + Round(cFrame.size.height);
end;
end;

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

@ -38,8 +38,24 @@ begin
end;
end;
function TCocoaWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN;
fnCombineMode: Longint): Longint;
function TCocoaWidgetSet.ClientToScreen(Handle: HWND; var P: TPoint): Boolean;
begin
Result := Handle <> 0;
if Result then
begin
// 1. convert client to window
with NSObject(Handle).lclClientFrame do
begin
inc(P.X, Left);
inc(P.Y, Top);
end;
// 2. convert window to screen
NSObject(Handle).lclLocalToScreen(P.X, P.Y);
end;
end;
function TCocoaWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint;
begin
Result := LCLType.Error;
if (Dest = 0) or (Src1 = 0) or (fnCombineMode<RGN_AND) or (fnCombineMode>RGN_COPY) then Exit;
@ -293,9 +309,9 @@ end;
function TCocoaWidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
begin
if hWnd<>0
then NSObject(hWnd).lclSetEnabled(bEnable)
else Result:=False;
Result := hWnd <> 0;
if Result then
NSObject(hWnd).lclSetEnabled(bEnable)
end;
function TCocoaWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
@ -817,6 +833,13 @@ begin
CritSection:=0;
end;
function TCocoaWidgetSet.DeleteDC(hDC: HDC): Boolean;
begin
Result := hDC <> 0;
if Result then
TCocoaContext(hDC).Free;
end;
procedure TCocoaWidgetSet.EnterCriticalSection(var CritSection: TCriticalSection);
begin
if CritSection=0 then Exit;
@ -1140,6 +1163,23 @@ begin
Result:=0;
end;
function TCocoaWidgetSet.ScreenToClient(Handle: HWND; var P: TPoint): Integer;
begin
Result := Ord(Handle <> 0);
if Result = 1 then
begin
// 1. convert screen to window
NSObject(Handle).lclScreenToLocal(P.X, P.Y);
// 2. convert window to client
with NSObject(Handle).lclClientFrame do
begin
dec(P.X, Left);
dec(P.Y, Top);
end;
end;
end;
function TCocoaWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;
begin
Result := ExtSelectClipRgn(DC, RGN, RGN_COPY);

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

@ -34,9 +34,9 @@
function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; override;
function CallNextHookEx(hHk: HHOOK; ncode : Integer; wParam: WParam; lParam : LParam) : Integer; override;
function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; wParam: WParam; lParam : lParam) : Integer; override;
function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; wParam: WParam; lParam : lParam) : Integer; override;}
function ClientToScreen(Handle: HWND; var P: TPoint) : Boolean; override;
{
function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; override;
function ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean; override;
@ -62,7 +62,7 @@ function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override;
procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;
{function DeleteDC(hDC: HDC): Boolean; override;}
function DeleteDC(hDC: HDC): Boolean; override;
function DeleteObject(GDIObject: HGDIOBJ): Boolean; override;
{function DestroyCaret(Handle : HWND): Boolean; override;}
function DestroyIcon(Handle: HICON): Boolean; override;
@ -159,7 +159,7 @@ function RestoreDC(DC: HDC; SavedDC: Integer): Boolean; override;
{function RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean; override;}
function SaveDC(DC: HDC): Integer; override;
{function ScreenToClient(Handle : HWND; var P : TPoint) : Integer; override;}
function ScreenToClient(Handle: HWND; var P: TPoint): Integer; override;
function SelectClipRGN(DC : hDC; RGN : HRGN) : Longint; override;
function SelectObject(ADC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; override;
{function SendMessage(HandleWnd: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; override;

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

@ -338,14 +338,14 @@ begin
if (AWinControl.Handle <> 0) then
begin
Obj := NSObject(AWinControl.Handle);
{
{
if Obj.isKindOfClass_(NSView) then
begin
Size := NSView(Obj).fittingSize;
PreferredWidth := Round(Size.width);
PreferredHeight := Round(Size.height);
end;
}
}
end;
end;

19
lcl/interfaces/cocoa/cocoawsforms.pp
View File

@ -193,30 +193,31 @@ end;
class function TCocoaWSCustomForm.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
win : TCocoaWindow;
cnt : TCocoaCustomControl;
ns : NSString;
win: TCocoaWindow;
cnt: TCocoaCustomControl;
ns: NSString;
const
WinMask = NSTitledWindowMask or NSClosableWindowMask or NSMiniaturizableWindowMask or NSResizableWindowMask;
begin
win := TCocoaWindow(TCocoaWindow.alloc);
if not Assigned(win) then begin
Result:=0;
if not Assigned(win) then
begin
Result := 0;
Exit;
end;
win:=TCocoaWindow(win.initWithContentRect_styleMask_backing_defer(CreateParamsToNSRect(AParams), WinMask, NSBackingStoreBuffered, False));
win := TCocoaWindow(win.initWithContentRect_styleMask_backing_defer(CreateParamsToNSRect(AParams), WinMask, NSBackingStoreBuffered, False));
win.enableCursorRects;
TCocoaWindow(win).callback:=TLCLWindowCallback.Create(win, AWinControl);
win.setDelegate(win);
ns:=NSStringUtf8(AWinControl.Caption);
ns := NSStringUtf8(AWinControl.Caption);
win.setTitle(ns);
ns.release;
win.setAcceptsMouseMovedEvents(True);
cnt:=TCocoaCustomControl.alloc.init;
cnt.callback:=TCocoaWindow(win).callback;
cnt := TCocoaCustomControl.alloc.init;
cnt.callback := TCocoaWindow(win).callback;
win.setContentView(cnt);
Result := TLCLIntfHandle(win);