1{%MainUnit customdrawnint.pas}
2{******************************************************************************
3  All CustomDrawn Winapi implementations specific to the Cocoa backend
4
5 ******************************************************************************
6 Implementation
7 ******************************************************************************
8
9 *****************************************************************************
10  This file is part of the Lazarus Component Library (LCL)
11
12  See the file COPYING.modifiedLGPL.txt, included in this distribution,
13  for details about the license.
14 *****************************************************************************
15}
16
17function TCDWidgetSet.ClientToScreen(Handle: HWND; var P: TPoint) : Boolean;
18var
19  ControlHandle: TCDBaseControl;
20  lControl: TWinControl;
21  lPoint: NSPoint;
22  lCocoaForm: TCocoaForm; // NSWindow
23  lClientFrame: NSRect;
24begin
25  Result := False;
26  if Handle = 0 then Exit;
27
28  // Go throught the non-native controls
29  ControlHandle := TCDBaseControl(Handle);
30
31  while not (ControlHandle is TCocoaWindow) do
32  begin
33    lControl := ControlHandle.GetWinControl();
34    if lControl = nil then Exit;
35    P.X := P.X + lControl.Left;
36    P.Y := P.Y + lControl.Top;
37
38    lControl := lControl.Parent;
39    if lControl = nil then Exit;
40    ControlHandle := TCDBaseControl(lControl.Handle);
41  end;
42
43  // Now actually do the convertion
44  lClientFrame := TCocoaWindow(ControlHandle).ClientArea.frame;
45  lPoint.x := lClientFrame.origin.X + P.X;
46  lPoint.Y := lClientFrame.origin.Y + lClientFrame.size.height - P.Y;
47  lCocoaForm := TCocoaWindow(ControlHandle).CocoaForm;
48  if lCocoaForm = nil then Exit;
49  lPoint := lCocoaForm.convertBaseToScreen(lPoint);
50  P.x := Round(lPoint.X);
51  P.Y := Screen.Height - Round(lPoint.Y);
52  Result := True;
53end;
54
55function TCDWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
56  FormatID: TClipboardFormat; Stream: TStream): boolean;
57begin
58  Result := False;
59end;
60
61function TCDWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
62  OnRequestProc: TClipboardRequestEvent;  FormatCount: integer;
63  Formats: PClipboardFormat): boolean;
64begin
65  Result := False;
66end;
67
68//##apiwiz##sps##   // Do not remove, no wizard declaration before this line
69(*
70procedure ColorToRGBFloat(cl: TColorRef; var r,g,b: Single); inline;
71begin
72  R:=(cl and $FF) / $FF;
73  G:=((cl shr 8) and $FF) / $FF;
74  B:=((cl shr 16) and $FF) / $FF;
75end;
76
77function RGBToColorFloat(r,g,b: Single): TColorRef; inline;
78begin
79  Result:=(Round(b*$FF) shl 16) or (Round(g*$FF) shl 8) or Round(r*$FF);
80end;
81
82function CocoaCombineMode(fnCombineMode: Integer): TCocoaCombine;
83begin
84  case fnCombineMode of
85    RGN_AND:  Result:=cc_And;
86    RGN_OR:   Result:=cc_Or;
87    RGN_XOR:  Result:=cc_Xor;
88    RGN_DIFF: Result:=cc_Diff;
89  else
90    Result:=cc_Copy;
91  end;
92end;
93
94function TCocoaWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN;
95  fnCombineMode: Longint): Longint;
96begin
97  Result := LCLType.Error;
98  if (Dest = 0) or (Src1 = 0) or (fnCombineMode<RGN_AND) or (fnCombineMode>RGN_COPY) then Exit;
99  if (fnCombineMode <> RGN_COPY) and (Src2 = 0) then Exit;
100
101  TCocoaRegion(Dest).CombineWith(TCocoaRegion(Src1), cc_Copy);
102
103  if fnCombineMode <> RGN_COPY then
104    TCocoaRegion(Dest). CombineWith(TCocoaRegion(Src2), CocoaCombineMode(fnCombineMode));
105end;
106
107{------------------------------------------------------------------------------
108  Method:  CreateBitmap
109  Params:  Width      - Bitmap width, in pixels
110           Height     - Bitmap height, in pixels
111           Planes     - Number of color planes
112           BitCount   - Number of bits required to identify a color (TODO)
113           BitmapBits - Pointer to array containing color data (TODO)
114  Returns: A handle to a bitmap
115
116  Creates a bitmap with the specified width, height and color format
117 ------------------------------------------------------------------------------}
118function TCocoaWidgetSet.CreateBitmap(Width, Height: Integer;
119  Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP;
120var
121  bmpType: TCocoaBitmapType;
122begin
123  {$IFDEF VerboseCDWinAPI}
124    DebugLn('TCocoaWidgetSet.CreateBitmap');
125  {$ENDIF}
126
127  // WORKAROUND: force context supported depths
128  if BitmapBits = nil then
129  begin
130    if BitCount = 24 then BitCount := 32;
131    // if BitCount = 1 then BitCount := 8;
132  end;
133
134  case BitCount of
135    1:  bmpType := cbtMono;
136    8:  bmpType := cbtGray;
137    32: bmpType := cbtARGB;
138  else
139    bmpType := cbtRGB;
140  end;
141
142  // winapi Bitmaps are on a word boundary
143  Result := HBITMAP(TCocoaBitmap.Create(Width, Height, BitCount, BitCount, cbaWord, bmpType, BitmapBits));
144end;
145
146function TCocoaWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH;
147var
148  b     : TCocoaBrush;
149begin
150  b:=TCocoaBrush.Create;
151  with b do ColorToRGBFloat(LogBrush.lbColor, R, G, B);
152  Result:=HBRUSH(b);
153end;
154
155function TCocoaWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP;
156begin
157  {$IFDEF VerboseWinAPI}
158    DebugLn('TCocoaWidgetSet.CreateCompatibleBitmap');
159  {$ENDIF}
160
161  Result := HBITMAP(TCocoaBitmap.Create(Width, Height, 32, 32, cbaDQWord, cbtARGB, nil));
162end;
163
164{------------------------------------------------------------------------------
165  Method:  CreateCompatibleDC
166  Params:  DC - Handle to memory device context
167  Returns: Handle to a memory device context
168
169  Creates a memory device context (DC) compatible with the specified device
170 ------------------------------------------------------------------------------}
171function TCocoaWidgetSet.CreateCompatibleDC(DC: HDC): HDC;
172begin
173  {$IFDEF VerboseWinAPI}
174    DebugLn('TCocoaWidgetSet.CreateCompatibleDC');
175  {$ENDIF}
176
177  Result := HDC(TCocoaContext.Create);
178end;
179
180//todo:
181//function TCocoaWidgetSet.CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN;
182//begin
183//end;
184
185function TCocoaWidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT;
186begin
187  Result:=CreateFontIndirectEx(LogFont, LogFont.lfFaceName);
188end;
189
190function TCocoaWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont;
191  const LongFontName: string): HFONT;
192var
193  cf  : TCocoaFont;
194begin
195  cf:=TCocoaFont.Create;
196  cf.Size:=LogFont.lfHeight;
197  cf.Name:=LongFontName;
198  if LogFont.lfWeight>FW_NORMAL then Include(cf.Style, cfs_Bold);
199  if LogFont.lfItalic>0 then Include(cf.Style, cfs_Italic);
200  if LogFont.lfUnderline>0 then Include(cf.Style, cfs_Underline);
201  if LogFont.lfStrikeOut>0 then Include(cf.Style, cfs_Strikeout);
202  cf.Antialiased:=logFont.lfQuality>=ANTIALIASED_QUALITY;
203  Result:=HFONT(cf);
204end;*)
205
206{$ifndef CD_UseNativeText}
207procedure TCDWidgetSet.BackendListFontPaths(var AFontPaths: TStringList; var AFontList: THashedStringList);
208var
209  i: Integer;
210  lFontPath: string;
211begin
212  // First /Library/Fonts/
213  AFontPaths.Add('/Library/Fonts/');
214  //FontsScanDir(lPasWinFontPath, AFontPaths, AFontList);
215
216  // We have populated FontPaths, now we may build the font list
217  for i := 0 to AFontPaths.Count -1 do
218  begin
219    lFontPath := AFontPaths[i];
220    FontsScanForTTF(lFontPath, AFontList);
221  end;
222
223  {$ifdef CD_Debug_TTF}
224    AFontPaths.SaveToFile('lxfontpaths.txt');
225    AFontList.Sort;
226    AFontList.SaveToFile('lxfontlist.txt');
227  {$endif}
228end;
229
230function TCDWidgetSet.BackendGetFontPath(const LogFont: TLogFont; const LongFontName: string): string;
231var
232  i: Integer;
233  Str: String;
234  AFontName: String;
235begin
236  // First look if font name matches a stored name
237  // but replace generic with reasonable default
238  AFontName:= '';
239  if IsFontNameDefault(LongFontName) then AFontName:= 'Arial'
240  else if SameText(LongFontName, 'sans') then AFontName:= 'Arial'
241  else if SameText(LongFontName, 'serif') then AFontName:= 'Times New Roman'
242  else AFontName:= LongFontName;
243
244  str := FFontList.Values[AFontName];
245  if str <> '' then begin
246    Result:= str;
247    exit;
248  end;
249
250  // Here font name wasn't found - Carry on educated guesses
251
252  // No luck - Nothing was found
253  raise Exception.Create('[BackendGetFontPath] Unable to find a suitable font to replace '+LongFontName);
254end;
255{$endif}
256
257(*function Create32BitAlphaBitmap(ABitmap, AMask: TCocoaBitmap): TCocoaBitmap;
258var
259  ARawImage: TRawImage;
260  Desc: TRawImageDescription absolute ARawimage.Description;
261
262  ImgHandle, ImgMaskHandle: HBitmap;
263  ImagePtr: PRawImage;
264  DevImage: TRawImage;
265  DevDesc: TRawImageDescription;
266  SrcImage, DstImage: TLazIntfImage;
267  W, H: Integer;
268begin
269  Result := nil;
270
271  if not RawImage_FromBitmap(ARawImage, HBITMAP(ABitmap), HBITMAP(AMask)) then
272    Exit;
273
274  ImgMaskHandle := 0;
275
276  W := Desc.Width;
277  if W < 1 then W := 1;
278  H := Desc.Height;
279  if H < 1 then H := 1;
280
281  QueryDescription(DevDesc, [riqfRGB, riqfAlpha], W, H);
282
283  if DevDesc.IsEqual(Desc)
284  then begin
285    // image is compatible, so use it
286    DstImage := nil;
287    ImagePtr := @ARawImage;
288  end
289  else begin
290    // create compatible copy
291    SrcImage := TLazIntfImage.Create(ARawImage, False);
292    DstImage := TLazIntfImage.Create(0,0,[]);
293    DstImage.DataDescription := DevDesc;
294    DstImage.CopyPixels(SrcImage);
295    SrcImage.Free;
296    DstImage.GetRawImage(DevImage);
297    ImagePtr := @DevImage;
298  end;
299
300  try
301    if not RawImage_CreateBitmaps(ImagePtr^, ImgHandle, ImgMaskHandle, True) then Exit;
302
303    Result := TCocoaBitmap(ImgHandle);
304  finally
305    ARawImage.FreeData;
306    DstImage.Free;
307  end;
308end;
309
310function TCocoaWidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON;
311var
312  ABitmap: TCocoaBitmap;
313begin
314  Result := 0;
315  if IconInfo^.hbmColor = 0 then Exit;
316
317  ABitmap := Create32BitAlphaBitmap(TCocoaBitmap(IconInfo^.hbmColor), TCocoaBitmap(IconInfo^.hbmMask));
318
319  if IconInfo^.fIcon then
320    Result := HICON(ABitmap)
321  else
322    Result := HICON(TCocoaCursor.CreateFromBitmap(ABitmap, GetNSPoint(IconInfo^.xHotSpot, IconInfo^.yHotSpot)));
323end;
324
325function TCocoaWidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN;
326var
327  p   : TCocoaPen;
328  cl  : DWORD;
329begin
330  {$IFDEF VerboseWinAPI}
331    DebugLn('TCocoaWidgetSet.CreatePenIndirect');
332  {$ENDIF}
333  p:=TCocoaPen.Create;
334  if LogPen.lopnWidth.x>0 then p.Width:=LogPen.lopnWidth.x;
335  p.Style:=LogPen.lopnStyle;
336  if LogPen.lopnColor and $8000000 > 0 then cl:=GetSysColor(LogPen.lopnColor)
337  else cl:=LogPen.lopnColor;
338  //todo:!
339  ColorToRGBFloat(cl, p.R, p.G, p.B);
340  Result := HPEN(p);//TCocoaPen.Create(LogPen));
341end;
342
343{------------------------------------------------------------------------------
344  Method:  CreatePolygonRgn
345  Params:  Points   - Pointer to array of polygon points
346           NumPts   - Number of points passed
347           FillMode - Filling mode
348  Returns: The new polygonal region
349
350  Creates a new polygonal region from the specified points
351 ------------------------------------------------------------------------------}
352function TCocoaWidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer;
353  FillMode: integer): HRGN;
354begin
355  {$IFDEF VerboseWinAPI}
356    DebugLn('TCocoaWidgetSet.CreatePolygonRgn NumPts: ' + DbgS(NumPts) +
357      ' FillMode: ' + DbgS(FillMode));
358  {$ENDIF}
359
360  Result := HRGN(TCocoaRegion.Create(Points, NumPts, FillMode=ALTERNATE));
361end;
362
363function TCocoaWidgetSet.CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
364begin
365  {$IFDEF VerboseWinAPI}
366    DebugLn('TCocoaWidgetSet.CreateRectRgn R: ' + DbgS(Classes.Rect(X1, Y1, X2, Y2)));
367  {$ENDIF}
368
369  Result := HRGN(TCocoaRegion.Create(X1, Y1, X2, Y2));
370end;
371
372function TCocoaWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
373var
374  gdi: TCocoaGDIObject;
375begin
376  Result:=True;
377  gdi:=CheckGDIOBJ(GdiObject);
378  if Assigned(gdi) then gdi.Release;
379end;
380
381function TCocoaWidgetSet.DestroyIcon(Handle: HICON): Boolean;
382var
383  Ico: TObject;
384begin
385  Result := Handle <> 0;
386  if not Result then
387    Exit;
388  Ico := TObject(Handle);
389  Result := (Ico is TCocoaBitmap) or (Ico is TCocoaCursor);
390  if Result then
391    Ico.Destroy;
392end;
393
394function TCocoaWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean;
395var
396  ctx : TCocoaContext;
397begin
398  ctx:=CheckDC(DC);
399  Result:=Assigned(ctx);
400  if not Result then Exit;
401
402  ctx.Ellipse(x1, y1, x2, y2);
403end;
404
405function TCocoaWidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
406begin
407  if hWnd<>0
408    then NSObject(hWnd).lclSetEnabled(bEnable)
409    else Result:=False;
410end;
411
412function TCocoaWidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
413  lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
414var
415  i: integer;
416begin
417  Result := True;
418  for i := 0 to NSScreen.screens.count - 1 do
419  begin
420    Result := Result and lpfnEnum(HMONITOR(NSScreen.screens.objectAtIndex(i)), 0, nil, dwData);
421    if not Result then break;
422  end;
423end;*)
424
425function TCDWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
426  Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
427{var
428  fontManager : NSFontManager;
429  arr         : NSArray;
430  fname       : NSString;
431  i           : Integer;
432
433  ELogFont    : TEnumLogFontEx;
434  Metric      : TNewTextMetricEx;
435  FontName    : AnsiString;    }
436begin
437  Result:=0;
438{  if not Assigned(Callback) then Exit;
439  fontManager:=NSFontManager.sharedFontManager;
440  arr:=fontManager.availableFontFamilies;
441  for i:=0 to arr.count-1 do begin
442    fname:=NSString(arr.objectAtIndex(i));
443    try
444      FontName:=NSStringToString(fname);
445      FillChar(ELogFont, SizeOf(ELogFont), #0);
446      FillChar(Metric, SizeOf(Metric), #0);
447      ELogFont.elfLogFont.lfFaceName := FontName;
448      ELogFont.elfFullName := FontName;
449      //todo: read the data from all fonts of the fontfamily
450      Result:=CallBack(ELogFont, Metric, TRUETYPE_FONTTYPE, lparam);
451      if Result=0 then Break;
452    except
453      Break;
454    end;
455  end;
456  arr.release; }
457end;
458
459{$ifdef CD_UseNativeText}
460function TCDWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
461  Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
462var
463  ctx: TCocoaContext;
464  lazdc: TLazCanvas;
465begin
466  {$ifdef VerboseCDText}
467    DebugLn(Format('[WinAPI ExtTextOut] DC=%x X=%d Y=%d Str=%s Count=%d', [DC, X, Y, StrPas(Str), Count]));
468  {$endif}
469
470  if not IsValidDC(DC) then Exit;
471
472  lazdc := TLazCanvas(ScreenDC);
473  if lazdc.NativeDC = 0 then Exit;
474  ctx := TCocoaContext(lazdc.NativeDC);
475
476  // Native TextOut
477  ctx.TextOut(0, 0, Str, Count, Dx, 0);
478
479  // Now blend it into our DC
480  lazdc := TLazCanvas(DC);
481  lazdc.AlphaBlend(ScreenDC, X, Y, 0, 0, ScreenBitmapWidth, ScreenBitmapHeight);
482end;
483{$endif}
484
485(*{------------------------------------------------------------------------------
486  Method:  GetWindowRect
487  Params:  Handle - Handle of window
488           Rect   - Record for window coordinates
489  Returns: if the function succeeds, the return value is nonzero; if the
490           function fails, the return value is zero
491
492  Retrieves the screen bounding rectangle of the specified window
493 ------------------------------------------------------------------------------}
494function TCocoaWidgetSet.GetWindowRect(Handle: hwnd; var ARect: TRect): Integer;
495var
496  dx, dy: Integer;
497begin
498  if Handle<>0 then begin
499    ARect:=NSObject(Handle).lclFrame;
500    if not NSObject(Handle).isKindOfClass_(NSWindow) then begin
501      dx:=0; dy:=0;
502      NSObject(Handle).lclLocalToScreen(dx, dx);
503      MoveRect(ARect, dx, dy);
504    end;
505    Result:=1;
506  end else
507    Result:=0;
508end;
509
510function TCocoaWidgetSet.IsWindowEnabled(Handle: HWND): boolean;
511begin
512  if Handle<>0
513    then Result:=NSObject(Handle).lclIsEnabled
514    else Result:=False;
515end;
516
517function TCocoaWidgetSet.IsWindowVisible(Handle: HWND): boolean;
518begin
519  if Handle<>0
520    then Result:=NSObject(Handle).lclIsVisible
521    else Result:=False;
522end;*)
523
524function TCDWidgetSet.BackendGetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
525begin
526  if Handle<>0 then
527  begin
528    Result:=True;
529    ARect:= TCocoaWindow(handle).CocoaForm.lclClientFrame;
530  end
531  else
532    Result:=False;
533  //WriteLn(Format('[TCDWidgetSet.BackendGetClientBounds handle=%d x=%d y=%d w=%d h=%d',
534  //  [Handle, ARect.Left, ARect.Top, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top]));
535end;
536
537(*function TCocoaWidgetSet.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
538var
539  dx, dy: Integer;
540begin
541  if Handle<>0 then begin
542    Result:=True;
543    ARect:=NSObject(handle).lclClientFrame;
544    dx:=0; dy:=0;
545    NSObject(Handle).lclLocalToScreen(dx, dy);
546    MoveRect(ARect, dx, dy);
547  end else
548    Result:=False;
549end;*)
550
551function TCDWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
552begin
553  lpPoint.x := Round(NSEvent.mouseLocation.x);
554    // cocoa returns cursor with inverted y coordinate
555  lpPoint.y := Round(NSScreen.mainScreen.frame.size.height -
556    NSEvent.mouseLocation.y);
557
558  Result := True;
559end;
560
561{------------------------------------------------------------------------------
562  Function: GetDeviceCaps
563  Params: DC: HDC; Index: Integer
564  Returns: Integer
565 ------------------------------------------------------------------------------}
566function TCDWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
567var
568  LazDC: TLazCanvas;
569begin
570  {$ifdef VerboseCDWinAPI}
571    DebugLn('[WinAPI GetDeviceCaps] DC ' + dbghex(DC));
572  {$endif}
573
574  Result := 0;
575
576  if DC = 0 then DC := HDC(ScreenDC);
577  LazDC := TLazCanvas(DC);
578
579  case Index of
580//    HORZSIZE:
581//      Result := QPaintDevice_widthMM(PaintDevice);
582//    VERTSIZE:
583//      Result := QPaintDevice_heightMM(PaintDevice);
584//    HORZRES:
585//      Result := QPaintDevice_width(PaintDevice);
586//    BITSPIXEL:
587//      Result := QPaintDevice_depth(PaintDevice);
588    PLANES:
589      Result := 1;
590//    SIZEPALETTE:
591//      Result := QPaintDevice_numColors(PaintDevice);
592{    LOGPIXELSX:
593      Result := javaEnvRef^^.GetLongField(javaEnvRef, javaActivityObject, javaField_lclxdpi;
594    LOGPIXELSY:
595      Result := javaEnvRef^^.GetLongField(javaEnvRef, javaActivityObject, javaField_lclydpi;}
596//    VERTRES:
597//      Result := QPaintDevice_height(PaintDevice);
598    NUMRESERVED:
599      Result := 0;
600    else
601      Result := 0;
602  end;
603end;
604
605function TCDWidgetSet.GetKeyState(nVirtKey: Integer): Smallint;
606begin
607  Result := inherited GetKeyState(nVirtKey);
608end;
609
610(*function TCocoaWidgetSet.GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
611var
612  ScreenID: NSScreen absolute hMonitor;
613begin
614  Result := (lpmi <> nil) and (lpmi^.cbSize >= SizeOf(TMonitorInfo));
615  if not Result then Exit;
616  NSToLCLRect(ScreenID.frame, lpmi^.rcMonitor);
617  NSToLCLRect(ScreenID.visibleFrame, lpmi^.rcWork);
618  if ScreenID = NSScreen.mainScreen then
619    lpmi^.dwFlags := MONITORINFOF_PRIMARY
620  else
621    lpmi^.dwFlags := 0;
622end;
623
624function TCocoaWidgetSet.GetParent(Handle : HWND): HWND;
625begin
626  if Handle<>0 then
627    Result:=HWND(NSObject(Handle).lclParent)
628  else
629    Result:=0;
630end;*)
631
632{------------------------------------------------------------------------------
633  Method:  GetSystemMetrics
634  Params:  NIndex - System metric to retrieve
635  Returns: The requested system metric value
636
637  Retrieves various system metrics.
638 ------------------------------------------------------------------------------}
639function TCDWidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
640begin
641  Result := 0;
642
643  {$IFDEF VerboseWinAPI}
644    DebugLn('TCocoaWidgetSet.GetSystemMetrics NIndex: ' + DbgS(NIndex));
645  {$ENDIF}
646
647  case NIndex of
648{    SM_CXHSCROLL,
649    SM_CYHSCROLL,
650    SM_CXVSCROLL,
651    SM_CYVSCROLL:
652      Result := 10;//GetCarbonThemeMetric(kThemeMetricScrollBarWidth);}
653    SM_CXSCREEN,
654    SM_CXVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.size.width);
655    SM_CYSCREEN,
656    SM_CYVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.size.height);
657    SM_XVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.x);
658    SM_YVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.y);
659    SM_CXSMICON,
660    SM_CYSMICON:
661      Result := 16;
662    SM_CXICON,
663    SM_CYICON:
664      Result := 128;
665    SM_CXCURSOR,
666    SM_CYCURSOR:
667      begin
668{        if TCarbonCursor.HardwareCursorsSupported then
669          Result := 64 else}
670          Result := 16;
671      end;
672{    SM_CXHTHUMB:
673      Result := 16;//GetCarbonThemeMetric(kThemeMetricScrollBarMinThumbWidth);
674    SM_CYVTHUMB:
675      Result := 16;//GetCarbonThemeMetric(kThemeMetricScrollBarMinThumbHeight);}
676    SM_SWSCROLLBARSPACING:
677      Result:=0;
678  else
679    DebugLn('TCocoaWidgetSet.GetSystemMetrics TODO ', DbgS(NIndex));;
680  end;
681
682  {$IFDEF VerboseWinAPI}
683    DebugLn('TCocoaWidgetSet.GetSystemMetrics Result: ' + DbgS(Result));
684  {$ENDIF}
685end;
686
687{$ifdef CD_UseNativeText}
688{------------------------------------------------------------------------------
689  Method:  GetTextExtentPoint
690  Params:  DC    - Handle of device context
691           Str   - Text string
692           Count - Number of characters in string
693           Size  - The record for the dimensions of the string
694  Returns: If the function succeeds
695
696  Computes the width and height of the specified string of text
697 ------------------------------------------------------------------------------}
698function TCDWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
699var
700  ctx: TCocoaContext;
701  lazdc: TLazCanvas;
702begin
703  {$IFDEF VerboseCDText}
704    DebugLn('[TCDWidgetSet.GetTextExtentPoint] DC: %x Str: %s Count: %d', [DC, Str, Count]);
705  {$ENDIF}
706
707  if not IsValidDC(DC) then Exit;
708
709  lazdc := TLazCanvas(DC);
710  if lazdc.NativeDC = 0 then Exit;
711  ctx := TCocoaContext(lazdc.NativeDC);
712
713  Result := ctx.GetTextExtentPoint(Str, Count, Size);
714
715  {$IFDEF VerboseCDText}
716    DebugLn('[TCDWidgetSet.GetTextExtentPoint] Size: %d,%d', [Size.cx, Size.cy]);
717  {$ENDIF}
718end;
719
720{------------------------------------------------------------------------------
721  Method:  GetTextMetrics
722  Params:  DC - Handle of device context
723           TM - The Record for the text metrics
724  Returns: If the function succeeds
725
726  Fills the specified buffer with the metrics for the currently selected font
727  TODO: get exact max. and av. char width, pitch and charset
728 ------------------------------------------------------------------------------}
729function TCDWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
730var
731  ctx: TCocoaContext;
732  lazdc: TLazCanvas;
733begin
734  Result := False;
735
736  {$IFDEF VerboseCDText}
737    DebugLn('TCDWidgetSet.GetTextMetrics DC: ' + DbgS(DC));
738  {$ENDIF}
739
740  if not IsValidDC(DC) then Exit;
741
742  lazdc := TLazCanvas(DC);
743  if lazdc.NativeDC = 0 then Exit;
744  ctx := TCocoaContext(lazdc.NativeDC);
745
746  Result := ctx.GetTextMetrics(TM);
747
748  {$IFDEF VerboseCDText}
749    DebugLn('TCDWidgetSet.GetTextMetrics Result: ' + DbgS(Result) +
750      ' TextMetric: ' + DbgS(TM));
751  {$ENDIF}
752end;
753{$endif}
754
755function TCDWidgetSet.BackendGetWindowRelativePosition(Handle: hwnd; var Left, Top: Integer): boolean;
756begin
757  if Handle<>0 then
758  begin
759    Result:=True;
760    //TCocoaWindow(handle).lclRelativePos(Left, Top);
761  end
762  else
763    Result:=False;
764end;
765
766function TCDWidgetSet.BackendGetWindowSize(Handle: hwnd; var Width, Height: Integer): boolean;
767var
768  r   : TRect;
769begin
770  {if Handle<>0 then begin
771    Result:=True;
772    r:=NSObject(Handle).lclFrame;
773    Width:=R.Right-R.Left;
774    Height:=R.Bottom-R.Top;
775  end else   }
776    Result:=False;
777end;
778
779function TCDWidgetSet.BackendInvalidateRect(aHandle : HWND; Rect : pRect; bErase : Boolean): Boolean;
780begin
781  if aHandle<>0 then
782  begin
783    Result:=True;
784    if Assigned(Rect) then
785      TCocoaWindow(aHandle).CocoaForm.lclInvalidateRect(Rect^)
786    else
787      TCocoaWindow(aHandle).CocoaForm.lclInvalidate;
788  end
789  else
790    Result:=False;
791end;
792
793function TCDWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer;
794{var
795  Str: WideString;
796  TitleStr: WideString;
797  OkStr: WideString;}
798begin
799{  //TODO: Finish full implementation of MessageBox
800  Str := GetUtf8String('TQtWidgetSet.MessageBox - not implemented');
801  TitleStr := GetUtf8String(lpCaption);
802  OkStr := GetUtf8String('Ok');
803  Result := QMessageBox_information(TQtWidget(hWnd).Widget, @Str, @TitleStr, @OkStr);}
804end;
805
806(*function TCocoaWidgetSet.UpdateWindow(Handle: HWND): Boolean;
807begin
808  Result:=InvalidateRect(Handle, nil, false);
809end;
810
811{----------------------------- WINDOWS SCROLLING ------------------------------}
812
813function TCocoaWidgetSet.GetScrollBarSize(Handle: HWND; BarKind: Integer): integer;
814begin
815  Result:=0;
816end;
817
818function TCocoaWidgetSet.GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean;
819begin
820  Result:=False;
821end;
822
823function TCocoaWidgetSet.GetScrollInfo(Handle: HWND; BarFlag: Integer; Var ScrollInfo: TScrollInfo): Boolean;
824begin
825  Result:=False;
826end;
827
828function TCocoaWidgetSet.SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer;
829begin
830  Result:=0;
831end;
832
833function TCocoaWidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean;
834begin
835  Result:=False;
836end;
837
838function TCocoaWidgetSet.SelectObject(ADC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
839var
840  dc: TCocoaContext;
841  gdi: TCocoaGDIObject;
842const
843  SName = 'TCarbonWidgetSet.SelectObject';
844begin
845  {$IFDEF VerboseWinAPI}
846    DebugLn(Format('TCocoaWidgetSet.SelectObject DC: %x GDIObj: %x', [ADC, GDIObj]));
847  {$ENDIF}
848  Result := 0;
849
850  dc:=CheckDC(ADC);
851  gdi:=CheckGDIOBJ(GDIObj);
852  if not Assigned(dc) then Exit;
853
854  if gdi is TCocoaBrush then begin // select brush
855    Result := HBRUSH(dc.Brush);
856    dc.Brush := TCocoaBrush(gdi);
857  end else if gdi is TCocoaPen then begin // select pen
858    Result := HPEN(dc.Pen);
859    dc.Pen := TCocoaPen(gdi);
860  end else if gdi is TCocoaFont then begin // select font
861    Result := HFONT(dc.Font);
862    dc.Font := TCocoaFont(gdi);
863  end else if gdi is TCocoaRegion then begin // select region
864    Result := HBRUSH(dc.Region);
865    dc.Region := TCocoaRegion(gdi);
866  end else if gdi is TCocoaBitmap then begin // select bitmap
867    {if not (ADC is TCarbonBitmapContext) then
868    begin
869      DebugLn(SName + ' Error - The specified device context is not bitmap context!');
870      Exit;
871    end;}
872    Result := HBITMAP(dc.Bitmap);
873    dc.Bitmap:=TCocoaBitmap(gdi);
874    //TCarbonBitmapContext(ADC).Bitmap := TCarbonBitmap(GDIObj);
875  end;
876
877  if Result<>0 then TCocoaGDIObject(Result).Release;
878  if Assigned(gdi) then gdi.AddRef;
879
880  {$IFDEF VerboseWinAPI}
881    DebugLn(Format('TCocoaWidgetSet.SelectObject Result: %x', [Result]));
882  {$ENDIF}
883end;*)
884
885{------------------------------------------------------------------------------
886  Function: SetFocus
887  Params: hWnd   - Window handle to be focused
888  Returns:
889
890 ------------------------------------------------------------------------------}
891function TCDWidgetSet.BackendSetFocus(hWnd: HWND): HWND;
892begin
893  Result := 0;
894end;
895
896(*{------------------------------------------------------------------------------
897  function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
898
899  nCmdShow:
900    SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED
901------------------------------------------------------------------------------}
902function TCocoaWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
903begin
904  {$ifdef VerboseCocoaWinAPI}
905    DebugLn('TCocoaWidgetSet.ShowWindow');
906  {$endif}
907
908  case nCmdShow of
909    SW_SHOW, SW_SHOWNORMAL:
910      NSWindow(hwnd).orderFront(nil);
911    SW_HIDE:
912      NSWindow(hwnd).orderOut(nil);
913    SW_MINIMIZE:
914      NSWindow(hwnd).miniaturize(nil);
915  end;
916  Result:=true;
917end;
918
919function TCocoaWidgetSet.RectVisible(DC: HDC; const ARect: TRect): Boolean;
920var
921  ClipBox: CGRect;
922  ctx : TCocoaContext;
923  R: TRect;
924begin
925  Result := False;
926
927  {$IFDEF VerboseWinAPI}
928    DebugLn('TCarbonWidgetSet.RectVisible DC: ' + DbgS(DC) + ' R: ' + DbgS(ARect));
929  {$ENDIF}
930
931  ctx:=CheckDC(DC);
932  if not Assigned(ctx) or (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then Exit;
933
934  // In Quartz 2D there is no direct access to clipping path of CGContext,
935  // therefore we can only test bounding box of the clipping path.
936
937  ClipBox := CGContextGetClipBoundingBox(ctx.CGContext);
938  Result := IntersectRect(R, ARect, CGRectToRect(ClipBox));
939
940  {$IFDEF VerboseWinAPI}
941    DebugLn('TCarbonWidgetSet.RectVisible Result: ' + DbgS(Result) + ' Clip: ' + DbgS(CGRectToRect(ClipBox)));
942  {$ENDIF}
943end;
944
945function TCocoaWidgetSet.MoveWindowOrgEx(DC: HDC; dX, dY: Integer): Boolean;
946var
947  ctx : TCocoaContext;
948begin
949  Result := False;
950  ctx:=CheckDC(DC);
951  if not Assigned(ctx) then Exit;
952
953  {$IFDEF VerboseWinAPI}
954  DebugLn('TCarbonWidgetSet.MoveWindowOrgEx DC: ' + DbgS(DC) + ' ' + DbgS(DX) + ', ' + DbgS(DY));
955  {$ENDIF}
956  ctx.SetOrigin(dX, dY);
957  Result := True;
958end;
959
960function TCocoaWidgetSet.GetWindowOrgEx(dc : hdc; P : PPoint): Integer;
961var
962  ctx : TCocoaContext;
963begin
964  ctx:=CheckDC(dc);
965  if not Assigned(ctx) or not Assigned(P) then
966    Result:=0
967  else begin
968    ctx.GetOrigin(p^.X, p^.Y);
969    Result:=1;
970  end;
971end;
972
973function TCocoaWidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR;
974begin
975  Result := HCURSOR(TCocoaCursor(ACursor).Install);
976end;
977
978function TCocoaWidgetSet.SetCursorPos(X, Y: Integer): Boolean;
979var
980  CursorPos: CGPoint;
981begin
982  Result := False;
983
984  CursorPos.X := X;
985  CursorPos.Y := Y;
986  if CGWarpMouseCursorPosition(CursorPos) <> noErr then Exit;
987  Result := True;
988end;
989*)
990
991(*function TCocoaWidgetSet.SaveDC(DC: HDC): Integer;
992var
993  ctx : TCocoaContext;
994  cg  : CGContextRef;
995begin
996  ctx := CheckDC(DC);
997  if not Assigned(ctx) then begin
998    Result:=0;
999    Exit;
1000  end;
1001  cg:=ctx.CGContext;
1002  if Assigned(cg) then begin
1003    CGContextSaveGState(cg);
1004    inc(ctx.Stack);
1005    Result:=ctx.Stack;
1006  end else
1007    Result:=0;
1008end;
1009
1010function TCocoaWidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
1011var
1012  ctx : TCocoaContext;
1013  cg  : CGContextRef;
1014  cnt : Integer;
1015  i   : Integer;
1016begin
1017  Result:=False;
1018  ctx := CheckDC(DC);
1019  cg:=ctx.CGContext;
1020  if not Assigned(ctx) or not Assigned(cg) then Exit;
1021
1022  if SavedDC<0 then cnt:=1
1023  else cnt:=ctx.Stack-SavedDC+1;
1024  Result:=cnt>0;
1025
1026  if Result then begin
1027    for i:=1 to cnt do CGContextRestoreGState(cg);
1028    dec(ctx.Stack, cnt);
1029  end;
1030end;*)
1031
1032{------------------------------------------------------------------------------
1033  Method:  ScreenToClient
1034  Params: Handle - window handle for source coordinates
1035          P      - record containing coordinates
1036  Returns: if the function succeeds, the return value is nonzero; if the
1037           function fails, the return value is zero
1038
1039  Converts the screen coordinates of a specified point on the screen to client
1040  coordinates.
1041 ------------------------------------------------------------------------------}
1042function TCDWidgetSet.ScreenToClient(Handle: HWND; Var P: TPoint): Integer;
1043begin
1044  Result := 0;
1045  //Result := Integer(Windows.ScreenToClient(Handle, @P));
1046end;
1047
1048//##apiwiz##eps##   // Do not remove, no wizard declaration after this line
1049