paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

rgbgraphics: Add qt6 and cocoa support.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9315 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-04-03 16:49:30 +00:00
parent 7b6eeafcb3
commit 674eeaed6d
5 changed files with 194 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
components/rgbgraphics/source/rgbcocoaroutines.pas Normal file
View File

@ -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.

2
components/rgbgraphics/source/rgbqt5routines.pas
View File

@ -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;

97
components/rgbgraphics/source/rgbqt6routines.pas Normal file
View File

@ -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.

9
components/rgbgraphics/source/rgbroutines.pas
View File

@ -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;

14
components/rgbgraphics/source/rgbtypes.pas
View File

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