rgbgraphics: Add qt6 and cocoa support.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9315 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/rgbgraphics/source/rgbcocoaroutines.pas

@@ -0,0 +1,78 @@
+{
+ /***************************************************************************
+                                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.
+

components/rgbgraphics/source/rgbqt5routines.pas

@@ -31,7 +31,7 @@ unit RGBQt5Routines;
 interface
 
 uses
-  SysUtils, Types, LCLType, Qt5, QtObjects, Classes,
+  SysUtils, Types, LCLType, Qt5, Qt5Objects, Classes,
   RGBTypes;
   
   procedure WidgetSetDrawRGB32Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer;

components/rgbgraphics/source/rgbqt6routines.pas

@@ -0,0 +1,97 @@
+{
+ /***************************************************************************
+                                RGBQt6Routines.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 Qt interface.
+
+}
+unit RGBQt6Routines;
+
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+  SysUtils, Types, LCLType, Qt6, Qt6Objects, Classes,
+  RGBTypes;
+  
+  procedure WidgetSetDrawRGB32Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer;
+    Bitmap: TRGB32BitmapCore);
+  procedure WidgetSetStretchDrawRGB32Bitmap(Dest: HDC; DstX, DstY, DstWidth, DstHeight: 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);
+begin
+  WidgetSetStretchDrawRGB32Bitmap(Dest, DstX, DstY, SrcWidth, SrcHeight, SrcX, SrcY, SrcWidth, SrcHeight, Bitmap);
+end;
+
+procedure WidgetSetStretchDrawRGB32Bitmap(Dest: HDC; DstX, DstY, DstWidth,
+  DstHeight: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer;
+  Bitmap: TRGB32BitmapCore);
+var
+  DstQDC: TQtDeviceContext absolute Dest;
+  SrcRect, DstRect: TRect;
+  Image: TQtImage;
+begin
+  DstRect := Bounds(DstX, DstY, DstWidth, DstHeight);
+  SrcRect := Bounds(SrcX, SrcY, SrcWidth, SrcHeight);
+  
+  Image := TQtImage.Create(Bitmap.Pixels, Bitmap.Width, Bitmap.Height, QImageFormat_RGB32);
+  try
+    QPainter_drawImage(DstQDC.Widget, PRect(@DstRect), Image.Handle, @SrcRect, QtAutoColor);
+  finally
+    Image.Free;
+  end;
+end;
+
+procedure WidgetSetDrawRGB8Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY,
+  SrcWidth, SrcHeight: Integer; Bitmap: TRGB8BitmapCore);
+var
+  DstQDC: TQtDeviceContext absolute Dest;
+  SrcRect, DstRect: TRect;
+  Image: TQtImage;
+  I: Integer;
+begin
+  DstRect := Bounds(DstX, DstY, SrcWidth, SrcHeight);
+  SrcRect := Bounds(SrcX, SrcY, SrcWidth, SrcHeight);
+
+  Image := TQtImage.Create(Bitmap.Pixels, Bitmap.Width, Bitmap.Height, QImageFormat_Indexed8);
+  try
+    // initialize palette
+    for I := 0 to 255 do
+      QImage_setColor(Image.Handle, I, I + I shl 8 + I shl 16 + $FF shl 24);
+    
+    QPainter_drawImage(DstQDC.Widget, PRect(@DstRect), Image.Handle, @SrcRect, QtAutoColor);
+  finally
+    Image.Free;
+  end;
+end;
+
+
+end.
+

components/rgbgraphics/source/rgbroutines.pas

@@ -36,7 +36,7 @@ uses
   SysUtils, Math, Forms, LCLIntf,
   LCLType, LCLProc, FPImage, IntfGraphics,
   Classes,
-{$IFDEF LCLwin32}
+{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
   RGBWinRoutines,
 {$ENDIF}
 {$IFDEF LCLqt}
@@ -45,6 +45,9 @@ uses
 {$IFDEF LCLqt5}
   RGBQt5Routines,
 {$ENDIF}
+{$IFDEF LCLqt6}
+  RGBQt6Routines,
+{$ENDIF}
 {$IFDEF LCLgtk}
   {$DEFINE StretchRGB32}
   RGBGTKRoutines,
@@ -60,6 +63,10 @@ uses
 {$IFDEF LCLcarbon}
   {$DEFINE StretchRGB32}
   RGBCarbonRoutines,
+{$ENDIF}
+{$IFDEF LCLCocoa}
+  {$DEFINE StretchRGB32}
+  RGBCocoaRoutines,
 {$ENDIF}
   RGBTypes, RGBUtils;
   

components/rgbgraphics/source/rgbtypes.pas

@@ -30,16 +30,22 @@ unit RGBTypes;
   {$mode objfpc}{$H+}
 {$endif}
 
-{$ifdef LCLwin32}
+{$if defined(LCLwin32) or defined(LCLwin64)}
   {$define RGB}
 {$endif}
+
 {$ifdef LCLqt}
   {$define RGB}
 {$endif}
+
 {$ifdef LCLqt5}
   {$define RGB}
 {$endif}
 
+{$ifdef LCLqt6}
+  {$define RGB}
+{$endif}
+
 interface
 
 uses