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