paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-06 18:38:23 +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;

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

@ -48,6 +48,7 @@ type
procedure lclInvalidate; message 'lclInvalidate';
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::';
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:';
@ -62,6 +63,7 @@ type
procedure lclInvalidate; message 'lclInvalidate'; reintroduce;
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::'; 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;
@ -88,6 +90,7 @@ type
procedure lclInvalidate; message 'lclInvalidate'; reintroduce;
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::'; 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;
@ -443,7 +452,7 @@ function TCocoaWindow.windowShouldClose(sender: id): LongBool;
var
canClose: Boolean;
begin
canClose:=true;
canClose := True;
callback.CloseQuery(canClose);
Result := canClose;
end;
@ -475,7 +484,7 @@ end;
function TCocoaWindow.acceptsFirstResponder: Boolean;
begin
Result:=true;
Result := True;
end;
procedure TCocoaWindow.mouseUp(event: NSEvent);
@ -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;
@ -669,8 +709,39 @@ begin
end;
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;
@ -758,8 +829,20 @@ 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;
@ -784,17 +867,16 @@ end;
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;

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

@ -201,7 +201,8 @@ const
begin
win := TCocoaWindow(TCocoaWindow.alloc);
if not Assigned(win) then begin
if not Assigned(win) then
begin
Result := 0;
Exit;
end;