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