- implementation for Carbon interface

- fix compilation after graphics rewrite - improved example application git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@251 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2007-09-02 15:12:14 +00:00
parent 1be18f4bcc
commit 4ee0dd740f
12 changed files with 1094 additions and 638 deletions
--- a/components/rgbgraphics/rgbcarbonroutines.pas
+++ b/components/rgbgraphics/rgbcarbonroutines.pas
@@ -0,0 +1,86 @@
+{
+ /***************************************************************************
+                                RGBGTKRoutines.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 GTK interfaces.
+
+}
+unit RGBCarbonRoutines;
+
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+  SysUtils, Classes, LCLType,
+  FPCMacOSAll, CarbonProc, CarbonGDIObjects, CarbonCanvas,
+  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
+  CGImage: CGImageRef;
+  CarbonBitmap: TCarbonBitmap;
+begin
+  if not CheckDC(Dest, 'WidgetSetDrawRGB32Bitmap') then Exit;
+
+  CarbonBitmap := TCarbonBitmap.Create(Bitmap.Width, Bitmap.Height, 24, 32, cbaDWord, cbtRGB, Bitmap.Pixels, False);
+  try
+    CGImage := CarbonBitmap.CreateSubImage(Bounds(SrcX, SrcY, SrcWidth, SrcHeight));
+
+    TCarbonDeviceContext(Dest).DrawCGImage(DstX, DstY, SrcWidth, SrcHeight, CGImage);
+    CGImageRelease(CGImage);
+  finally
+    CarbonBitmap.Free;
+  end;
+end;
+
+procedure WidgetSetDrawRGB8Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY,
+  SrcWidth, SrcHeight: Integer; Bitmap: TRGB8BitmapCore);
+var
+  CGImage: CGImageRef;
+  CarbonBitmap: TCarbonBitmap;
+begin
+  if not CheckDC(Dest, 'WidgetSetDrawRGB8Bitmap') then Exit;
+
+  CarbonBitmap := TCarbonBitmap.Create(Bitmap.Width, Bitmap.Height, 8, 8, cbaDWord, cbtGray, Bitmap.Pixels, False);
+  try
+    CGImage := CarbonBitmap.CreateSubImage(Bounds(SrcX, SrcY, SrcWidth, SrcHeight));
+
+    TCarbonDeviceContext(Dest).DrawCGImage(DstX, DstY, SrcWidth, SrcHeight, CGImage);
+    CGImageRelease(CGImage);
+  finally
+    CarbonBitmap.Free;
+  end;
+end;
+
+
+end.
+