{%MainUnit cocoaint.pas} {****************************************************************************** All Cocoa interface communication implementations. This is the implementation of the overrides of the Cocoa Interface for the methods defined in the lcl/include/lclintf.inc !! Keep alphabetical !! ****************************************************************************** Implementation ****************************************************************************** ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } {------------------------------------------------------------------------------ Method: CreateStandardCursor Params: ACursor - Cursor type Returns: Cursor object in Cocoa for the specified cursor type ------------------------------------------------------------------------------} function TCocoaWidgetSet.CreateStandardCursor(ACursor: SmallInt): hCursor; begin case ACursor of crArrow, crAppStart, // neither LCL nor Cocoa provides "crAppStart" cursor crDefault : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.arrowCursor)); crCross : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.crosshairCursor)); crIBeam : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.IBeamCursor)); crSizeNS, crVSplit : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.resizeUpDownCursor)); crSizeNESW : Result := HCursor(TCocoaCursor.CreateFromCustomCursor( AllocCursorFromCursorByDegrees(NSCursor.resizeLeftRightCursor, 45) )); crSizeNWSE : Result := HCursor(TCocoaCursor.CreateFromCustomCursor( AllocCursorFromCursorByDegrees(NSCursor.resizeLeftRightCursor, -45) )); crSizeWE, crHSplit : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.resizeLeftRightCursor)); crSizeN : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.resizeUpCursor)); crSizeNW : Result := HCursor(TCocoaCursor.CreateFromCustomCursor( AllocCursorFromCursorByDegrees(NSCursor.resizeLeftCursor, -45) )); crSizeSW : Result := HCursor(TCocoaCursor.CreateFromCustomCursor( AllocCursorFromCursorByDegrees(NSCursor.resizeLeftCursor, 45) )); crSizeW : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.resizeLeftCursor)); crSizeNE : Result := HCursor(TCocoaCursor.CreateFromCustomCursor( AllocCursorFromCursorByDegrees(NSCursor.resizeRightCursor, 45) )); crSizeSE : Result := HCursor(TCocoaCursor.CreateFromCustomCursor( AllocCursorFromCursorByDegrees(NSCursor.resizeRightCursor, -45) )); crSizeE : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.resizeRightCursor)); crSizeS : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.resizeDownCursor)); crNo, crNoDrop : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.operationNotAllowedCursor)); crHandPoint : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.pointingHandCursor)); //crHourGlass, crDrag : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.dragCopyCursor)); else // We answer with Result=0 for crHourGlass because Cocoa does not provide any API // to set the wait cursor. As a compromise to make cross-platform LCL apps written // in Windows/Linux behave as expected without change, we answer 0 here and // a non-native wait cursor will be utilized Result := 0; end; end; (* {------------------------------------------------------------------------------ Method: DrawGrid Params: DC - Handle to device context R - Grid rectangle DX, DY - Grid cell width and height Draws the point grid ------------------------------------------------------------------------------} procedure TCarbonWidgetSet.DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); begin {$IFDEF VerboseLCLIntf} DebugLn('TCarbonWidgetSet.DrawGrid Rect: ' + DbgS(R)); {$ENDIF} if not CheckDC(DC, 'DrawGrid') then Exit; TCarbonDeviceContext(DC).DrawGrid(R, DX, DY); end; function TCarbonWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; begin Result:=inherited ExtUTF8Out(DC, X, Y, Options, Rect, Str, Count, Dx); end; function TCarbonWidgetSet.GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; begin Result:=inherited GetAcceleratorString(AVKey, AShiftState); end; function TCarbonWidgetSet.GetControlConstraints(Constraints: TObject): boolean; begin Result:=inherited GetControlConstraints(Constraints); end; {------------------------------------------------------------------------------ Method: GetDesignerDC Params: WindowHandle - Handle of window Returns: Device context for window designer ------------------------------------------------------------------------------} function TCarbonWidgetSet.GetDesignerDC(WindowHandle: HWND): HDC; begin Result := 0; {$IFDEF VerboseLCLIntf} DebugLn('TCarbonWidgetSet.GetDesignerDC Handle: ' + DbgS(WindowHandle)); {$ENDIF} if not CheckWidget(WindowHandle, 'GetDesignerDC', TCarbonDesignWindow) then Exit; Result := HDC(TCarbonDesignWindow(WindowHandle).GetDesignContext); end; {------------------------------------------------------------------------------ Method: GetLCLOwnerObject Params: Handle - Handle of window Returns: LCL control which has the specified widget ------------------------------------------------------------------------------} function TCarbonWidgetSet.GetLCLOwnerObject(Handle: HWnd): TObject; begin {$IFDEF VerboseLCLIntf} DebugLn('TCarbonWidgetSet.GetLCLOwnerObject Handle: ' + DbgS(Handle)); {$ENDIF} Result := nil; if not CheckWidget(Handle, 'GetLCLOwnerObject') then Exit; Result := TCarbonWidget(Handle).LCLObject; {$IFDEF VerboseLCLIntf} DebugLn('TCarbonWidgetSet.GetLCLOwnerObject Result: ' + DbgS(Result)); {$ENDIF} end; *) {------------------------------------------------------------------------------ Method: IsDesignerDC Params: WindowHandle - Handle of window DC - Handle of device context Returns: If the device context is designer ------------------------------------------------------------------------------} function TCocoaWidgetSet.IsDesignerDC(WindowHandle: HWND; DC: HDC): Boolean; begin Result := (WindowHandle <> 0) and (DC <> 0) and TCocoaContext(DC).isDesignDC; end; procedure TCocoaWidgetSet.SyncClipboard(); begin fClipboard.Sync; end; type { TCocoaAlertCancelAccessoryView } TCocoaAlertCancelAccessoryView = objcclass(NSView) sheetOfWindow: NSWindow; function performKeyEquivalent (theEvent: NSEvent): LCLObjCBoolean; override; end; TCocoaSheetDelegate = objcclass(NSObject) public ended: Boolean; retCode: NSInteger; procedure alertDidEnd(alert:NSAlert; returncode: NSInteger; contextInfo: Pointer); message 'alertDidEnd:::'; end; procedure TCocoaSheetDelegate.alertDidEnd(alert:NSAlert; returncode: NSInteger; contextInfo: Pointer); begin ended := true; retCode := returnCode; end; // it's placed as a separate function for an easier code management function RunSheetAsModal(anAlert: NSAlert; ownerWindow: NSWindow): Integer; var alertDel: TCocoaSheetDelegate; begin alertDel:= TCocoaSheetDelegate.alloc.init; try anAlert.beginSheetModalForWindow_modalDelegate_didEndSelector_contextInfo( ownerWindow, alertDel, ObjCSelector('alertDidEnd:::'), nil); while not alertDel.ended do CocoaWidgetSet.AppProcessMessages; Result := alertDel.retCode; finally alertDel.release; end; end; {------------------------------------------------------------------------------ Func: CocoaPromptUser Params: DialogCaption - Dialog caption DialogMessage - Dialog message text DialogType - Type of dialog Buttons - Pointer to button types ButtonCount - Count of passed buttons DefaultIndex - Index of default button EscapeResult - Result value of escape sheetOfWindow - Shows the prompt as a sheet to the specified NSWindow, if nil, the prompt is shown as an application modal dialog modalSheet - (only used if sheetOfWindow is not null). if true, the function doesn't return until the sheet is closed Returns: The result value of pushed button Shows modal dialog or window sheet with the specified caption, message and buttons and prompts user to push one. ------------------------------------------------------------------------------} function CocoaPromptUser(const DialogCaption : string; const DialogMessage : string; DialogType : LongInt; Buttons : PLongInt; ButtonCount : LongInt; DefaultIndex : LongInt; EscapeResult : LongInt; sheetOfWindow : NSWindow; modalSheet: Boolean) : LongInt; {Implements MessageDlg.} var anAlert: NSAlert; informativeText: NSString; messageText: NSString; I: Integer; aButton: NSButton; Str: string; cancelAccessory: TCocoaAlertCancelAccessoryView; needsCancel: Boolean; isMenuOn: Boolean; begin {Str := 'TCocoaWidgetSet.PromptUser DialogCaption: ' + DialogCaption + ' DialogMessage: ' + DialogMessage + ' DialogType: ' + DbgS(DialogType) + ' ButtonCount: ' + DbgS(ButtonCount) + ' DefaultIndex: ' + DbgS(DefaultIndex) + ' EscapeResult: ' + DbgS(EscapeResult); Result := -1;} {$IFDEF VerboseLCLIntf} DebugLn('TCocoaWidgetSet.PromptUser DialogCaption: ' + DialogCaption + ' DialogMessage: ' + DialogMessage + ' DialogType: ' + DbgS(DialogType) + ' ButtonCount: ' + DbgS(ButtonCount) + ' DefaultIndex: ' + DbgS(DefaultIndex) + ' EscapeResult: ' + DbgS(EscapeResult)); {$ENDIF} Result := -1; AnAlert := NSAlert.alloc.init; try cancelAccessory := nil; informativeText := NSStringUtf8(DialogMessage); messageText := NSStringUtf8(DialogCaption); case DialogType of idDialogWarning, idDialogError : anAlert.setAlertStyle(NSCriticalAlertStyle); idDialogInfo : anAlert.setAlertStyle(NSInformationalAlertStyle); end; try anAlert.setInformativeText(informativeText); anAlert.setMessageText(messageText); needsCancel := True; for I := 0 to ButtonCount - 1 do begin if Buttons[I] = idButtonHelp then begin anAlert.setShowsHelp(true) {$IFDEF VerboseLCLIntf} DebugLn('TCocoaWidgetSet.PromptUser Warning: Help button is shown but ignored'); {$ENDIF} end else begin if (Buttons[I] < Low(BUTTON_CAPTION_ARRAY)) or (Buttons[I] > High(BUTTON_CAPTION_ARRAY)) then begin DebugLn('TCocoaWidgetSet.PromptUser Invalid button ID: ' + DbgS(Buttons[I])); Continue; end; aButton := anAlert.addButtonWithTitle(BUTTON_CAPTION_ARRAY[Buttons[I]]); aButton.setKeyEquivalentModifierMask(0); if I = DefaultIndex then aButton.setKeyEquivalent(NSSTR_KEY_ENTER) else if I = 0 then // By default, the first button is the default button. If in our // case this should not be the case, remove the default status // from the first button. aButton.setKeyEquivalent(NSSTR_EMPTY); if Buttons[I]=mrCancel then begin needsCancel := False; aButton.setKeyEquivalent(NSSTR_KEY_ESC); end; aButton.setTag(Buttons[I]); end; end; if needsCancel then begin cancelAccessory := TCocoaAlertCancelAccessoryView.alloc.init; cancelAccessory.sheetOfWindow := sheetOfWindow; cancelAccessory.setBounds(NSZeroRect); anAlert.setAccessoryView(cancelAccessory); end; ApplicationWillShowModal; if Assigned(sheetOfWindow) then begin if not (modalSheet) then begin anAlert.beginSheetModalForWindow_modalDelegate_didEndSelector_contextInfo( sheetOfWindow, nil, nil, nil ); Result := 0; end else Result := RunSheetAsModal(anAlert, sheetOfWindow); end else begin isMenuOn := ToggleAppMenu(false); try Result := AnAlert.runModal; if Result = NSCancelButton then Result := EscapeResult; finally ToggleAppMenu(isMenuOn); // modal menu doesn't have a window, disabling it end; end; finally if Assigned(cancelAccessory) then cancelAccessory.release; informativeText.release; messageText.release; end; finally AnAlert.release; end; {$IFDEF VerboseLCLIntf} DebugLn('TCocoaWidgetSet.PromptUser Result: ' + DbgS(Result)); {$ENDIF} end; {TCocoaWidgetSet.PromptUser} { TCocoaAlertCancelAccessoryView } function TCocoaAlertCancelAccessoryView.performKeyEquivalent(theEvent: NSEvent): LCLObjCBoolean; begin if theEvent.keyCode = kVK_Escape then begin if Assigned(sheetOfWindow) then NSApplication(NSApp).endSheet(window) // use "sheetOfWindow.endSheet(window)" on 10.9+ else NSApplication(NSApp).stopModalWithCode(NSCancelButton); Result := True; end else Result := inherited performKeyEquivalent(theEvent); end; {------------------------------------------------------------------------------ Method: PromptUser Params: DialogCaption - Dialog caption DialogMessage - Dialog message text DialogType - Type of dialog Buttons - Pointer to button types ButtonCount - Count of passed buttons DefaultIndex - Index of default button EscapeResult - Result value of escape Returns: The result value of pushed button Shows modal dialog with the specified caption, message and buttons and prompts user to push one. ------------------------------------------------------------------------------} function TCocoaWidgetSet.PromptUser(const DialogCaption, DialogMessage: String; DialogType: longint; Buttons: PLongint; ButtonCount, DefaultIndex, EscapeResult: Longint): Longint; begin Result := CocoaPromptUser(DialogCaption, DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult); end; {TCocoaWidgetSet.PromptUser} {------------------------------------------------------------------------------ Method: MessageBox ------------------------------------------------------------------------------} function TCocoaWidgetSet.MessageBox(HWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): Integer; var DialogType : LongInt; ButtonsArray : array[0..3] of LongInt; ButtonsCount : LongInt; DefButtonIndex: LongInt; SheetWnd : NSWindow; begin FillChar(ButtonsArray, SizeOf(ButtonsArray), 0); if (uType and MB_RETRYCANCEL) = MB_RETRYCANCEL then begin ButtonsCount := 2; ButtonsArray[0] := idButtonRetry; ButtonsArray[1] := idButtonCancel; end else if (uType and MB_YESNO) = MB_YESNO then begin ButtonsCount := 2; ButtonsArray[0] := idButtonYes; ButtonsArray[1] := idButtonNo; end else if (uType and MB_YESNOCANCEL) = MB_YESNOCANCEL then begin ButtonsCount := 3; ButtonsArray[0] := idButtonYes; ButtonsArray[1] := idButtonNo; ButtonsArray[2] := idButtonCancel; end else if (uType and MB_ABORTRETRYIGNORE) = MB_ABORTRETRYIGNORE then begin ButtonsCount := 3; ButtonsArray[0] := idButtonAbort; ButtonsArray[1] := idButtonRetry; ButtonsArray[2] := idButtonIgnore; end else if (uType and MB_OKCANCEL) = MB_OKCANCEL then begin ButtonsCount := 2; ButtonsArray[0] := idButtonOk; ButtonsArray[1] := idButtonCancel; end else begin ButtonsCount := 1; ButtonsArray[0] := idButtonOk; end; if (uType and MB_ICONINFORMATION) = MB_ICONINFORMATION then DialogType := idDialogInfo else if (uType and MB_ICONWARNING) = MB_ICONWARNING then DialogType := idDialogWarning else if (uType and MB_ICONQUESTION) = MB_ICONQUESTION then DialogType := idDialogConfirm else if (uType and MB_ICONERROR) = MB_ICONERROR then DialogType := idDialogError else DialogType := idDialogInfo; if (uType and MB_DEFBUTTON2) = MB_DEFBUTTON2 then DefButtonIndex := Pred(2) else if (uType and MB_DEFBUTTON3) = MB_DEFBUTTON3 then DefButtonIndex := Pred(3) else if (uType and MB_DEFBUTTON4) = MB_DEFBUTTON4 then DefButtonIndex := Pred(4) else DefButtonIndex := Pred(1); if HWnd = 0 then SheetWnd := Nil else SheetWnd := NSView(HWnd).window(); Result := CocoaPromptUser( string(lpCaption), string(lpText), DialogType, @ButtonsArray, ButtonsCount, DefButtonIndex, 0 {EscapeResult}, SheetWnd, true); case Result of idButtonOk : Result := IDOK; idButtonNo : Result := IDNO; idButtonYes : Result := IDYES; idButtonCancel : Result := IDCANCEL; idButtonRetry : Result := IDRETRY; idButtonAbort : Result := IDABORT; idButtonIgnore : Result := IDIGNORE; else Result := IDCANCEL; end; end; {------------------------------------------------------------------------------ Function: RawImage_CreateBitmaps Params: ARawImage: Source raw image ABitmap: Destination bitmap object AMask: Destination mask object ASkipMask: When set, no mask is created Returns: ------------------------------------------------------------------------------} function TCocoaWidgetSet.RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean): Boolean; const ALIGNMAP: array[TRawImageLineEnd] of TCocoaBitmapAlignment = (cbaByte, cbaByte, cbaWord, cbaDWord, cbaQWord, cbaDQWord); var ADesc: TRawImageDescription absolute ARawImage.Description; bmpType: TCocoaBitmapType; begin Result := RawImage_DescriptionToBitmapType(ADesc, bmpType); if not Result then begin debugln(['TCocoaWidgetSet.RawImage_CreateBitmaps TODO Depth=',ADesc.Depth,' alphaprec=',ADesc.AlphaPrec,' byteorder=',ord(ADesc.ByteOrder),' alpha=',ADesc.AlphaShift,' red=',ADesc.RedShift,' green=',adesc.GreenShift,' blue=',adesc.BlueShift]); exit; end; ABitmap := HBITMAP(TCocoaBitmap.Create(ADesc.Width, ADesc.Height, ADesc.Depth, ADesc.BitsPerPixel, ALIGNMAP[ADesc.LineEnd], bmpType, ARawImage.Data)); if ASkipMask or (ADesc.MaskBitsPerPixel = 0) then AMask := 0 else AMask := HBITMAP(TCocoaBitmap.Create(ADesc.Width, ADesc.Height, 1, ADesc.MaskBitsPerPixel, ALIGNMAP[ADesc.MaskLineEnd], cbtMask, ARawImage.Mask)); Result := True; end; {------------------------------------------------------------------------------ Function: RawImage_DescriptionFromBitmap Params: ABitmap: ADesc: Returns: Describes the inner format utilized by Cocoa and specific information for the specified bitmap ------------------------------------------------------------------------------} function TCocoaWidgetSet.RawImage_DescriptionFromBitmap(ABitmap: HBITMAP; out ADesc: TRawImageDescription): Boolean; begin if CheckBitmap(ABitmap, 'RawImage_DescriptionFromBitmap') then Result := RawImage_DescriptionFromCocoaBitmap(ADesc, TCocoaBitmap(ABitmap)) else Result := False; end; {------------------------------------------------------------------------------ Function: RawImage_DescriptionFromDevice Params: ADC: - Handle to device context ADesc: - Pointer to raw image description Returns: True if success Retrieves the standard image format utilized by Cocoa ------------------------------------------------------------------------------} function TCocoaWidgetSet.RawImage_DescriptionFromDevice(ADC: HDC; out ADesc: TRawImageDescription): Boolean; begin Result := False; FillStandardDescription(ADesc); if (ADC <> 0) and CheckDC(ADC, 'RawImage_DescriptionFromDevice') then begin with TCocoaContext(ADC).Size do begin ADesc.Width := cx; ADesc.Height := cy; end; end; Result := True; end; {------------------------------------------------------------------------------ Function: RawImage_FromBitmap Params: ARawImage: Image to create ABitmap: Source bitmap AMask: Source mask ARect: Source rect (TODO) Returns: True if the function succeeds Creates a raw image from the specified bitmap ------------------------------------------------------------------------------} function TCocoaWidgetSet.RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; ARect: PRect = nil): Boolean; begin if CheckBitmap(ABitmap, 'RawImage_FromBitmap') and ((AMask = 0) or CheckBitmap(AMask, 'RawImage_FromBitmap (mask)')) then Result := RawImage_FromCocoaBitmap(ARawImage, TCocoaBitmap(ABitmap), TCocoaBitmap(AMask), ARect) else Result := False; end; {------------------------------------------------------------------------------ Method: TCocoaWidgetSet.GetImagePixelData Used by RawImage_FromDevice. Copies the data from a CGImageRef into a local buffer. The buffer is created using GetMem, and the caller is responsible for using FreeMem to free the returned pointer. This function throws exceptions in case of errors and may return a nil pointer. ------------------------------------------------------------------------------} function TCocoaWidgetSet.GetImagePixelData(AImage: CGImageRef; out bitmapByteCount: PtrUInt): Pointer; var bitmapData: Pointer; context: CGContextRef = nil; colorSpace: CGColorSpaceRef; bitmapBytesPerRow, pixelsWide, pixelsHigh: PtrUInt; imageRect: CGRect; begin Result := nil; // Get image width, height. The entire image is used. pixelsWide := CGImageGetWidth(AImage); pixelsHigh := CGImageGetHeight(AImage); imageRect.origin.x := 0.0; imageRect.origin.y := 0.0; imageRect.size.width := pixelsWide; imageRect.size.height := pixelsHigh; // The target format is fixed in ARGB, DQWord alignment, with 32-bits depth and // 8-bits per channel, the default image format on the LCL bitmapBytesPerRow := ((pixelsWide * 4) + $F) and not PtrUInt($F); bitmapByteCount := (bitmapBytesPerRow * pixelsHigh); // Use the generic RGB color space. colorSpace := CGColorSpaceCreateWithName(kCGColorSpaceGenericRGB); if (colorSpace = nil) then raise Exception.Create('Unable to create CGColorSpaceRef'); // Allocate memory for image data. This is the destination in memory // where any drawing to the bitmap context will be rendered. bitmapData := System.GetMem( bitmapByteCount ); if (bitmapData = nil) then raise Exception.Create('Unable to allocate memory'); { Creates the bitmap context. Regardless of what the source image format is, it will be converted over to the format specified here by CGBitmapContextCreate. } context := CGBitmapContextCreate(bitmapData, pixelsWide, pixelsHigh, 8, // bits per component bitmapBytesPerRow, colorSpace, kCGImageAlphaNoneSkipFirst); // The function fails with kCGImageAlphaFirst if (context = nil) then begin System.FreeMem(bitmapData); raise Exception.Create('Unable to create CGContextRef'); end; // Draw the image to the bitmap context. Once we draw, the memory // allocated for the context for rendering will then contain the // raw image data in the specified color space. CGContextDrawImage(context, imageRect, AImage); // Now we can get a pointer to the image data associated with the context. // ToDo: Verify if we should copy this data to a new buffer Result := CGBitmapContextGetData(context); { Clean-up } CGColorSpaceRelease(colorSpace); CGContextRelease(context); end; {------------------------------------------------------------------------------ Function: RawImage_FromDevice Params: ARawImage: Image to create ADC: Source dc ARect: Source rect (TODO) This function is utilized when the function TBitmap.LoadFromDevice is called The main use for this function is to get a screenshot. MWE: exept for the desktop, there is always a bitmep selected in the DC. So get this internal bitmap and pass it to RawImage_FromBitmap The ScreenShot getting code uses OpenGL to get a CGImageRef. The only way to access the bytes of a CGImageRef is by drawing it to a canvas and then reading the data from the canvas. In doing it we can choose the pixel format for the canvas, so we choose a convenient one: ARGB, 32-bits depth, just like the standard image description. See also: Technical Q&A QA1509 - Getting the pixel data from a CGImage object http://developer.apple.com/qa/qa2007/qa1509.html ------------------------------------------------------------------------------} var _CGDisplayCreateImage : function ( displayID: CGDirectDisplayID ): CGImageRef; cdecl = nil; function CGDisplayCreateImageNone( displayID: CGDirectDisplayID ): CGImageRef; cdecl; begin Result := nil; end; function TCocoaWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean; var CBC: TCocoaBitmapContext absolute ADC; displayID: CGDirectDisplayID; ScreenImage: CGImageRef; begin Result := False; // Verifies if we are getting the rawimage from a normal DC as opposed to a // desktop DC if CheckDC(ADC, 'RawImage_FromDevice') and (CBC is TCocoaBitmapContext) then begin Result := RawImage_FromCocoaBitmap(ARawImage, CBC.Bitmap, nil, @ARect); Exit; end; { Screenshot taking code starts here } { Get's a screenshot } displayID := CGMainDisplayID(); if not Assigned(Pointer(_CGDisplayCreateImage)) then begin Pointer(_CGDisplayCreateImage) := GetProcAddress(TLibHandle(RTLD_DEFAULT), 'CGDisplayCreateImage'); if not Assigned(@_CGDisplayCreateImage) then Pointer(_CGDisplayCreateImage) := @CGDisplayCreateImageNone; end; ScreenImage := _CGDisplayCreateImage(displayID); { Fills the image description } ARawImage.Init; FillStandardDescription(ARawImage.Description); if Assigned(ScreenImage) then begin ARawImage.Description.Height := CGImageGetHeight(ScreenImage); ARawImage.Description.Width := CGImageGetWidth(ScreenImage); ARawImage.Data := GetImagePixelData(ScreenImage, ARawImage.DataSize); end; ARawImage.Mask := nil; { Copies the image data to a local buffer } { clean-up } CGImageRelease(ScreenImage); Result := True; end; procedure TCocoaWidgetSet.SetCanvasScaleFactor(DC: HDC; const AScaleRatio: double); var ctx: TCocoaContext; begin ctx := CheckDC(DC); if Assigned(ctx) and (ctx is TCocoaBitmapContext) then CGContextScaleCTM(ctx.CGContext, AScaleRatio, AScaleRatio); end; {------------------------------------------------------------------------------ Function: RawImage_QueryDescription Params: AFlags: ADesc: Returns: ------------------------------------------------------------------------------} //function TCarbonWidgetSet.RawImage_QueryDescription(AFlags: TRawImageQueryFlags; var ADesc: TRawImageDescription): Boolean; //begin // // override only when queried formats are different from screen description //end; (* {------------------------------------------------------------------------------ Method: ReleaseDesignerDC Params: Window - handle of window DC - handle of designer device context Returns: 1 if the device context was released or 0 if it wasn't Releases a designer device context (DC) ------------------------------------------------------------------------------} function TCarbonWidgetSet.ReleaseDesignerDC(Window: HWND; DC: HDC): Integer; begin Result := 0; {$IFDEF VerboseLCLIntf} DebugLn('TCarbonWidgetSet.ReleaseDesignerDC Handle: ' + DbgS(Window)); {$ENDIF} if not CheckWidget(Window, 'ReleaseDesignerDC', TCarbonDesignWindow) then Exit; TCarbonDesignWindow(Window).ReleaseDesignContext; Result := 1; end; {------------------------------------------------------------------------------ Method: SetMainMenuEnabled Params: AEnabled Enables/disables main menu ------------------------------------------------------------------------------} procedure TCarbonWidgetSet.SetMainMenuEnabled(AEnabled: Boolean); begin {$IFDEF VerboseLCLIntf} DebugLn('TCarbonWidgetSet.SetMainMenuEnabled AEnabled: ' + DbgS(AEnabled)); {$ENDIF} fMenuEnabled:=AEnabled; if FMainMenu <> 0 then begin if csDesigning in TCarbonMenu(FMainMenu).LCLMenuItem.ComponentState then Exit; TCarbonMenu(FMainMenu).SetEnable(AEnabled); end; end; {------------------------------------------------------------------------------ Method: TCarbonWidgetSet.SetRootMenu Params: AMenu - Main menu Sets the menu to menu bar ------------------------------------------------------------------------------} procedure TCarbonWidgetSet.SetRootMenu(const AMenu: HMENU); begin {$IFDEF VerboseLCLIntf} DebugLn('TCarbonWidgetSet.SetRootMenu AMenu: ' + DbgS(AMenu)); {$ENDIF} if (AMenu <> 0) and CheckMenu(AMenu, 'SetRootMenu') and not (csDesigning in TCarbonMenu(AMenu).LCLMenuItem.ComponentState) then begin TCarbonMenu(AMenu).AttachToMenuBar; FMainMenu := AMenu; SetMainMenuEnabled(MenuEnabled); end; end; {------------------------------------------------------------------------------ Method: SetCaptureWidget Params: AWidget - Carbon widget to capture Sets captured Carbon widget ------------------------------------------------------------------------------} procedure TCarbonWidgetSet.SetCaptureWidget(const AWidget: HWND); begin {$IFDEF VerboseLCLIntf} DebugLn('TCarbonWidgetSet.SetCaptureWidget AWidget: ' + DbgS(AWidget)); {$ENDIF} if AWidget <> FCaptureWidget then begin FCaptureWidget := AWidget; if FCaptureWidget <> 0 then LCLSendCaptureChangedMsg(TCarbonWidget(FCaptureWidget).LCLObject); end; end; {------------------------------------------------------------------------------ Method: SetTextFractional Params: ACanvas - LCL Canvas Sets canvas text fractional enabled ------------------------------------------------------------------------------} procedure TCarbonWidgetSet.SetTextFractional(ACanvas: TCanvas; AEnabled: Boolean); begin {$IFDEF VerboseLCLIntf} DebugLn('TCarbonWidgetSet.SetTextFractional ACanvas: ' + DbgS(ACanvas) + ' AEnabled: ' + DbgS(AEnabled)); {$ENDIF} if not CheckDC(ACanvas.Handle, 'SetTextFractional') then Exit; TCarbonDeviceContext(ACanvas.Handle).TextFractional := AEnabled; end; *)