{ /*************************************************************************** RGBCarbonRoutines.pas ***************************************************************************/ ***************************************************************************** * * * See the file COPYING.modifiedLGPL, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** Author: Tom Gregorovic (_tom_@centrum.cz) Abstract: This unit contains routines for Carbon interface. } unit RGBCocoaRoutines; {$ifdef fpc} {$mode objfpc}{$H+} {$endif} interface uses SysUtils, Classes, LCLType, MacOSAll, CocoaGDIObjects, RGBTypes, RGBUtils; procedure WidgetSetDrawRGB32Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer; Bitmap: TRGB32BitmapCore); procedure WidgetSetDrawRGB8Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer; Bitmap: TRGB8BitmapCore); implementation procedure WidgetSetDrawRGB32Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer; Bitmap: TRGB32BitmapCore); var xBitmap: TCocoaBitmap; begin if not CheckDC(Dest, 'WidgetSetDrawRGB32Bitmap') then Exit; xBitmap := TCocoaBitmap.Create(Bitmap.Width, Bitmap.Height, 24, 32, cbaDWord, cbtRGB, Bitmap.Pixels, False); try TCocoaContext(Dest).DrawBitmap(DstX, DstY, xBitmap); finally xBitmap.Free; end; end; procedure WidgetSetDrawRGB8Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer; Bitmap: TRGB8BitmapCore); var xBitmap: TCocoaBitmap; begin if not CheckDC(Dest, 'WidgetSetDrawRGB8Bitmap') then Exit; xBitmap := TCocoaBitmap.Create(Bitmap.Width, Bitmap.Height, 8, 8, cbaDWord, cbtGray, Bitmap.Pixels, False); try TCocoaContext(Dest).DrawBitMap(DstX, DstY, xBitMap); finally xBitmap.Free; end; end; end.