1{%MainUnit cocoaint.pas}
2{ $Id: cocoawinapi.inc 15525 2008-06-23 06:39:58Z paul $ }
3{******************************************************************************
4  All Cocoa Winapi implementations.
5  This are the implementations of the overrides of the Cocoa Interface for the
6  methods defined in the
7  lcl/include/winapi.inc
8
9 ******************************************************************************
10 Implementation
11 ******************************************************************************
12
13 *****************************************************************************
14  This file is part of the Lazarus Component Library (LCL)
15
16  See the file COPYING.modifiedLGPL.txt, included in this distribution,
17  for details about the license.
18 *****************************************************************************
19}
20
21//##apiwiz##sps##   // Do not remove, no wizard declaration before this line
22
23function CocoaCombineMode(ACombineMode: Integer): TCocoaCombine;
24begin
25  case ACombineMode of
26    RGN_AND:  Result:=cc_And;
27    RGN_OR:   Result:=cc_Or;
28    RGN_XOR:  Result:=cc_Xor;
29    RGN_DIFF: Result:=cc_Diff;
30  else
31    Result:=cc_Copy;
32  end;
33end;
34
35const
36  CocoaRegionTypeToWin32Map: array[TCocoaRegionType] of Integer = (
37 { crt_Error     } ERROR,
38 { crt_Empty     } NULLREGION,
39 { crt_Rectangle } SIMPLEREGION,
40 { crt_Complex   } COMPLEXREGION
41  );
42
43function TCocoaWidgetSet.Arc(DC: HDC; Left, Top, Right, Bottom, angle1,
44  angle2: Integer): Boolean;
45begin
46  Result:=inherited Arc(DC, Left, Top, Right, Bottom, angle1, angle2);
47end;
48
49function TCocoaWidgetSet.AngleChord(DC: HDC; x1, y1, x2, y2, angle1,
50  angle2: Integer): Boolean;
51begin
52  Result:=inherited AngleChord(DC, x1, y1, x2, y2, angle1, angle2);
53end;
54
55function TCocoaWidgetSet.BeginPaint(Handle: hWnd; var PS: TPaintStruct): hdc;
56begin
57  Result := inherited BeginPaint(Handle, PS);
58  PS.hdc := Result;
59end;
60
61function TCocoaWidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer;
62  SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
63var
64  SrcCtx, DestCtx: TCocoaContext;
65  Bmp: TCocoaBitmap;
66begin
67  SrcCtx := CheckDC(SrcDC);
68  DestCtx := CheckDC(DestDC);
69
70  Result := Assigned(SrcCtx) and Assigned(DestCtx);
71
72  if not Result then
73    Exit;
74
75  if not (SrcCtx is TCocoaBitmapContext) then
76  begin
77    DebugLn('StretchMaskBlt Error - invalid source device context ', SrcCtx.ClassName,
78      ', expected TCocoaBitmapContext!');
79    Exit(False);
80  end;
81
82  Bmp := TCocoaBitmapContext(SrcCtx).Bitmap;
83
84  if not Assigned(Bmp) then
85    Exit(False);
86
87  // Width and Height should not be greater than bitmap width
88  Width := Min(Width, Bmp.Width);
89  Height := Min(Height, Bmp.Height);
90
91  Result := DestCtx.StretchDraw(X, Y, Width, Height,
92    TCocoaBitmapContext(SrcCtx), XSrc, YSrc, Width, Height,
93    nil, 0, 0, Rop);
94end;
95
96function TCocoaWidgetSet.ClientToScreen(Handle: HWND; var P: TPoint): Boolean;
97var
98  r : NSRect;
99  cl : NSView;
100  clr : TRect;
101begin
102  Result := Handle <> 0;
103
104  if Result then
105  begin
106    // must use lclContentView! - it's client view
107    cl := NSObject(Handle).lclContentView;
108    if HWND(cl) = Handle then
109    begin
110      // if Handle is lclContentView, then we should check clientRect
111      // (i.e. TabControl doesn't have lclContentView, yet its clientRect is adjusted)
112      clr := NSObject(Handle).lclClientFrame;
113      P.X := P.X + clr.Left;
114      P.Y := P.Y + clr.Top;
115    end;
116    cl.lclLocalToScreen(P.X, P.Y);
117  end;
118end;
119
120procedure TCocoaWidgetSet.CallDefaultWndHandler(Sender: TObject; var Message);
121var
122  hnd : NSObject;
123  vw  : NSView;
124  tb : Boolean;
125  ar : Boolean;
126  ks : Boolean;
127  rt : Boolean;
128const
129  WantTab   : array [boolean] of integer = (0, DLGC_WANTTAB);
130  WantArrow : array [boolean] of integer = (0, DLGC_WANTARROWS);
131  WantKeys  : array [boolean] of integer = (0, DLGC_WANTALLKEYS);
132begin
133  case TLMessage(Message).Msg of
134    LM_GETDLGCODE: begin
135      hnd := nil;
136      if (Sender is TWinControl) then hnd := NSObject(TWinControl(Sender).Handle);
137      if not Assigned(hnd) then Exit;
138      vw := hnd.lclContentView();
139      if Assigned(vw) then
140      begin
141        tb := false;
142        ar := false;
143        ks := false;
144        rt := false;
145        vw.lclExpectedKeys(tb, ar, rt, ks);
146        ks := ks or rt; // Return is handled by LCL as part of ALLKey
147        TLMessage(Message).Result := TLMessage(Message).Result or WantTab[tb] or WantArrow[ar] or WantKeys[ks];
148      end;
149
150    end;
151  else
152    TLMessage(Message).Result := 0;
153  end;
154end;
155
156{------------------------------------------------------------------------------
157  Method:  ClipboardFormatToMimeType
158  Params:  FormatID - A registered format identifier (0 is invalid)
159  Returns: The corresponding mime type as string
160 ------------------------------------------------------------------------------}
161function TCocoaWidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
162begin
163  {$IFDEF VerboseClipboard}
164    DebugLn('TCocoaWidgetSet.ClipboardFormatToMimeType FormatID: ' + DbgS(FormatID));
165  {$ENDIF}
166  Result := fClipboard.FormatToMimeType(FormatID);
167end;
168
169{------------------------------------------------------------------------------
170  Method:  ClipboardGetData
171  Params:  ClipboardType - Clipboard type
172           FormatID      - A registered format identifier (0 is invalid)
173           Stream        - If format is available, it will be appended to this
174                           stream
175  Returns: If the function succeeds
176 ------------------------------------------------------------------------------}
177function TCocoaWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
178  FormatID: TClipboardFormat; Stream: TStream): boolean;
179begin
180  {$IFDEF VerboseClipboard}
181    DebugLn('TCocoaWidgetSet.ClipboardGetData ClipboardType=' +
182      ClipboardTypeName[ClipboardType] + ' FormatID: ' + DbgS(FormatID));
183  {$ENDIF}
184  Result := fClipboard.GetData(ClipboardType, FormatID, Stream);
185end;
186
187{------------------------------------------------------------------------------
188  Method:  ClipboardGetFormats
189  Params:  ClipboardType - The type of clipboard operation
190           Count         - The number of clipboard formats
191           List          - Pointer to an array of supported formats
192                           (you must free it yourself)
193  Returns: If the function succeeds
194 ------------------------------------------------------------------------------}
195
196function TCocoaWidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType;
197  var Count: integer; var List: PClipboardFormat): boolean;
198var
199  fmt: TDynClipboardFormatArray;
200begin
201  {$IFDEF VerboseClipboard}
202    DebugLn('TCocoaWidgetSet.ClipboardGetFormats ClipboardType' +
203      ClipboardTypeName[ClipboardType]);
204  {$ENDIF}
205  fmt := nil;
206  Result := fClipboard.GetFormats(ClipboardType, Count, fmt);
207  if Count > 0 then begin
208    GetMem(List, Count * sizeof(TClipboardFormat));
209    System.Move(fmt[0], List^, Count * sizeof(TClipboardFormat));
210  end else
211    List := nil;
212end;
213
214{------------------------------------------------------------------------------
215  Method:  ClipboardGetOwnerShip
216  Params:  ClipboardType - Type of clipboard
217           OnRequestProc - TClipboardRequestEvent is defined in LCLType.pp
218                           If OnRequestProc is nil the onwership will end.
219           FormatCount   - Number of formats
220           Formats       - Array of TClipboardFormat. The supported formats the
221                           owner provides.
222
223  Returns: If the function succeeds
224
225  Sets the supported formats and requests ownership for the clipboard.
226  The OnRequestProc is used to get the data from the LCL and to put it on the
227  clipboard.
228  If someone else requests the ownership, the OnRequestProc will be executed
229  with the invalid FormatID 0 to notify the old owner of the lost of ownership.
230 ------------------------------------------------------------------------------}
231function TCocoaWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
232  OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
233  Formats: PClipboardFormat): boolean;
234begin
235  {$IFDEF VerboseClipboard}
236    DebugLn('TCocoaWidgetSet.ClipboardGetOwnerShip ClipboardType=' +
237      ClipboardTypeName[ClipboardType] + ' FormatCount: ' + DbgS(FormatCount));
238  {$ENDIF}
239  Result := fClipboard.GetOwnership(ClipboardType, OnRequestProc, FormatCount, Formats);
240end;
241
242{------------------------------------------------------------------------------
243  Method:  ClipboardRegisterFormat
244  Params:  AMimeType - A string (usually a MIME type) identifying a new format
245                       type to register
246  Returns: The registered Format identifier (TClipboardFormat)
247 ------------------------------------------------------------------------------}
248function TCocoaWidgetSet.ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat;
249begin
250  Result := fClipboard.RegisterFormat(AMimeType);
251  {$IFDEF VerboseClipboard}
252    DebugLn('TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=' + AMimeType
253      + ' Result='+DbgS(Result));
254  {$ENDIF}
255end;
256
257function TCocoaWidgetSet.ClipboardFormatNeedsNullByte(
258  const AFormat: TPredefinedClipboardFormat): Boolean;
259begin
260  Result := False
261end;
262
263function TCocoaWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint;
264begin
265  Result := LCLType.Error;
266  if (Dest = 0) or (Src1 = 0) or (fnCombineMode<RGN_AND) or (fnCombineMode>RGN_COPY) then Exit;
267  if (fnCombineMode <> RGN_COPY) and (Src2 = 0) then Exit;
268
269  Result := CocoaRegionTypeToWin32Map[TCocoaRegion(Dest).CombineWith(TCocoaRegion(Src1), cc_Copy)];
270
271  if fnCombineMode <> RGN_COPY then
272    Result := CocoaRegionTypeToWin32Map[TCocoaRegion(Dest).CombineWith(TCocoaRegion(Src2), CocoaCombineMode(fnCombineMode))];
273end;
274
275{------------------------------------------------------------------------------
276  Method:  CreateBitmap
277  Params:  Width      - Bitmap width, in pixels
278           Height     - Bitmap height, in pixels
279           Planes     - Number of color planes
280           BitCount   - Number of bits required to identify a color (TODO)
281           BitmapBits - Pointer to array containing color data (TODO)
282  Returns: A handle to a bitmap
283
284  Creates a bitmap with the specified width, height and color format
285 ------------------------------------------------------------------------------}
286function TCocoaWidgetSet.CreateBitmap(Width, Height: Integer;
287  Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP;
288var
289  bmpType: TCocoaBitmapType;
290begin
291  // WORKAROUND: force context supported depths
292  if BitmapBits = nil then
293  begin
294    if BitCount = 24 then BitCount := 32;
295    // if BitCount = 1 then BitCount := 8;
296  end;
297
298  case BitCount of
299    1:  bmpType := cbtMono;
300    8:  bmpType := cbtGray;
301    32: bmpType := cbtARGB;
302  else
303    bmpType := cbtRGB;
304  end;
305
306  // winapi Bitmaps are on a word boundary
307  Result := HBITMAP(TCocoaBitmap.Create(Width, Height, BitCount, BitCount, cbaWord, bmpType, BitmapBits));
308end;
309
310function TCocoaWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH;
311begin
312  Result := HBrush(TCocoaBrush.Create(LogBrush));
313end;
314
315function TCocoaWidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; Width,
316  Height: Integer): Boolean;
317begin
318  Result := (Handle <> 0);
319  if Result then
320    Result := CocoaCaret.CreateCaret(NSView(Handle).lclContentView, Bitmap, Width, Height)
321end;
322
323function TCocoaWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP;
324begin
325  Result := HBITMAP(TCocoaBitmap.Create(Width, Height, 32, 32, cbaDQWord, cbtARGB, nil));
326end;
327
328{------------------------------------------------------------------------------
329  Method:  CreateCompatibleDC
330  Params:  DC - Handle to memory device context
331  Returns: Handle to a memory device context
332
333  Creates a memory device context (DC) compatible with the specified device
334 ------------------------------------------------------------------------------}
335function TCocoaWidgetSet.CreateCompatibleDC(DC: HDC): HDC;
336begin
337  Result := HDC(TCocoaBitmapContext.Create);
338end;
339
340//todo:
341//function TCocoaWidgetSet.CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN;
342//begin
343//end;
344
345function TCocoaWidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT;
346begin
347  Result := HFont(TCocoaFont.Create(LogFont, LogFont.lfFaceName));
348end;
349
350function TCocoaWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont;
351  const LongFontName: string): HFONT;
352begin
353  Result := HFont(TCocoaFont.Create(LogFont, LongFontName));
354end;
355
356class function TCocoaWidgetSet.Create32BitAlphaBitmap(ABitmap, AMask: TCocoaBitmap): TCocoaBitmap;
357var
358  ARawImage: TRawImage;
359  Desc: TRawImageDescription absolute ARawimage.Description;
360
361  ImgHandle, ImgMaskHandle: HBitmap;
362  ImagePtr: PRawImage;
363  DevImage: TRawImage;
364  DevDesc: TRawImageDescription;
365  SrcImage, DstImage: TLazIntfImage;
366  W, H: Integer;
367begin
368  Result := nil;
369
370  if not LCLIntf.RawImage_FromBitmap(ARawImage, HBITMAP(ABitmap), HBITMAP(AMask)) then
371    Exit;
372
373  ImgMaskHandle := 0;
374
375  W := Desc.Width;
376  if W < 1 then W := 1;
377  H := Desc.Height;
378  if H < 1 then H := 1;
379
380  QueryDescription(DevDesc, [riqfRGB, riqfAlpha], W, H);
381
382  if DevDesc.IsEqual(Desc)
383  then begin
384    // image is compatible, so use it
385    DstImage := nil;
386    ImagePtr := @ARawImage;
387  end
388  else begin
389    // create compatible copy
390    SrcImage := TLazIntfImage.Create(ARawImage, False);
391    DstImage := TLazIntfImage.Create(0,0,[]);
392    DstImage.DataDescription := DevDesc;
393    DstImage.CopyPixels(SrcImage);
394    SrcImage.Free;
395    DstImage.GetRawImage(DevImage);
396    ImagePtr := @DevImage;
397  end;
398
399  try
400    if not LCLIntf.RawImage_CreateBitmaps(ImagePtr^, ImgHandle, ImgMaskHandle, True) then Exit;
401
402    Result := TCocoaBitmap(ImgHandle);
403  finally
404    ARawImage.FreeData;
405    DstImage.Free;
406  end;
407end;
408
409function TCocoaWidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON;
410var
411  ABitmap: TCocoaBitmap;
412begin
413  Result := 0;
414  if IconInfo^.hbmColor = 0 then Exit;
415
416  ABitmap := Create32BitAlphaBitmap(TCocoaBitmap(IconInfo^.hbmColor), TCocoaBitmap(IconInfo^.hbmMask));
417
418  if IconInfo^.fIcon then
419    Result := HICON(ABitmap)
420  else
421    Result := HICON(TCocoaCursor.CreateFromBitmap(ABitmap, GetNSPoint(IconInfo^.xHotSpot, IconInfo^.yHotSpot)));
422end;
423
424function TCocoaWidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN;
425begin
426  Result := HPen(TCocoaPen.Create(LogPen));
427end;
428
429{------------------------------------------------------------------------------
430  Method:  CreatePolygonRgn
431  Params:  Points   - Pointer to array of polygon points
432           NumPts   - Number of points passed
433           FillMode - Filling mode
434  Returns: The new polygonal region
435
436  Creates a new polygonal region from the specified points
437 ------------------------------------------------------------------------------}
438function TCocoaWidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer;
439  FillMode: integer): HRGN;
440begin
441  {$IFDEF VerboseWinAPI}
442    DebugLn('TCocoaWidgetSet.CreatePolygonRgn NumPts: ' + DbgS(NumPts) +
443      ' FillMode: ' + DbgS(FillMode));
444  {$ENDIF}
445
446  Result := HRGN(TCocoaRegion.Create(Points, NumPts, FillMode=ALTERNATE));
447end;
448
449function TCocoaWidgetSet.CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
450begin
451  {$IFDEF VerboseWinAPI}
452    DebugLn('TCocoaWidgetSet.CreateRectRgn R: ' + DbgS(Classes.Rect(X1, Y1, X2, Y2)));
453  {$ENDIF}
454
455  Result := HRGN(TCocoaRegion.Create(X1, Y1, X2, Y2));
456end;
457
458function TCocoaWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
459const
460  SName = 'TCocoaWidgetSet.DeleteObject';
461var
462  gdi: TCocoaGDIObject;
463begin
464  Result := False;
465  if GDIObject = 0 then
466    Exit(True);
467
468  gdi := CheckGDIOBJ(GdiObject);
469
470  if not Assigned(gdi) then
471  begin
472    DebugLn(SName, ' Error - GDIObject: ' +  DbgSName(gdi) + ' is unknown!');
473    Exit;
474  end;
475
476  if gdi.Global then
477  begin
478    // global brushes can be cached, so just exit here since we will free the resource later on
479    //DebugLn(SName, ' Error - GDIObject: ' +  DbgSName(gdi) + ' is global!');
480    Exit;
481  end;
482
483  if gdi.RefCount <> 1 then
484  begin
485    DebugLn(SName, 'Error - GDIObject: ' + DbgSName(gdi) + ' is still selected!');
486    Exit;
487  end;
488
489  gdi.Destroy;
490  Result := True;
491end;
492
493function TCocoaWidgetSet.DestroyCaret(Handle: HWND): Boolean;
494begin
495  Result := CocoaCaret.DestroyCaret( NSView(Handle).lclContentView );
496end;
497
498function TCocoaWidgetSet.DestroyIcon(Handle: HICON): Boolean;
499var
500  Ico: TObject;
501begin
502  Result := Handle <> 0;
503  if not Result then
504    Exit;
505  Ico := TObject(Handle);
506  Result := (Ico is TCocoaBitmap) or (Ico is TCocoaCursor);
507  if Result then
508    Ico.Destroy;
509end;
510
511function TCocoaWidgetSet.DPtoLP(DC: HDC; var Points; Count: Integer): BOOL;
512var
513  ctx: TCocoaContext;
514  P: PPoint;
515begin
516  Result := False;
517  ctx := CheckDC(DC);
518  if not Assigned(ctx) then Exit;
519  P := @Points;
520  with ctx.GetLogicalOffset do
521    while Count > 0 do
522    begin
523      Dec(Count);
524      dec(P^.X, X);
525      dec(P^.Y, Y);
526      inc(P);
527    end;
528  Result := True;
529end;
530
531function TCocoaWidgetSet.DrawFocusRect(DC: HDC; const Rect: TRect): boolean;
532var
533  ctx: TCocoaContext;
534  p: Integer;
535  pn: TCocoaPen;
536  opn: TCocoaPen;
537  r: TRect;
538begin
539
540  ctx := CheckDC(DC);
541  Result := Assigned(ctx);
542  if Result then
543  begin
544    //ctx.DrawFocusRect(Rect);
545
546    // drawing in Windows compatible XOR style
547
548    p:=ctx.ROP2;
549    opn:=ctx.Pen;
550    pn:=TCocoaPen.Create(clDkGray, psSolid, true, 2, pmCopy, pecFlat, pjsRound, false );
551    try
552      ctx.Pen:=pn;
553      ctx.ROP2:=R2_NOTXORPEN;
554      ctx.Pen.Apply(ctx, true);
555      r:=Rect;
556      dec(r.Right);
557      dec(r.Bottom);
558      ctx.Frame(r);
559    finally
560      ctx.ROP2:=p;
561      ctx.Pen:=opn;
562      pn.Free;
563    end;
564  end;
565end;
566
567procedure DrawEdgeRect(dst: TCocoaContext; const r: TRect; flags: Cardinal;
568  LTColor, BRColor: TColor);
569begin
570  dst.Pen.SetColor(LTColor, true);
571  dst.Pen.Apply(dst);
572  if flags and BF_LEFT > 0 then
573  begin
574    dst.MoveTo(r.Left, r.Bottom);
575    dst.LineTo(r.Left, r.Top);
576  end;
577  if flags and BF_TOP > 0 then
578  begin
579    dst.MoveTo(r.Left, r.Top);
580    dst.LineTo(r.Right, r.Top);
581  end;
582
583  dst.Pen.SetColor(BRColor, true);
584  dst.Pen.Apply(dst);
585  if flags and BF_RIGHT > 0 then
586  begin
587    dst.MoveTo(r.Right, r.Top);
588    dst.LineTo(r.Right, r.Bottom);
589  end;
590  if flags and BF_BOTTOM > 0 then
591  begin
592    dst.MoveTo(r.Right, r.Bottom);
593    // there's a missing pixel. Seems like it's accumulating an offset
594    dst.LineTo(r.Left-1, r.Bottom);
595  end;
596end;
597
598function TCocoaWidgetSet.DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal;
599  grfFlags: Cardinal): Boolean;
600var
601  ctx: TCocoaContext;
602  r: TRect;
603  keepPen   : TCocoaPen;
604  edgePen   : TCocoaPen;
605  keepBrush : TCocoaBrush;
606  edgeBrush : TCocoaBrush;
607const
608  OutLT = cl3DLight;    // the next to hilight
609  OutBR = cl3DDkShadow; // the darkest (almost black)
610  InnLT = cl3DHiLight;  // the lightest (almost white)
611  InnBR = cl3DShadow;   // darker than light, lighter than dark shadow
612begin
613  ctx := CheckDC(DC);
614  Result := Assigned(ctx);
615  if not Result then Exit;
616
617  keepPen := ctx.Pen;
618  keepBrush := ctx.Brush;
619  try
620    edgePen := TCocoaPen.Create($FFFFFF, psSolid, false, 1, pmCopy, pecRound, pjsRound);
621    edgeBrush := TCocoaBrush.Create(NSColor.whiteColor, false);
622    edgeBrush.Solid := false;
623    ctx.Pen := edgePen;
624    ctx.Brush := edgeBrush;
625
626    r := Rect;
627    if (edge and BDR_OUTER > 0) then
628    begin
629      if edge and BDR_RAISEDOUTER > 0 then
630        DrawEdgeRect(ctx, r, grfFlags, OutLT, OutBR)
631      else
632        DrawEdgeRect(ctx, r, grfFlags, InnBR, InnLT);
633      InflateRect(r, -1, -1);
634    end;
635
636    if (edge and BDR_INNER > 0) then
637    begin
638      if edge and BDR_RAISEDINNER > 0 then
639        DrawEdgeRect(ctx, r, grfFlags, InnLT, InnBR)
640      else
641        DrawEdgeRect(ctx, r, grfFlags, OutBR, OutLT);
642    end;
643
644  finally
645    ctx.Pen := keepPen;
646    ctx.Brush := keepBrush;
647    edgeBrush.Free;
648    edgePen.Free;
649  end;
650
651  Result := true;
652end;
653
654function TCocoaWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean;
655var
656  ctx: TCocoaContext;
657begin
658  ctx := CheckDC(DC);
659  Result := Assigned(ctx);
660  if Result then
661    ctx.Ellipse(x1, y1, x2, y2);
662end;
663
664function TCocoaWidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
665var
666  obj : NSObject;
667begin
668  Result := hWnd <> 0;
669  if Result then
670  begin
671    obj := NSObject(hWnd);
672
673    // The following check is actually a hack. LCL enables all windows disabled
674    // during ShowModal form. No matter if the windows are on the stack of the modality or not.
675    // Since Cocoa doesn't do much of the "modal" control over the windows
676    // (runWindowModal isn't used... maybe it should be?)
677    // It's possible that windows "disabled" by a another model window would be
678    // re-enabled. This check verifies that only a window on the top of the modal stack
679    // will be brought back active... what about other windows?
680    if bEnable and isModalSession and (obj.isKindOfClass(TCocoaWindowContent)) then begin
681      if not (TCocoaWindowContent(obj).isembedded)
682        and not isTopModalWin(TCocoaWindowContent(obj).window) then Exit;
683    end;
684    obj.lclSetEnabled(bEnable);
685
686    if (CaptureControl <> 0)
687      and (not bEnable)
688      and (obj.isKindOfClass(NSView))
689      and NSViewIsLCLEnabled(NSView(obj)) then
690      ReleaseCapture
691  end;
692end;
693
694function TCocoaWidgetSet.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer;
695begin
696  Result:=inherited EndPaint(Handle, PS);
697end;
698
699function TCocoaWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
700  Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
701var
702  fname: NSString;
703  ELogFont: TEnumLogFontEx;
704  Metric: TNewTextMetricEx;
705  FontName: AnsiString;
706begin
707  Result := 0;
708  if not Assigned(Callback) then Exit;
709  for fname in NSFontManager.sharedFontManager.availableFontFamilies do
710  begin
711    try
712      FontName := NSStringToString(fname);
713      FillChar(ELogFont, SizeOf(ELogFont), #0);
714      FillChar(Metric, SizeOf(Metric), #0);
715      ELogFont.elfLogFont.lfFaceName := FontName;
716      ELogFont.elfFullName := FontName;
717      //todo: read the data from all fonts of the fontfamily
718      Result := CallBack(ELogFont, Metric, TRUETYPE_FONTTYPE, lparam);
719      if Result = 0 then Break;
720    except
721      Break;
722    end;
723  end;
724end;
725
726// According to the documentation of NSScreen.screen It's recommended
727// not to cache NSScreen objects stored in the array. As those might change.
728// However, according to the same documentation, the objects can change
729// only with a notificatio sent out. BUT while using a macincloud (remote desktop)
730// services, it was identified that NSScreen object CAN change without any notification.
731// So, instead of passing NSScreen as HMonitor, only INDEX+1 in NSScreen.screen
732// is used.
733function IndexToHMonitor(i: NSUInteger): HMonitor;
734begin
735  if i = NSIntegerMax then Result := 0
736  else Result := i + 1;
737end;
738
739function HMonitorToIndex(h: HMonitor): NSUInteger;
740begin
741  if h = 0 then Result := NSIntegerMax
742  else Result := NSUInteger(h)-1;
743end;
744
745function TCocoaWidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
746  lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
747var
748  i: NSUInteger;
749  cnt: NSUInteger;
750begin
751  Result := True;
752  cnt := NSScreen.screens.count;
753  if cnt = 0 then
754  begin
755    Result := false;
756    Exit;
757  end;
758  for i := 0 to NSScreen.screens.count - 1 do
759  begin
760    Result := Result and lpfnEnum(IndexToHMonitor(i), 0, nil, dwData);
761    if not Result then break;
762  end;
763end;
764
765function TCocoaWidgetSet.ExcludeClipRect(dc: hdc;
766  Left, Top, Right, Bottom : Integer) : Integer;
767var
768  RRGN : HRGN;
769  R : TRect;
770begin
771  // there seems to be a bug in TWidgetset ExcludeClipRect.
772  // as it doesn't use LPtoDP() (as IntersectClipRect does).
773  // Fixing the problem here.
774  R := Types.Rect(Left, Top, Right, Bottom);
775  LPtoDP(DC, R, 2);
776
777  If DCClipRegionValid(DC) then begin
778    //DebugLn('TWidgetSet.ExcludeClipRect A DC=',DbgS(DC),' Rect=',Left,',',Top,',',Right,',',Bottom);
779    // create the rectangle region, that should be excluded
780    RRGN := CreateRectRgn(R.Left,R.Top,R.Right,R.Bottom);
781    Result := ExtSelectClipRGN(DC, RRGN, RGN_DIFF);
782    //DebugLn('TWidgetSet.ExcludeClipRect B Result=',Result);
783    DeleteObject(RRGN);
784  end else
785    Result:=ERROR;
786end;
787
788
789function TCocoaWidgetSet.ExtSelectClipRGN(dc: hdc; rgn: hrgn; Mode: Longint): Integer;
790var
791  ctx: TCocoaContext;
792begin
793  ctx := CheckDC(DC);
794  if Assigned(ctx) then
795    Result := CocoaRegionTypeToWin32Map[ctx.SetClipRegion(TCocoaRegion(rgn), CocoaCombineMode(Mode))]
796  else
797    Result := ERROR;
798end;
799
800function TCocoaWidgetSet.ExtCreatePen(dwPenStyle, dwWidth: DWord;
801  const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN;
802begin
803  Result := HPEN(TCocoaPen.Create(dwPenStyle, dwWidth, lplb, dwStyleCount, lpStyle));
804end;
805
806function TCocoaWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
807  Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
808var
809  ctx: TCocoaContext;
810begin
811  ctx := CheckDC(DC);
812  Result := Assigned(ctx);
813  if Assigned(ctx) then
814    ctx.TextOut(X, Y, Options, Rect, Str, Count, Dx);
815end;
816
817function TCocoaWidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean;
818var
819  ctx: TCocoaContext;
820  br: TCocoaGDIObject;
821begin
822  ctx := CheckDC(DC);
823  br := CheckGDIOBJ(Brush);
824  Result := Assigned(ctx) and (not Assigned(br) or (br is TCocoaBrush));
825  if not Result then Exit;
826
827  ctx.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, True, TCocoaBrush(br));
828end;
829
830function TCocoaWidgetSet.FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool;
831var
832  OldRgn: TCocoaRegion;
833  R: TRect;
834  Clipped: Boolean;
835  ctx: TCocoaContext;
836  br: TCocoaGDIObject;
837  I: Integer;
838begin
839  ctx := CheckDC(DC);
840  br := CheckGDIOBJ(hbr);
841  Result := Assigned(ctx) and (not Assigned(br) or (br is TCocoaBrush));
842  if not Result then Exit;
843
844  Clipped := ctx.Clipped;
845  I := ctx.SaveDC;
846  if Clipped then
847    OldRgn := TCocoaRegion.CreateDefault;
848  try
849    if Clipped then
850      ctx.CopyClipRegion(OldRgn);
851    if SelectClipRgn(DC, RegionHnd) <> ERROR then
852    begin
853      R := TCocoaRegion(RegionHnd).GetBounds;
854      with R do
855        ctx.Rectangle(Left, Top, Right, Bottom, True, TCocoaBrush(br));
856      if Clipped then
857        SelectClipRgn(DC, HRGN(OldRgn));
858      Result := True;
859    end;
860  finally
861    if Clipped then
862      OldRgn.Free;
863    ctx.RestoreDC(I);
864  end;
865end;
866
867function TCocoaWidgetSet.Frame3d(DC: HDC; var ARect: TRect;
868  const FrameWidth: integer; const Style: TBevelCut): Boolean;
869var
870  ctx: TCocoaContext;
871begin
872  ctx := CheckDC(DC);
873  Result := Assigned(ctx) and (FrameWidth > 0);
874  if Result then
875    ctx.Frame3d(ARect, FrameWidth, Style);
876end;
877
878function TCocoaWidgetSet.FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer;
879var
880  ctx: TCocoaContext;
881begin
882  ctx := CheckDC(DC);
883  if Assigned(ctx) then
884  begin
885    ctx.FrameRect(ARect, TCocoaBrush(hBr));
886    Result := -1;
887  end
888  else
889    Result := 0;
890end;
891
892function TCocoaWidgetSet.GetActiveWindow: HWND;
893var
894  wn : NSWindow;
895begin
896  // return the currect application active window
897  wn := NSApp.keyWindow;
898  if not Assigned(wn) then Result := 0
899  else Result := HWND(wn.contentView);
900end;
901
902function TCocoaWidgetSet.GetBkColor(DC: HDC): TColorRef;
903var
904  ctx: TCocoaContext;
905begin
906  ctx := CheckDC(DC);
907  if Assigned(ctx) then
908    Result := ctx.BkColor
909  else
910    Result := CLR_INVALID;
911end;
912
913function TCocoaWidgetSet.GetCapture: HWND;
914begin
915  Result:=FCaptureControl;
916end;
917
918function TCocoaWidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean;
919begin
920  Result := CocoaCaret.GetCaretPos(lpPoint);
921end;
922
923function TCocoaWidgetSet.GetCaretRespondToFocus(handle: HWND;
924  var ShowHideOnFocus: boolean): Boolean;
925begin
926  Result := inherited GetCaretRespondToFocus(handle, ShowHideOnFocus);
927end;
928
929{------------------------------------------------------------------------------
930  function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
931
932  nCmdShow:
933    SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED
934------------------------------------------------------------------------------}
935function TCocoaWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
936var
937  win: NSWindow;
938  lCocoaWin: TCocoaWindow = nil;
939  lWinContent: TCocoaWindowContent = nil;
940  disableFS : Boolean;
941const
942  NSFullScreenWindowMask = 1 shl 14;
943
944begin
945  Result:=true;
946  {$ifdef VerboseCocoaWinAPI}
947    DebugLn('TCocoaWidgetSet.ShowWindow');
948  {$endif}
949
950  // for regular controls (non-window or embedded window, acting as a control)
951  if (not NSObject(hWnd).isKindOfClass(TCocoaWindowContent)) or (TCocoaWindowContent(hWnd).isembedded) then
952  begin
953    NSObject(hWnd).lclSetVisible(nCmdSHow <> SW_HIDE);
954    Exit;
955  end;
956
957  // for windows
958  lWinContent := TCocoaWindowContent(hWnd);
959
960  //todo: should it be lclOwnWindow?
961  if Assigned(lWinContent.fswin) then
962    win := lWinContent.fswin
963  else
964    win := NSWindow(lWinContent.window);
965
966  disableFS := false;
967  if win.isKindOfClass(TCocoaWindow) then
968  begin
969    lCocoaWin := TCocoaWindow(win);
970    disableFS := Assigned(lCocoaWin) and (lCocoaWin.lclIsFullScreen) and (nCmdShow <> SW_SHOWFULLSCREEN);
971  end;
972
973  if disableFS and Assigned(lCocoaWin) then
974    lCocoaWin.lclSwitchFullScreen(false);
975
976  case nCmdShow of
977    SW_SHOW, SW_SHOWNORMAL:
978      win.orderFront(nil);
979    SW_HIDE:
980      win.orderOut(nil);
981    SW_MINIMIZE:
982      win.miniaturize(nil);
983    SW_MAXIMIZE:
984      win.zoom(nil);
985    SW_SHOWFULLSCREEN:
986      if Assigned(lCocoaWin) then
987        lCocoaWin.lclSwitchFullScreen(true);
988  end;
989end;
990
991function TCocoaWidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
992  SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal
993  ): Boolean;
994begin
995  Result := StretchMaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc,
996    SrcWidth, SrcHeight, 0, 0, 0, Rop);
997end;
998
999function TCocoaWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width,
1000  Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
1001  Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
1002var
1003  SrcCtx, DestCtx: TCocoaContext;
1004begin
1005  DestCtx := CheckDC(DestDC);
1006  SrcCtx := CheckDC(SrcDC);
1007
1008  Result := Assigned(DestCtx) and Assigned(SrcCtx);
1009
1010  if not Result then
1011    Exit;
1012
1013  if not (SrcCtx is TCocoaBitmapContext) then
1014  begin
1015    DebugLn('StretchMaskBlt Error - invalid source device context ', SrcCtx.ClassName,
1016      ', expected TCocoaBitmapContext!');
1017    Exit;
1018  end;
1019
1020  Result := DestCtx.StretchDraw(X, Y, Width, Height,
1021    TCocoaBitmapContext(SrcCtx), XSrc, YSrc, SrcWidth, SrcHeight,
1022    TCocoaBitmap(Mask), XMask, YMask, Rop);
1023end;
1024
1025function TCocoaWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
1026  pvParam: Pointer; fWinIni: DWord): LongBool;
1027begin
1028  Result := True;
1029  case uiAction of
1030    SPI_GETWHEELSCROLLLINES: PDword(pvPAram)^ := 3;
1031    SPI_GETWORKAREA:
1032    begin
1033      NSToLCLRect(NSScreen(NSScreen.screens.objectAtIndex(0)).visibleFrame
1034        , NSScreenZeroHeight
1035        , TRect(pvParam^));
1036    end;
1037  else
1038    Result := False;
1039  end
1040end;
1041
1042{------------------------------------------------------------------------------
1043  Method:  GetWindowRect
1044  Params:  Handle - Handle of window
1045           Rect   - Record for window coordinates
1046  Returns: if the function succeeds, the return value is nonzero; if the
1047           function fails, the return value is zero
1048
1049  Retrieves the screen bounding rectangle of the specified window
1050 ------------------------------------------------------------------------------}
1051function TCocoaWidgetSet.GetWindowRect(Handle: hwnd; var ARect: TRect): Integer;
1052var
1053  dx, dy: Integer;
1054begin
1055  if Handle <> 0 then
1056  begin
1057    ARect := NSObject(Handle).lclFrame;
1058    if not NSObject(Handle).isKindOfClass_(NSWindow) then
1059    begin
1060      dx := 0;
1061      dy := 0;
1062      NSObject(Handle).lclLocalToScreen(dx, dy);
1063      MoveRect(ARect, dx, dy);
1064    end;
1065    Result := 1;
1066  end else
1067    Result := 0;
1068end;
1069
1070function TCocoaWidgetSet.IsWindowEnabled(Handle: HWND): boolean;
1071begin
1072  if Handle<>0
1073    then Result:=NSObject(Handle).lclIsEnabled
1074    else Result:=False;
1075end;
1076
1077function TCocoaWidgetSet.IsWindowVisible(Handle: HWND): boolean;
1078begin
1079  if Handle<>0
1080    then Result:=NSObject(Handle).lclIsVisible
1081    else Result:=False;
1082end;
1083
1084function TCocoaWidgetSet.GetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
1085begin
1086  Result := Handle <> 0;
1087  if Result then
1088    ARect := NSObject(handle).lclClientFrame;
1089end;
1090
1091function TCocoaWidgetSet.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
1092begin
1093  Result := Handle <> 0;
1094  if Result then
1095  begin
1096    ARect := NSObject(handle).lclClientFrame;
1097    OffsetRect(ARect, -ARect.Left, -ARect.Top);
1098  end;
1099end;
1100
1101function TCocoaWidgetSet.GetClipBox(DC: hDC; lpRect: PRect): Longint;
1102var
1103  ctx: TCocoaContext;
1104begin
1105  ctx := CheckDC(DC);
1106  if Assigned(ctx) and Assigned(lpRect) then
1107  begin
1108    lpRect^ := ctx.GetClipRect;
1109    Result := COMPLEXREGION;
1110  end
1111  else
1112    Result := ERROR;
1113end;
1114
1115function TCocoaWidgetSet.GetClipRGN(DC: hDC; RGN: hRGN): Longint;
1116var
1117  ctx: TCocoaContext;
1118begin
1119  ctx := CheckDC(DC);
1120  if Assigned(ctx) and (RGN <> 0) then
1121    Result := CocoaRegionTypeToWin32Map[ctx.CopyClipRegion(TCocoaRegion(RGN))]
1122  else
1123    Result := ERROR;
1124end;
1125
1126function TCocoaWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
1127begin
1128  with NSEvent.mouseLocation do
1129  begin
1130    lpPoint.x := Round(x);
1131    // cocoa returns cursor with inverted y coordinate
1132    lpPoint.y := Round(NSScreenZeroHeight-y);
1133  end;
1134  //debugln('GetCursorPos='+DbgS(lpPoint));
1135  Result := True;
1136end;
1137
1138function TCocoaWidgetSet.GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
1139var
1140  Scr0Height:  CGFloat;
1141  ScreenID: NSScreen;
1142  idx : NSUInteger;
1143begin
1144  Result := (lpmi <> nil) and (lpmi^.cbSize >= SizeOf(TMonitorInfo));
1145  if not Result then Exit;
1146  idx := HMonitorToIndex(hMonitor);
1147  Result := (idx < NSScreen.screens.count);
1148  if not Result then Exit;
1149
1150  Scr0Height := NSScreenZeroHeight;
1151  ScreenID := NSScreen(NSScreen.screens.objectAtIndex(idx));
1152  NSToLCLRect(ScreenID.frame, Scr0Height, lpmi^.rcMonitor);
1153  NSToLCLRect(ScreenID.visibleFrame, Scr0Height, lpmi^.rcWork);
1154  // according to the documentation the primary (0,0 coord screen)
1155  // is always and index 0
1156  if idx = 0 then
1157    lpmi^.dwFlags := MONITORINFOF_PRIMARY
1158  else
1159    lpmi^.dwFlags := 0;
1160end;
1161
1162function TCocoaWidgetSet.GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer;
1163var
1164  AObject: TCocoaGDIObject;
1165  DIB: TDIBSection;
1166  Width, Height, RequiredSize, i: Integer;
1167  Traits: NSFontTraitMask;
1168
1169  APen: TCocoaPen absolute AObject;
1170  ALogPen: PLogPen absolute Buf;
1171  AExtLogPen: PExtLogPen absolute Buf;
1172  AFont: TCocoaFont absolute AObject;
1173  ALogFont: PLogFont absolute Buf;
1174begin
1175  Result := 0;
1176
1177  AObject := CheckGDIObj(GDIObj);
1178
1179  if AObject is TCocoaBitmap then
1180  begin
1181    if Buf = nil then
1182    begin
1183      Result := SizeOf(TDIBSection);
1184      Exit;
1185    end;
1186
1187    Width := TCocoaBitmap(AObject).Width;
1188    Height := TCocoaBitmap(AObject).Height;
1189
1190    FillChar(DIB, SizeOf(TDIBSection), 0);
1191
1192    {dsBM - BITMAP}
1193    DIB.dsBm.bmType := $4D42;
1194    DIB.dsBm.bmWidth := Width;
1195    DIB.dsBm.bmHeight := Height;
1196    DIB.dsBm.bmWidthBytes := 0;
1197    DIB.dsBm.bmPlanes := 1;
1198    DIB.dsBm.bmBitsPixel := 32;
1199    DIB.dsBm.bmBits := nil;
1200
1201    {dsBmih - BITMAPINFOHEADER}
1202    DIB.dsBmih.biSize := 40;
1203    DIB.dsBmih.biWidth := Width;
1204    DIB.dsBmih.biHeight := Height;
1205    DIB.dsBmih.biPlanes := DIB.dsBm.bmPlanes;
1206    DIB.dsBmih.biCompression := 0;
1207    DIB.dsBmih.biSizeImage := 0;
1208    DIB.dsBmih.biXPelsPerMeter := 0;
1209    DIB.dsBmih.biYPelsPerMeter := 0;
1210    DIB.dsBmih.biClrUsed   := 0;
1211    DIB.dsBmih.biClrImportant := 0;
1212    DIB.dsBmih.biBitCount := 32;
1213
1214    if BufSize >= SizeOf(TDIBSection) then
1215    begin
1216      PDIBSection(Buf)^ := DIB;
1217      Result := SizeOf(TDIBSection);
1218    end
1219    else
1220      if BufSize > 0 then
1221      begin
1222        System.Move(DIB, Buf^, BufSize);
1223        Result := BufSize;
1224      end;
1225  end
1226  else
1227  if AObject is TCocoaPen then
1228  begin
1229    if APen.IsExtPen then
1230    begin
1231      RequiredSize := SizeOf(TExtLogPen);
1232      if Length(APen.Dashes) > 1 then
1233        inc(RequiredSize, (Length(APen.Dashes) - 1) * SizeOf(DWord));
1234      if Buf = nil then
1235        Result := RequiredSize
1236      else
1237      if BufSize >= RequiredSize then
1238      begin
1239        Result := RequiredSize;
1240        AExtLogPen^.elpPenStyle := APen.Style;
1241        if APen.IsGeometric then
1242        begin
1243          case APen.JoinStyle of
1244            kCGLineJoinRound:
1245              AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_JOIN_ROUND;
1246            kCGLineJoinBevel:
1247              AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_JOIN_BEVEL;
1248            kCGLineJoinMiter:
1249              AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_JOIN_MITER;
1250          end;
1251
1252          case APen.CapStyle of
1253            kCGLineCapRound:
1254              AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_ENDCAP_ROUND;
1255            kCGLineCapSquare:
1256              AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_ENDCAP_SQUARE;
1257            kCGLineCapButt:
1258              AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_ENDCAP_FLAT;
1259          end;
1260          AExtLogPen^.elpWidth := APen.Width;
1261        end
1262        else
1263          AExtLogPen^.elpWidth := 1;
1264
1265        AExtLogPen^.elpBrushStyle := BS_SOLID;
1266        AExtLogPen^.elpColor := APen.ColorRef;
1267        AExtLogPen^.elpHatch := 0;
1268
1269        AExtLogPen^.elpNumEntries := Length(APen.Dashes);
1270        if AExtLogPen^.elpNumEntries > 0 then
1271        begin
1272          for i := 0 to AExtLogPen^.elpNumEntries - 1 do
1273            PDword(@AExtLogPen^.elpStyleEntry)[i] := Trunc(APen.Dashes[i]);
1274        end
1275        else
1276          AExtLogPen^.elpStyleEntry[0] := 0;
1277      end;
1278    end
1279    else
1280    begin
1281      if Buf = nil then
1282        Result := SizeOf(TLogPen)
1283      else
1284      if BufSize >= SizeOf(TLogPen) then
1285      begin
1286        Result := SizeOf(TLogPen);
1287        ALogPen^.lopnStyle := APen.Style;
1288        ALogPen^.lopnWidth := Types.Point(APen.Width, 0);
1289        ALogPen^.lopnColor := APen.ColorRef;
1290      end;
1291    end;
1292  end;
1293  if AObject is TCocoaFont then
1294  begin
1295    if Buf = nil then
1296      Result := SizeOf(TLogFont)
1297    else
1298    if BufSize >= SizeOf(TLogFont) then
1299    begin
1300      Result := SizeOf(TLogFont);
1301      FillChar(ALogFont^, SizeOf(ALogFont^), 0);
1302      ALogFont^.lfFaceName := AFont.Name;
1303      ALogFont^.lfHeight := -AFont.Size; // Cocoa supports only full height (with leading) that corresponds with a negative value in WinAPI
1304      Traits := NSFontManager.sharedFontManager.traitsOfFont(AFont.Font);
1305      if (Traits and NSFontBoldTrait) <> 0 then
1306        ALogFont^.lfWeight := FW_BOLD
1307      else
1308        ALogFont^.lfWeight := FW_NORMAL;
1309      if (Traits and NSFontItalicTrait) <> 0 then
1310        ALogFont^.lfItalic := 1
1311      else
1312        ALogFont^.lfItalic := 0;
1313    end;
1314  end;
1315end;
1316
1317function TCocoaWidgetSet.GetParent(Handle : HWND): HWND;
1318begin
1319  if Handle<>0 then
1320    Result:=HWND(NSObject(Handle).lclParent)
1321  else
1322    Result:=0;
1323end;
1324
1325function TCocoaWidgetSet.GetWindowRelativePosition(Handle: hwnd; var Left, Top: Integer): boolean;
1326begin
1327  Result := Handle <> 0;
1328  if Result then
1329    NSObject(handle).lclRelativePos(Left, Top);
1330end;
1331
1332function TCocoaWidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: Integer): boolean;
1333var
1334  r: TRect;
1335  lView: NSView;
1336begin
1337  Result := Handle <> 0;
1338  if not Result then Exit;
1339
1340  r := NSObject(Handle).lclFrame;
1341  Width := R.Right - R.Left;
1342  Height := R.Bottom - R.Top;
1343end;
1344
1345function TCocoaWidgetSet.InitStockFont(AFont: TObject; AStockFont: TStockFont): Boolean;
1346var
1347  Font: TFont absolute AFont;
1348  CTFont: CTFontRef;
1349  CTFontName: CFStringRef;
1350  CTFontSize: CGFloat;
1351  CTFontType: CTFontUIFontType;
1352begin
1353  Result := False;
1354
1355  case AStockFont of
1356    sfSystem:  // stock system font
1357      CTFontType := kCTFontSystemFontType;
1358    sfHint:    // stock hint font
1359      CTFontType := kCTFontToolTipFontType;
1360    sfIcon:    // stock icon font
1361      CTFontType := kCTFontViewsFontType;
1362    sfMenu:     // stock menu font
1363      CTFontType := kCTFontMenuItemFontType;
1364  end;
1365
1366  CTFont :=  CTFontCreateUIFontForLanguage(CTFontType, 0, nil);
1367  try
1368    CTFontName := CTFontCopyFamilyName(CTFont);
1369    try
1370      Font.Name := CFStringToStr(CTFontName);
1371      finally
1372      CFRelease(CTFontName);
1373      end;
1374    CTFontSize := CTFontGetSize(CTFont);
1375    Font.Height := -Round(CTFontSize);
1376    finally
1377    CFRelease(CTFont);
1378    end;
1379  Result := True;
1380end;
1381
1382function TCocoaWidgetSet.HideCaret(Handle: HWND): Boolean;
1383var
1384  lView: NSView;
1385begin
1386  if (Handle = 0)
1387    then lView := nil
1388    else lView := NSView(Handle).lclContentView;
1389
1390  Result := CocoaCaret.HideCaret(lView);
1391end;
1392
1393function TCocoaWidgetSet.InvalidateRect(aHandle: HWND; Rect: pRect; bErase: Boolean): Boolean;
1394begin
1395  Result := aHandle <> 0;
1396  if Result then
1397  begin
1398    if Assigned(Rect) then
1399      NSObject(aHandle).lclInvalidateRect(Rect^)
1400    else
1401      NSObject(aHandle).lclInvalidate;
1402  end;
1403end;
1404
1405function TCocoaWidgetSet.UpdateWindow(Handle: HWND): Boolean;
1406begin
1407  Result := Handle <> 0;
1408  if Result then
1409    NSObject(Handle).lclUpdate;
1410end;
1411
1412function TCocoaWidgetSet.GetProp(Handle: hwnd; Str: PChar): Pointer;
1413var
1414  PropStorage: TStringList;
1415  I: Integer;
1416begin
1417  if Handle <> 0 then
1418  begin
1419    PropStorage := NSObject(Handle).lclGetPropStorage;
1420    if Assigned(PropStorage) then
1421    begin
1422      I := PropStorage.IndexOf(Str);
1423      if I <> -1 then
1424        Result := PropStorage.Objects[I]
1425      else
1426        Result := nil;
1427    end
1428    else
1429      Result := nil;
1430  end else
1431    Result := nil;
1432end;
1433
1434function TCocoaWidgetSet.IsWindow(handle: HWND): boolean;
1435var
1436  cbi : ICommonCallback;
1437  obj : TObject;
1438begin
1439  if handle <> 0 then
1440  begin
1441    cbi := NSObject(handle).lclGetCallback;
1442    Result := Assigned(cbi);
1443    if not Result then Exit;
1444
1445    obj := cbi.GetCallbackObject;
1446    Result :=  (obj is TLCLCommonCallback)
1447      and (HWND(TLCLCommonCallback(obj).HandleFrame)=handle);
1448  end
1449  else
1450    Result := False;
1451end;
1452
1453function ViewFromPoint(view: NSView;Point: TPoint): HWND;
1454var rect: TRect;
1455    p:TPoint;
1456    cb: ICommonCallback;
1457    cbo: TObject;
1458  hv  : NSView;
1459begin
1460  Result:=0;
1461  if not assigned(view) then
1462     exit;
1463  cb := view.lclGetCallback;
1464  if Assigned(cb) then
1465  begin
1466    cbo := cb.GetCallbackObject;
1467    if not (cbo is TLCLCommonCallback) then Exit;
1468    p:=Point;
1469    // The hit test is done by the out-side frame (Handle)
1470    hv := TLCLCommonCallback(cbo).HandleFrame;
1471    hv.lclScreenToLocal(p.X,p.Y);
1472    rect:=hv.lclClientFrame;
1473    if PtInRect(rect, p) then
1474      //if hv.lclClassName;
1475      Result := HWND(hv)
1476  end
1477end;
1478
1479function RecurseSubviews(view: NSView;Point: TPoint):HWND;
1480var  sv:integer;
1481begin
1482  // first check views subview if there is a embedded view
1483  Result:=0;
1484  if not Assigned(view) or (view.isHidden) or (not view.lclIsEnabled) then Exit;
1485  sv:=0;
1486  while (Result=0) and (sv<view.subviews.count) do
1487    begin
1488    Result:=RecurseSubviews(view.subviews.objectAtIndex(sv),Point);
1489    inc(sv)
1490    end;
1491  if Result=0 then
1492     Result:=ViewFromPoint(view,Point);
1493end;
1494
1495function TCocoaWidgetSet.WindowFromPoint(Point: TPoint): HWND;
1496var
1497  winrect: TRect;
1498  windows: NSArray;
1499  win: integer;
1500  window, windowbelowpoint: NSWindow;
1501  p:NSPoint;
1502  winnr:NSInteger;
1503begin
1504  Result := 0;
1505  if not assigned(NSApp) then
1506    Exit;
1507
1508  windows := NSApp.windows;
1509  for win := 0 to windows.count - 1 do
1510  begin
1511    window:=windows.objectAtIndex(win);
1512    p.x:=Point.X;
1513    p.y:=NSScreenZeroHeight-Point.Y;
1514    winnr:=NSWindow.windowNumberAtPoint_belowWindowWithWindowNumber(p,0);
1515    windowbelowpoint:=NSWindow(NSApp.windowWithWindowNumber(winnr));
1516    if windowbelowpoint=window then
1517    begin
1518      Result:=RecurseSubviews(window.contentView, Point);
1519      if Result<>0 then
1520      begin
1521        exit;
1522      end;
1523    end;
1524  end;
1525end;
1526
1527
1528function TCocoaWidgetSet.GetRgnBox(RGN: HRGN; lpRect: PRect): Longint;
1529begin
1530  Result := ERROR;
1531  if Assigned(lpRect) then
1532    lpRect^ := Types.Rect(0, 0, 0, 0);
1533
1534  if not (TObject(RGN) is TCocoaRegion) then
1535    Exit;
1536
1537  if Assigned(lpRect) then
1538  begin
1539    lpRect^ := TCocoaRegion(RGN).GetBounds;
1540    Result := CocoaRegionTypeToWin32Map[TCocoaRegion(RGN).GetType];
1541  end;
1542end;
1543
1544function TCocoaWidgetSet.GetROP2(DC: HDC): Integer;
1545var
1546  ctx: TCocoaContext;
1547begin
1548  ctx := CheckDC(DC);
1549  if Assigned(ctx) then
1550    Result := ctx.ROP2
1551  else
1552    Result := 0;
1553end;
1554
1555function TCocoaWidgetSet.SetProp(Handle: hwnd; Str: PChar; Data: Pointer): Boolean;
1556var
1557  PropStorage: TStringList;
1558begin
1559  Result := Handle <> 0;
1560  if Result then
1561  begin
1562    PropStorage := NSObject(Handle).lclGetPropStorage;
1563    Result := Assigned(PropStorage);
1564    if Result then
1565      PropStorage.AddObject(Str, TObject(Data));
1566  end;
1567end;
1568
1569function TCocoaWidgetSet.SetROP2(DC: HDC; Mode: Integer): Integer;
1570var
1571  ctx: TCocoaContext;
1572begin
1573  ctx := CheckDC(DC);
1574  if Assigned(ctx) then
1575  begin
1576    Result := ctx.ROP2;
1577    ctx.ROP2 := Mode;
1578  end
1579  else
1580    Result := 0;
1581end;
1582
1583{----------------------------- WINDOWS SCROLLING ------------------------------}
1584
1585function TCocoaWidgetSet.GetScrollBarSize(Handle: HWND; BarKind: Integer): integer;
1586var
1587  sc  : NSScrollView;
1588  obj : NSObject;
1589begin
1590  obj := NSObject(Handle);
1591  Result := 0;
1592  if not Assigned(obj) then Exit;
1593
1594  if obj.isKindOfClass(NSScrollView) then
1595  begin
1596    if (BarKind = SB_Vert) and Assigned(NSScrollView(obj).verticalScroller) then
1597      Result:=round(NSScrollView(obj).verticalScroller.frame.size.width)
1598    else if (BarKind = SB_Horz) and Assigned(NSScrollView(obj).horizontalScroller) then
1599      Result:=round(NSScrollView(obj).verticalScroller.frame.size.height)
1600    else
1601      Result := Round(NSScroller.scrollerWidth);
1602  end
1603  else
1604    Result := Round(NSScroller.scrollerWidth);
1605end;
1606
1607function TCocoaWidgetSet.GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean;
1608var
1609  obj : NSObject;
1610  sc  : NSScrollView;
1611  mn  : TCocoaManualScrollView;
1612begin
1613  obj := NSObject(Handle);
1614  Result := Assigned(obj);
1615  if not Result then Exit;
1616
1617  if obj.isKindOfClass(TCocoaManualScrollHost) then
1618    obj := TCocoaManualScrollHost(obj).documentView;
1619
1620  if obj.isKindOfClass(NSScrollView) then
1621  begin
1622    sc := NSScrollView(obj);
1623    case SBStyle of
1624      SB_Vert: Result := sc.hasVerticalScroller;
1625      SB_Horz: Result := sc.hasHorizontalScroller;
1626    else
1627      Result := sc.hasHorizontalScroller and sc.hasVerticalScroller;
1628    end;
1629  end
1630  else if obj.isKindOfClass(TCocoaManualScrollView) then
1631  begin
1632    mn := TCocoaManualScrollView(obj);
1633    case SBStyle of
1634      SB_Vert: Result := mn.hasVerticalScroller;
1635      SB_Horz: Result := mn.hasHorizontalScroller;
1636    else
1637      Result := mn.hasHorizontalScroller and mn.hasVerticalScroller;
1638    end;
1639  end
1640  else
1641    Result := False;
1642end;
1643
1644function TCocoaWidgetSet.GetScrollInfo(Handle: HWND; BarFlag: Integer;
1645  var ScrollInfo: TScrollInfo): Boolean;
1646var
1647  sc : NSScrollView;
1648  obj : NSObject;
1649begin
1650  obj := NSObject(Handle);
1651  Result := Assigned(obj);
1652  if not Result then Exit;
1653
1654  if obj.isKindOfClass(TCocoaManualScrollHost) then
1655    obj := TCocoaManualScrollHost(obj).documentView;
1656
1657  if obj.isKindOfClass(TCocoaScrollBar) then
1658    Result := CocoaScrollBarGetScrollInfo(TCocoaScrollBar(obj), ScrollInfo)
1659  else
1660  if obj.isKindOfClass(TCocoaManualScrollView) then
1661  begin
1662    if BarFlag = SB_Vert then
1663      Result := CocoaScrollBarGetScrollInfo( TCocoaScrollBar(TCocoaManualScrollView(obj).verticalScroller), ScrollInfo)
1664    else
1665      Result := CocoaScrollBarGetScrollInfo( TCocoaScrollBar(TCocoaManualScrollView(obj).horizontalScroller), ScrollInfo);
1666  end else if obj.isKindOfClass(NSScrollView) then
1667    NSScrollViewGetScrollInfo(NSScrollView(obj), BarFlag, ScrollInfo)
1668  else
1669    Result := False;
1670end;
1671
1672function TCocoaWidgetSet.GetStockObject(Value: Integer): THandle;
1673begin
1674  Result := 0;
1675
1676  case Value of
1677    BLACK_BRUSH:         // Black brush.
1678      Result := FStockBlackBrush;
1679    DKGRAY_BRUSH:        // Dark gray brush.
1680      Result := FStockDKGrayBrush;
1681    GRAY_BRUSH:          // Gray brush.
1682      Result := FStockGrayBrush;
1683    LTGRAY_BRUSH:        // Light gray brush.
1684      Result := FStockLtGrayBrush;
1685    NULL_BRUSH:          // Null brush (equivalent to HOLLOW_BRUSH).
1686      Result := FStockNullBrush;
1687    WHITE_BRUSH:         // White brush.
1688      Result := FStockWhiteBrush;
1689
1690    BLACK_PEN:           // Black pen.
1691      Result := FStockBlackPen;
1692    NULL_PEN:            // Null pen.
1693      Result := FStockNullPen;
1694    WHITE_PEN:           // White pen.
1695      Result := FStockWhitePen;
1696
1697    DEFAULT_GUI_FONT, SYSTEM_FONT:
1698      Result := FStockSystemFont;
1699    SYSTEM_FIXED_FONT:
1700      Result := FStockFixedFont;
1701  end;
1702end;
1703
1704function TCocoaWidgetSet.GetSysColor(nIndex: Integer): DWORD;
1705var
1706  Color: NSColor;
1707  SysBrush: HBrush;
1708begin
1709  // 1. get the system brush - it has a NSColor reference
1710  SysBrush := GetSysColorBrush(nIndex);
1711  if SysBrush = 0 then
1712  begin
1713    Result := 0;
1714    Exit;
1715  end;
1716
1717  Color := TCocoaBrush(SysBrush).Color;
1718
1719  if Assigned(Color) then
1720    Result := NSColorToColorRef(Color)
1721  else
1722    Result := 0;
1723end;
1724
1725function TCocoaWidgetSet.GetSysColorBrush(nIndex: Integer): HBRUSH;
1726var
1727  sys : NSColor;
1728begin
1729  if (nIndex < 0) or (nIndex > MAX_SYS_COLORS) then
1730  begin
1731    Result := 0;
1732    Exit;
1733  end;
1734  if (FSysColorBrushes[nIndex] = 0) then
1735    FSysColorBrushes[nIndex] := HBrush(TCocoaBrush.Create(SysColorToNSColor(nIndex), True))
1736  else
1737  begin
1738    // system wide can change the color on the fly
1739    TCocoaBrush(FSysColorBrushes[nIndex]).Color := SysColorToNSColor(nIndex)
1740  end;
1741
1742  Result := FSysColorBrushes[nIndex];
1743end;
1744
1745function TCocoaWidgetSet.SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer;
1746var
1747  si  : TScrollInfo;
1748  obj : NSObject;
1749  sc  : TCocoaScrollView;
1750  bar : TCocoaScrollBar;
1751  f   : NSSize;
1752  sz  : NSSize;
1753  flg : NSUInteger;
1754  hosted: Boolean;
1755begin
1756  obj := NSObject(Handle);
1757  Result := 0;
1758  if not Assigned(obj) then Exit;
1759
1760  if obj.isKindOfClass(TCocoaManualScrollHost) then
1761  begin
1762    hosted := true;
1763    obj := TCocoaManualScrollHost(obj).documentView;
1764  end else
1765    hosted := false;
1766
1767  if obj.isKindOfClass(TCocoaScrollView) then
1768  begin
1769    sc:=TCocoaScrollView(obj);
1770    if sc.isCustomRange and (ScrollInfo.fMask and SIF_RANGE>0) then begin
1771      f:=sc.frame.size;
1772      sz:=NSView(sc.documentView).frame.size; // type casting is here for the compiler. for i386 it messes up types
1773      flg:=sc.documentView.autoresizingMask;
1774
1775      if SBStyle=SB_Horz then begin
1776        if ScrollInfo.nMax>f.width then begin
1777          sz.width := ScrollInfo.nMax;
1778          flg:=flg and not NSViewWidthSizable;
1779        end else begin
1780          sz.width := f.width;
1781          flg:=flg or NSViewWidthSizable;
1782        end;
1783      end else if SBStyle=SB_Vert then begin
1784        if ScrollInfo.nMax>f.height then begin
1785          sz.height := ScrollInfo.nMax;
1786          flg:=flg and not NSViewHeightSizable;
1787        end else begin
1788          sz.height := f.height;
1789          flg:=flg or NSViewHeightSizable;
1790        end;
1791      end;
1792      sc.documentView.setAutoresizingMask(flg);
1793      sc.documentView.setFrameSize( sz );
1794    end;
1795
1796    if ScrollInfo.fMask and SIF_ALL > 0 then
1797      NSScrollViewSetScrollPos(NSScrollView(obj), SBStyle, ScrollInfo);
1798    FillChar(si, sizeof(si), 0);
1799    si.cbSize:=sizeof(si);
1800    NSScrollViewGetScrollInfo(NSScrollView(obj), SBStyle, si);
1801    Result:=si.nPos;
1802  end else if obj.isKindOfClass(TCocoaManualScrollView) then
1803  begin
1804    bar:=nil;
1805    if SBStyle=SB_Vert then
1806      bar:= TCocoaScrollBar(TCocoaManualScrollView(obj).allocVerticalScroller(false))
1807    else if SBStyle=SB_Horz then
1808      bar:= TCocoaScrollBar(TCocoaManualScrollView(obj).allocHorizontalScroller(false));
1809
1810    if Assigned(bar) then
1811    begin
1812      Result := CocoaScrollBarSetScrollInfo(bar, ScrollInfo);
1813      //debugln('TCocoaWidgetSet.SetScrollInfo page=',bar.pageInt,' min=',bar.minInt,' max=',bar.maxInt,' ',bar.lclPos);
1814      ShowScrollBar(Handle, SBStyle, bar.pageInt < bar.maxInt-bar.minInt);
1815    end
1816    else
1817      Result := 0;
1818
1819    if hosted then
1820      NSView(obj).lclInvalidate;
1821
1822  end else if obj.isKindOfClass(TCocoaScrollBar) then
1823  begin
1824    Result := CocoaScrollBarSetScrollInfo(TCocoaScrollBar(obj), ScrollInfo);
1825  end
1826  else
1827    Result := 0;
1828end;
1829
1830function TCocoaWidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean;
1831var
1832  obj : NSObject;
1833  sc  : TCocoaScrollView;
1834  mn  : TCocoaManualScrollView;
1835begin
1836  obj := NSObject(Handle);
1837  Result := Assigned(obj);
1838  if not Result then Exit;
1839
1840  if obj.isKindOfClass(TCocoaManualScrollHost) then
1841    obj := TCocoaManualScrollHost(obj).documentView;
1842
1843  if obj.isKindOfClass(TCocoaScrollView)
1844  then begin
1845    Result := true;
1846    sc := TCocoaScrollView(obj);
1847    if wBar in [SB_Vert, SB_Both] then
1848      sc.setHasVerticalScroller(bShow);
1849
1850    if wBar in [SB_Horz, SB_Both] then
1851      sc.setHasHorizontalScroller(bShow);
1852  end
1853  else if obj.isKindOfClass(TCocoaManualScrollView)
1854  then begin
1855    mn := TCocoaManualScrollView(obj);
1856
1857    if wBar in [SB_Vert, SB_Both] then
1858      mn.setHasVerticalScroller(bShow);
1859
1860    if wBar in [SB_Horz, SB_Both] then
1861      mn.setHasHorizontalScroller(bShow);
1862
1863    Result := true;
1864  end else
1865    Result := false;
1866end;
1867
1868{----------------------------------- DRAWING ----------------------------------}
1869
1870
1871type
1872  TPointArray = array [word] of TPoint;
1873  PPointArray = ^TPointArray;
1874
1875function TCocoaWidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean;
1876var
1877  ctx: TCocoaContext;
1878begin
1879  ctx := CheckDC(DC);
1880  Result := Assigned(ctx);
1881  if Result then
1882    ctx.LineTo(X, Y);
1883end;
1884
1885function TCocoaWidgetSet.LPtoDP(DC: HDC; var Points; Count: Integer): BOOL;
1886var
1887  ctx: TCocoaContext;
1888  P: PPoint;
1889begin
1890  Result := False;
1891  ctx := CheckDC(DC);
1892  if not Assigned(ctx) then Exit;
1893  P := @Points;
1894  with ctx.GetLogicalOffset do
1895    while Count > 0 do
1896    begin
1897      Dec(Count);
1898      inc(P^.X, X);
1899      inc(P^.Y, Y);
1900      inc(P);
1901    end;
1902  Result := True;
1903end;
1904
1905function TCocoaWidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer;
1906begin
1907  if not (TObject(RGN) is TCocoaRegion) then
1908    Exit(ERROR);
1909  TCocoaRegion(RGN).Offset(nXOffset, nYOffset);
1910  Result := CocoaRegionTypeToWin32Map[TCocoaRegion(RGN).GetType];
1911end;
1912
1913function TCocoaWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
1914var
1915  ctx: TCocoaContext;
1916begin
1917  ctx := CheckDC(DC);
1918  Result := Assigned(ctx);
1919  if Result then
1920  begin
1921    if Assigned(OldPoint) then
1922      OldPoint^ := ctx.PenPos;
1923    ctx.MoveTo(X, Y);
1924  end;
1925end;
1926
1927{$push}
1928{$rangechecks off}
1929function TCocoaWidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: boolean): boolean;
1930var
1931  ctx: TCocoaContext;
1932begin
1933  ctx := CheckDC(DC);
1934  Result := Assigned(ctx) and Assigned(Points) and (NumPts >= 2);
1935  if Result then
1936    ctx.Polygon(PPointArray(Points)^, NumPts, Winding);
1937end;
1938
1939function TCocoaWidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean;
1940var
1941  ctx: TCocoaContext;
1942begin
1943  ctx := CheckDC(DC);
1944  Result := Assigned(ctx) and Assigned(Points) and (NumPts > 0);
1945  if Result then
1946    ctx.Polyline(PPointArray(Points)^, NumPts);
1947end;
1948{$pop}
1949
1950type
1951  TLCLEventMessage = objcclass(NSObject)
1952    handle: HWND;
1953    msg: Cardinal;
1954    wp: WParam;
1955    lp: LParam;
1956    res: LResult;
1957    releaseAfterRun: Boolean;
1958    procedure lclRunEvent(sender: id); message 'lclRunEvent:';
1959  end;
1960
1961procedure TLCLEventMessage.lclRunEvent(sender: id);
1962begin
1963  res := NSObject(handle).lclDeliverMessage(msg, wp, lp);
1964  if releaseAfterRun then self.release;
1965end;
1966
1967function AllocLCLEventMessage(ahandle: HWND; amsg: Cardinal; awp: WParam; alp: LParam; forSend: Boolean): TLCLEventMessage;
1968begin
1969  Result := TLCLEventMessage.alloc.init;
1970  Result.handle := ahandle;
1971  Result.msg := amsg;
1972  Result.wp := awp;
1973  Result.lp := alp;
1974  Result.releaseAfterRun := not forSend;
1975end;
1976
1977
1978function TCocoaWidgetSet.PostMessage(Handle: HWND; Msg: Cardinal;
1979  wParam: WParam; lParam: LParam): Boolean;
1980var
1981  m: TLCLEventMessage;
1982begin
1983  Result := Handle <> 0;
1984  if Result then
1985  begin
1986    m:=AllocLCLEventMessage(Handle, Msg, wParam, lParam, false);
1987    m.performSelectorOnMainThread_withObject_waitUntilDone(
1988      ObjCSelector('lclRunEvent:'), nil, false
1989    );
1990  end;
1991end;
1992
1993function TCocoaWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
1994var
1995  ctx: TCocoaContext;
1996begin
1997  ctx := CheckDC(DC);
1998  Result := Assigned(ctx);
1999  if Result then
2000  begin
2001    // rectangle must be filled using current brush
2002    ctx.Rectangle(X1, Y1, X2, Y2, True, ctx.Brush);
2003    // and outlined by current pen
2004    ctx.Rectangle(X1, Y1, X2, Y2, False, nil);
2005  end;
2006end;
2007
2008{------------------------------- SYNC OBJECTS ---------------------------------}
2009
2010procedure TCocoaWidgetSet.InitializeCriticalSection(var CritSection: TCriticalSection);
2011begin
2012  CritSection:=TCriticalSection(NSRecursiveLock.alloc);
2013end;
2014
2015procedure TCocoaWidgetSet.DeleteCriticalSection(var CritSection: TCriticalSection);
2016begin
2017  if CritSection=0 then Exit;
2018  NSRecursiveLock(CritSection).release;
2019  CritSection:=0;
2020end;
2021
2022function TCocoaWidgetSet.DeleteDC(hDC: HDC): Boolean;
2023begin
2024  Result := hDC <> 0;
2025  if Result then
2026    TCocoaContext(hDC).Free;
2027end;
2028
2029procedure TCocoaWidgetSet.EnterCriticalSection(var CritSection: TCriticalSection);
2030begin
2031  if CritSection=0 then Exit;
2032  NSRecursiveLock(CritSection).lock;
2033end;
2034
2035procedure TCocoaWidgetSet.LeaveCriticalSection(var CritSection: TCriticalSection);
2036begin
2037  if CritSection=0 then Exit;
2038  NSRecursiveLock(CritSection).unlock;
2039end;
2040
2041{------------------------------- DEVICE CONTEXT -------------------------------}
2042
2043function TCocoaWidgetSet.GetDC(hWnd: HWND): HDC;
2044var
2045  ctx: TCocoaContext = nil;
2046  lCallback: ICommonCallback;
2047begin
2048  if hWnd = 0 then
2049    Result := HDC(ScreenContext)
2050  else
2051  begin
2052    lCallback := NSObject(hWnd).lclGetCallback;
2053    if lCallback <> nil then
2054      ctx := lCallback.GetContext;
2055
2056    if ctx = nil then
2057    begin
2058      ctx := TCocoaContext.Create(DefaultContext.ctx);
2059      ctx.InitDraw(DefaultContext.size.cx, DefaultContext.size.cy);
2060    end;
2061    Result := HDC(ctx);
2062  end;
2063
2064  {$IFDEF VerboseWinAPI}
2065    DebugLn('[TCocoaWidgetSet.GetDC] hWnd: %x Result: %x', [hWnd, Result]);
2066  {$ENDIF}
2067end;
2068
2069function TCocoaWidgetSet.GetDCOriginRelativeToWindow(PaintDC: HDC;
2070  WindowHandle: HWND; var OriginDiff: TPoint): boolean;
2071begin
2072  Result:=PaintDC<>0;
2073  if Result then
2074    OriginDiff:=TCocoaContext(PaintDC).WindowOfs;
2075end;
2076
2077function TCocoaWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
2078var
2079  ctx: TCocoaContext;
2080begin
2081  ctx := CheckDC(DC);
2082  if not Assigned(ctx) then
2083    Exit(0);
2084
2085  // todo: change implementation for printers
2086  case Index of
2087    HORZSIZE:
2088      Result := Round(NSScreen.mainScreen.frame.size.width / 72 * 25.4);
2089    VERTSIZE:
2090      Result := Round(NSScreen.mainScreen.frame.size.height / 72 * 25.4);
2091    HORZRES:
2092      Result := Round(NSScreen.mainScreen.frame.size.width);
2093    BITSPIXEL:
2094      // this is based on the main screen only. Should verify what actual DC is passed.
2095      // for VIEWS the typical BPP would be 32.
2096      case NSScreen.mainScreen.depth of
2097        NSWindowDepthTwentyfourBitRGB: //24-bit would be reported as 32
2098          Result := 32;
2099        NSWindowDepthSixtyfourBitRGB:
2100          Result := 64;
2101        NSWindowDepthOnehundredtwentyeightBitRGB:
2102          Result := 128;
2103      else
2104        Result := 32;
2105      end;
2106
2107    PLANES:
2108      Result := 1;
2109    SIZEPALETTE:
2110      Result := 0;
2111    LOGPIXELSX:
2112      Result := 72;
2113    LOGPIXELSY:
2114      Result := 72;
2115    VERTRES:
2116      Result := Round(NSScreen.mainScreen.frame.size.height);
2117    NUMRESERVED:
2118      Result := 0;
2119  else
2120    DebugLn('TCocoaWidgetSet.GetDeviceCaps TODO Index: ' + DbgS(Index));
2121    Result := 0;
2122  end;
2123end;
2124
2125function TCocoaWidgetSet.GetDeviceSize(DC: HDC; var P: TPoint): Boolean;
2126var
2127  ctx: TCocoaContext;
2128begin
2129  ctx := CheckDC(DC);
2130  Result := Assigned(ctx);
2131  if Result then
2132    with ctx.Size do
2133    begin
2134      P.X := cx;
2135      P.Y := cy;
2136    end;
2137end;
2138
2139function TCocoaWidgetSet.GetFocus: HWND;
2140var
2141  Obj : NSObject;
2142  win : NSWindow;
2143  rsp : NSResponder;
2144  view : NSView;
2145  dl   : NSObject;
2146  cb   : ICommonCallback;
2147  cbobj : TObject;
2148begin
2149  Result := 0;
2150  win := NSApp.keyWindow;
2151  if not Assigned(win) then Exit;
2152  // assuming that that the content view of Window
2153  // is the focused handle and return it, by default
2154  Result := HWND(win.contentView);
2155
2156  rsp := win.firstResponder;
2157  if not Assigned(rsp) then Exit;
2158
2159  // todo: The HANDLE is allocated in "WS" side, thus we should be using
2160  //       "callback" object to determine, what actual NSView is the handle
2161
2162  if rsp.isKindOfClass(TCocoaFieldEditor) then
2163  begin
2164    // field editor is a "popup" editor over many controls
2165    // the editor itself is never returned as any kind of HANDLE.
2166    // The handle is the box, that's editing
2167    dl := NSObject(TCocoaFieldEditor(rsp).delegate);
2168    if Assigned(dl) and (dl.isKindOfClass(NSView)) and Assigned(dl.lclGetCallback) then
2169      Result := HWND(dl);
2170  end
2171  else
2172  begin
2173    cb := rsp.lclGetCallback;
2174    if Assigned(cb) then
2175      cbobj := cb.GetCallbackObject
2176    else
2177      cbobj := nil;
2178
2179    if (cbobj is TLCLCommonCallback) then
2180      Result := HWND(TLCLCommonCallback(cbobj).HandleFrame)
2181    else
2182      Result := 0;
2183  end;
2184end;
2185
2186function TCocoaWidgetSet.GetForegroundWindow: HWND;
2187//var
2188//  App: NSRunningApplication;
2189begin
2190  // return the currect active window in the system
2191{ this is not possible because we can't access another application NSApplication
2192  for App in NSWorkSpace.sharedWorkspace.runningApplications do
2193    if App.isActive then
2194    begin
2195      Result := HWND(App.keyWindow);
2196      Exit;
2197    end;
2198}
2199  if NSApp.isActive then
2200    Result := HWND(NSApp.keyWindow)
2201  else
2202    Result := 0;
2203end;
2204
2205function TCocoaWidgetSet.GetKeyState(nVirtKey: Integer): Smallint;
2206const
2207  StateDown    = SmallInt($FF80);
2208  StateToggled = SmallInt($0001);
2209  DownMap: array[Boolean] of SmallInt = (0, StateDown);
2210  ToggleMap: array[Boolean] of SmallInt = (0, StateToggled);
2211var
2212  Modifiers: NSUInteger;
2213begin
2214  // NSApp.currentEvent.modifierFlags doesn't work before events start coming,
2215  // see bug 29272 and http://lists.apple.com/archives/cocoa-dev/2010/Feb/msg00105.html
2216  Modifiers := NSEvent.modifierFlags_();
2217  case nVirtKey of
2218    VK_MENU,
2219    VK_LMENU:
2220      // the ssAlt/VK_MENU is mapped to optionKey under MacOS
2221      Result := DownMap[(Modifiers and NSAlternateKeyMask) <> 0];
2222    VK_SHIFT,
2223    VK_LSHIFT:
2224      Result := DownMap[(Modifiers and NSShiftKeyMask) <> 0];
2225    VK_CONTROL,
2226    VK_LCONTROL:
2227      Result := DownMap[(Modifiers and NSControlKeyMask) <> 0];
2228    VK_LWIN, VK_RWIN:
2229      Result := DownMap[(Modifiers and NSCommandKeyMask) <> 0];
2230    VK_CAPITAL:
2231      Result := ToggleMap[(Modifiers and NSAlphaShiftKeyMask) <> 0];
2232    VK_LBUTTON:
2233      Result := DownMap[(NSEvent.pressedMouseButtons() and $1) <> 0];
2234    VK_RBUTTON:
2235      Result := DownMap[(NSEvent.pressedMouseButtons() and $2) <> 0];
2236    VK_MBUTTON:
2237      Result := DownMap[(NSEvent.pressedMouseButtons() and $3) <> 0];
2238    VK_XBUTTON1:
2239      Result := DownMap[(NSEvent.pressedMouseButtons() and $4) <> 0];
2240    VK_XBUTTON2:
2241      Result := DownMap[(NSEvent.pressedMouseButtons() and $5) <> 0];
2242    else
2243      Result := 0;
2244  end;
2245end;
2246
2247function TCocoaWidgetSet.SelectObject(ADC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
2248var
2249  dc: TCocoaContext;
2250  gdi: TCocoaGDIObject;
2251const
2252  SName = 'TCocoaWidgetSet.SelectObject';
2253begin
2254  {$IFDEF VerboseWinAPI}
2255    DebugLn(Format('TCocoaWidgetSet.SelectObject DC: %x GDIObj: %x', [ADC, GDIObj]));
2256  {$ENDIF}
2257  Result := 0;
2258
2259  dc:=CheckDC(ADC);
2260  gdi:=CheckGDIOBJ(GDIObj);
2261  if not Assigned(dc) then Exit;
2262  if not Assigned(gdi) then Exit;
2263
2264  if gdi is TCocoaBrush then
2265  begin // select brush
2266    Result := HBRUSH(dc.Brush);
2267    dc.Brush := TCocoaBrush(gdi);
2268  end else if gdi is TCocoaPen then
2269  begin // select pen
2270    Result := HPEN(dc.Pen);
2271    dc.Pen := TCocoaPen(gdi);
2272  end else if gdi is TCocoaFont then
2273  begin // select font
2274    Result := HFONT(dc.Font);
2275    dc.Font := TCocoaFont(gdi);
2276  end else if gdi is TCocoaRegion then
2277  begin // select region
2278    Result := HRGN(dc.Region);
2279    dc.Region := TCocoaRegion(gdi);
2280  end else if gdi is TCocoaBitmap then
2281  begin // select bitmap
2282    if not (dc is TCocoaBitmapContext) then
2283    begin
2284      DebugLn(SName + ' Error - The specified device context is not bitmap context!');
2285      Exit;
2286    end;
2287    Result := HBITMAP(TCocoaBitmapContext(dc).Bitmap);
2288    TCocoaBitmapContext(dc).Bitmap := TCocoaBitmap(gdi);
2289  end
2290  else
2291  begin
2292    DebugLn(SName + ' Error - Unknown Object Type ' + DbgSName(gdi));
2293    Exit;
2294  end;
2295
2296  {$IFDEF VerboseWinAPI}
2297    DebugLn(Format('TCocoaWidgetSet.SelectObject Result: %x', [Result]));
2298  {$ENDIF}
2299end;
2300
2301function TCocoaWidgetSet.SendMessage(Handle: HWND; Msg: Cardinal;
2302  WParam: WParam; LParam: LParam): LResult;
2303var
2304  m: TLCLEventMessage;
2305begin
2306  if Handle <> 0 then
2307  begin
2308    m:=AllocLCLEventMessage(Handle, Msg, wParam, lParam, true);
2309    m.performSelectorOnMainThread_withObject_waitUntilDone(
2310      ObjCSelector('lclRunEvent:'), nil, true
2311    );
2312    Result := m.res;
2313    m.release;
2314  end else
2315    Result := 0;
2316end;
2317
2318function TCocoaWidgetSet.SetActiveWindow(Handle: HWND): HWND;
2319var
2320  Obj: NSObject;
2321begin
2322  Obj := NSObject(Handle);
2323  Result := 0; // should return 0, if function fails
2324  if Assigned(Obj) and NSApp.isActive then
2325  begin
2326    Result := HWND(NSApp.keyWindow.contentView);
2327    if (Handle <> 0) then
2328      NSView(Handle).window.makeKeyWindow;
2329  end;
2330end;
2331
2332function TCocoaWidgetSet.SetBKColor(DC: HDC; Color: TColorRef): TColorRef;
2333var
2334  ctx: TCocoaContext;
2335begin
2336  ctx := CheckDC(DC);
2337  if Assigned(ctx) then
2338  begin
2339    Result := ctx.BkColor;
2340    ctx.BkColor := TColor(Color);
2341  end
2342  else
2343    Result := CLR_INVALID;
2344end;
2345
2346function TCocoaWidgetSet.SetBkMode(DC: HDC; bkMode: Integer): Integer;
2347var
2348  ctx: TCocoaContext;
2349begin
2350  ctx := CheckDC(DC);
2351  if Assigned(ctx) then
2352  begin
2353    Result := ctx.BkMode;
2354    ctx.BkMode := bkMode;
2355  end
2356  else
2357    Result := 0;
2358end;
2359
2360function TCocoaWidgetSet.SetCapture(AHandle: HWND): HWND;
2361begin
2362  Result := FCaptureControl;
2363  FCaptureControl := AHandle;
2364end;
2365
2366function TCocoaWidgetSet.SetCaretPos(X, Y: Integer): Boolean;
2367begin
2368  Result := CocoaCaret.SetCaretPos(X, Y);
2369end;
2370
2371function TCocoaWidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean;
2372begin
2373  Result := CocoaCaret.SetCaretPos(X, Y);
2374end;
2375
2376function TCocoaWidgetSet.SetCaretRespondToFocus(handle: HWND;
2377  ShowHideOnFocus: boolean): Boolean;
2378begin
2379  Result:=inherited SetCaretRespondToFocus(handle, ShowHideOnFocus);
2380end;
2381
2382function TCocoaWidgetSet.RectVisible(dc: hdc; const ARect: TRect): Boolean;
2383var
2384  ClipBox: CGRect;
2385  ctx : TCocoaContext;
2386  R: TRect;
2387begin
2388  ctx := CheckDC(DC);
2389  Result := Assigned(ctx) and (ARect.Right > ARect.Left) and (ARect.Bottom > ARect.Top);
2390
2391  if not Result then Exit;
2392
2393  // In Quartz 2D there is no direct access to clipping path of CGContext,
2394  // therefore we can only test bounding box of the clipping path.
2395
2396  ClipBox := CGContextGetClipBoundingBox(ctx.CGContext);
2397  Result := IntersectRect(R, ARect, CGRectToRect(ClipBox));
2398end;
2399
2400function TCocoaWidgetSet.ReleaseCapture : Boolean;
2401begin
2402  FCaptureControl:=0;
2403  Result := True;
2404end;
2405
2406function TCocoaWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
2407var
2408  ctx: TCocoaContext;
2409begin
2410  Result := 0;
2411  ctx := CheckDC(DC);
2412  if not Assigned(ctx) then
2413    Exit;
2414  if (ctx <> DefaultContext) and (ctx<>ScreenContext) and (not ctx.isControlDC) then
2415    ctx.Free;
2416  Result := 1;
2417end;
2418
2419function TCocoaWidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer;
2420var
2421  ctx: TCocoaContext;
2422begin
2423  ctx := CheckDC(dc);
2424  if not Assigned(ctx) then
2425    Exit(0);
2426  if Assigned(P) then
2427    P^ := ctx.WindowOfs;
2428  Result:=1;
2429end;
2430
2431function TCocoaWidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR;
2432begin
2433  if ACursor = 0 then Result := 0 else
2434  Result := HCURSOR(TCocoaCursor(ACursor).Install);
2435end;
2436
2437function TCocoaWidgetSet.SetCursorPos(X, Y: Integer): Boolean;
2438var
2439  CursorPos: CGPoint;
2440begin
2441  Result := False;
2442
2443  CursorPos.X := X;
2444  CursorPos.Y := Y;
2445  if CGWarpMouseCursorPosition(CursorPos) <> noErr then Exit;
2446  Result := True;
2447end;
2448
2449function NeedsFocusNotifcation(event: NSEvent; win: NSWindow): Boolean;
2450begin
2451  Result := (Assigned(win))
2452      and (not Assigned(event) or (event.window <> win));
2453end;
2454
2455function TCocoaWidgetSet.SetFocus(Handle: HWND): HWND;
2456var
2457  Obj: NSObject;
2458  lView: NSView;
2459  cb: ICommonCallback;
2460begin
2461  if Handle <> 0 then
2462  begin
2463    Result := GetFocus;
2464    if Result = Handle then
2465      Exit;
2466    Obj := NSObject(Handle);
2467    if Obj.isKindOfClass(NSWindow) then
2468    begin
2469      NSWindow(Obj).makeKeyWindow;
2470      NSWindow(Obj).makeFirstResponder(nil);
2471    end
2472    else
2473    begin
2474      lView := obj.lclContentView;
2475      if lView <> nil then
2476      begin
2477        if lView.window <> nil then
2478        begin
2479          lView.window.makeKeyWindow;
2480          if lView.window.makeFirstResponder(lView.lclContentView) then
2481          begin
2482            // initial focus set (right before the event loop starts)
2483            if NeedsFocusNotifcation(NSApp.currentEvent, lView.window) then
2484            begin
2485              cb := lView.lclGetCallback;
2486              if Assigned(cb) then cb.BecomeFirstResponder;
2487            end;
2488          end;
2489        end else
2490          Result := 0; // the view is on window, cannot set focus. Fail
2491      end else
2492        Result := 0;
2493    end;
2494  end
2495  else
2496    Result := 0;
2497end;
2498
2499function TCocoaWidgetSet.SetForegroundWindow(HWnd: HWND): boolean;
2500var
2501  Obj: NSObject;
2502  lWin: NSWindow;
2503begin
2504  Result := HWnd <> 0;
2505  if Result then
2506  begin
2507    {$ifdef BOOLFIX}
2508    NSApp.activateIgnoringOtherApps_(Ord(True));
2509    {$else}
2510    NSApp.activateIgnoringOtherApps(True);
2511    {$endif}
2512    Obj := NSObject(HWnd);
2513    lWin := NSWindow(GetNSObjectWindow(Obj));
2514    if lWin <> nil then
2515      lWin.makeKeyAndOrderFront(NSApp)
2516    else
2517      Result := False;
2518  end;
2519end;
2520
2521function TCocoaWidgetSet.SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean;
2522var
2523  lWin: NSWindow;
2524  frm : TCustomForm;
2525begin
2526  Result := False;
2527
2528  lWin := NSWindow(GetNSObjectWindow(NSObject(AWindowHandle)));
2529
2530  frm := HWNDToForm(AWindowHandle);
2531  if Assigned(frm) and (csDesigning in frm.ComponentState) then begin
2532    Result := true;
2533    Exit;
2534  end;
2535  if not Assigned(frm) then Exit;
2536
2537  if (lWin <> nil) and lWin.isKindOfClass(TCocoaWindow) and
2538     //todo: why is Menu handle checked here?
2539     (frm.Menu.Handle = AMenuHandle)
2540  then
2541  begin
2542    if lWin.isKeyWindow or lWin.isMainWindow then
2543      SetMainMenu(AMenuHandle, frm.Menu);
2544    Result := True;
2545  end;
2546end;
2547
2548{------------------------------- FONT AND TEXT --------------------------------}
2549
2550function TCocoaWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
2551var
2552  ctx: TCocoaContext;
2553begin
2554  ctx := CheckDC(DC);
2555  if Assigned(ctx) then
2556  begin
2557    Result := TColorRef(ctx.TextColor);
2558    ctx.TextColor := TColor(Color);
2559  end
2560  else
2561    Result := CLR_INVALID;
2562end;
2563
2564function TCocoaWidgetSet.SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer;
2565  OldPoint: PPoint): Boolean;
2566var
2567  ctx: TCocoaContext;
2568begin
2569  Result := False;
2570  ctx := CheckDC(DC);
2571  if not Assigned(ctx) then Exit;
2572
2573  if Assigned(OldPoint) then
2574    OldPoint^ := ctx.ViewportOfs;
2575  ctx.ViewportOfs := Types.Point(NewX, NewY);
2576  Result := True;
2577end;
2578
2579function TCocoaWidgetSet.SetWindowOrgEx(DC: HDC; NewX, NewY: Integer;
2580  OldPoint: PPoint): Boolean;
2581var
2582  ctx: TCocoaContext;
2583begin
2584  Result := False;
2585  ctx := CheckDC(DC);
2586  if not Assigned(ctx) then Exit;
2587
2588  if Assigned(OldPoint) then
2589    OldPoint^ := ctx.WindowOfs;
2590  ctx.WindowOfs := Types.Point(NewX, NewY);
2591  Result := True;
2592end;
2593
2594function TCocoaWidgetSet.ShowCaret(Handle: HWND): Boolean;
2595var
2596  lView: NSView;
2597begin
2598  //writeln('WinAPI. show caret ',PtrUInt(Handle));
2599  if (Handle = 0) then lView := nil
2600  else lView := NSView(Handle).lclContentView;
2601
2602  Result := CocoaCaret.ShowCaret(lView)
2603end;
2604
2605{------------------------------------------------------------------------------
2606  Method:  GetSystemMetrics
2607  Params:  NIndex - System metric to retrieve
2608  Returns: The requested system metric value
2609
2610  Retrieves various system metrics.
2611 ------------------------------------------------------------------------------}
2612function TCocoaWidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
2613begin
2614  Result := 0;
2615
2616  {$IFDEF VerboseWinAPI}
2617    DebugLn('TCocoaWidgetSet.GetSystemMetrics NIndex: ' + DbgS(NIndex));
2618  {$ENDIF}
2619
2620  case NIndex of
2621    SM_CXHSCROLL,
2622    SM_CYHSCROLL,
2623    SM_CXVSCROLL,
2624    SM_CYVSCROLL:
2625      Result := Round(NSScroller.scrollerWidthForControlSize(NSRegularControlSize));
2626    SM_CXSCREEN,
2627    SM_CXVIRTUALSCREEN,
2628    SM_CXFULLSCREEN: Result := Round(NSScreen.mainScreen.frame.size.width);
2629    SM_CYSCREEN,
2630    SM_CYVIRTUALSCREEN,
2631    SM_CYFULLSCREEN: Result := Round(NSScreen.mainScreen.frame.size.height);
2632    SM_XVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.x);
2633    SM_YVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.y);
2634    SM_CXSMICON,
2635    SM_CYSMICON:
2636      Result := 16;
2637    SM_CXICON,
2638    SM_CYICON:
2639      Result := 128;
2640    SM_CXCURSOR,
2641    SM_CYCURSOR:
2642      begin
2643{        if TCarbonCursor.HardwareCursorsSupported then
2644          Result := 64 else}
2645          Result := 16;
2646      end;
2647    SM_CXDRAG,SM_CYDRAG: Result := 5;
2648    SM_CXHTHUMB, SM_CYVTHUMB:
2649      Result := Round(NSScroller.scrollerWidthForControlSize(NSRegularControlSize));
2650    SM_SWSCROLLBARSPACING:
2651      Result := 0;
2652    SM_LCLHasFormAlphaBlend:
2653      Result := 1;
2654  else
2655    DebugLn('TCocoaWidgetSet.GetSystemMetrics TODO ', DbgS(NIndex));;
2656  end;
2657
2658  {$IFDEF VerboseWinAPI}
2659    DebugLn('TCocoaWidgetSet.GetSystemMetrics Result: ' + DbgS(Result));
2660  {$ENDIF}
2661end;
2662
2663function TCocoaWidgetSet.GetTextColor(DC: HDC) : TColorRef;
2664var
2665  ctx: TCocoaContext;
2666begin
2667  ctx := CheckDC(DC);
2668  if Assigned(ctx) then
2669    Result := ColorToRGB(ctx.TextColor)
2670  else
2671    Result := CLR_INVALID;
2672end;
2673
2674{------------------------------------------------------------------------------
2675  Method:  GetTextExtentPoint
2676  Params:  DC    - Handle of device context
2677           Str   - Text string
2678           Count - Number of characters in string
2679           Size  - The record for the dimensions of the string
2680  Returns: If the function succeeds
2681
2682  Computes the width and height of the specified string of text
2683 ------------------------------------------------------------------------------}
2684function TCocoaWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
2685var
2686  ctx : TCocoaContext;
2687begin
2688  {$IFDEF VerboseWinAPI}
2689    DebugLn('[TCocoaWidgetSet.GetTextExtentPoint] DC: %x Str: %s Count: %d', [DC, Str, Count]);
2690  {$ENDIF}
2691  ctx:=CheckDC(DC);
2692  Result:=Assigned(ctx);
2693  if not Assigned(ctx) then Exit(False);
2694  Result := ctx.GetTextExtentPoint(Str, Count, Size);
2695  {$IFDEF VerboseWinAPI}
2696    DebugLn('[TCocoaWidgetSet.GetTextExtentPoint] Size: %d,%d', [Size.cx, Size.cy]);
2697  {$ENDIF}
2698end;
2699
2700{------------------------------------------------------------------------------
2701  Method:  GetTextMetrics
2702  Params:  DC - Handle of device context
2703           TM - The Record for the text metrics
2704  Returns: If the function succeeds
2705
2706  Fills the specified buffer with the metrics for the currently selected font
2707  TODO: get exact max. and av. char width, pitch and charset
2708 ------------------------------------------------------------------------------}
2709function TCocoaWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
2710var
2711  ctx: TCocoaContext;
2712begin
2713  ctx := CheckDC(DC);
2714  Result := Assigned(ctx) and ctx.GetTextMetrics(TM);
2715end;
2716
2717function TCocoaWidgetSet.GetViewPortOrgEx(DC: HDC; P: PPoint): Integer;
2718var
2719  ctx: TCocoaContext;
2720begin
2721  ctx := CheckDC(dc);
2722  if not Assigned(ctx) then
2723    Exit(0);
2724  if Assigned(P) then
2725    P^ := ctx.ViewportOfs;
2726  Result:=1;
2727end;
2728
2729function TCocoaWidgetSet.TextOut(DC: HDC; X,Y: Integer; Str: Pchar; Count: Integer) : Boolean;
2730begin
2731  Result := ExtTextOut(DC, X, Y, 0, nil, Str, Count, nil);
2732end;
2733
2734function TCocoaWidgetSet.SaveDC(DC: HDC): Integer;
2735var
2736  ctx: TCocoaContext;
2737begin
2738  ctx := CheckDC(DC);
2739  if Assigned(ctx) then
2740    Result := ctx.SaveDC
2741  else
2742    Result:=0;
2743end;
2744
2745function TCocoaWidgetSet.ScreenToClient(Handle: HWND; var P: TPoint): Integer;
2746begin
2747  Result := Ord(Handle <> 0);
2748
2749  if Result = 1 then
2750    NSObject(Handle).lclScreenToLocal(P.X, P.Y);
2751end;
2752
2753function TCocoaWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer; prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT): Boolean;
2754var
2755  obj: NSOBject;
2756  v : NSView;
2757begin
2758  obj:=NSObject(hWnd);
2759  Result:=Assigned(obj) and (obj.isKindOfClass(NSView));
2760  if not Result then Exit;
2761
2762  v:=NSView(obj).lclContentView;
2763  // todo: parse the passed parameters.
2764  //       the content of the window could be already prepared
2765  //       thus not entire control should be invalided
2766  {$ifdef BOOLFIX}
2767  v.setNeedsDisplay__(Ord(true));
2768  {$else}
2769  v.setNeedsDisplay_(true);
2770  {$endif}
2771end;
2772
2773function TCocoaWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;
2774begin
2775  Result := ExtSelectClipRgn(DC, RGN, RGN_COPY);
2776end;
2777
2778function TCocoaWidgetSet.SetSysColors(cElements: Integer; const lpaElements; const lpaRgbValues): Boolean;
2779var
2780  n: Integer;
2781  Element: LongInt;
2782  Color: NSColor;
2783begin
2784  Result := False;
2785  if cElements > MAX_SYS_COLORS then Exit;
2786
2787  for n := 0 to cElements - 1 do
2788  begin
2789    Element := PInteger(@lpaElements)[n];
2790    if (Element > MAX_SYS_COLORS) or (Element < 0) then
2791      Exit;
2792    Color := ColorToNSColor(PDWord(@lpaRgbValues)[n]);
2793    if (FSysColorBrushes[Element] <> 0) then
2794      TCocoaBrush(FSysColorBrushes[Element]).Color := Color
2795    else
2796      FSysColorBrushes[Element] := HBrush(TCocoaBrush.Create(Color, True));
2797  end;
2798
2799  Result := True;
2800end;
2801
2802function TCocoaWidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
2803var
2804  ctx: TCocoaContext;
2805begin
2806  ctx := CheckDC(DC);
2807  if Assigned(ctx) then
2808    Result := ctx.RestoreDC(SavedDC)
2809  else
2810    Result := False;
2811end;
2812
2813function TCocoaWidgetSet.RoundRect(DC: HDC; X1, Y1, X2, Y2: Integer; RX,
2814  RY: Integer): Boolean;
2815begin
2816  Result:=inherited RoundRect(DC, X1, Y1, X2, Y2, RX, RY);
2817end;
2818
2819//##apiwiz##eps##   // Do not remove, no wizard declaration after this line
2820