diff --git a/components/rgbgraphics/example/rgbexample.lpi b/components/rgbgraphics/example/rgbexample.lpi
index 993a16ebf..ab6de17a2 100644
--- a/components/rgbgraphics/example/rgbexample.lpi
+++ b/components/rgbgraphics/example/rgbexample.lpi
@@ -5,17 +5,16 @@
-
+
-
+
-
-
+
@@ -23,23 +22,25 @@
-
+
-
+
-
+
-
+
-
+
+
+
@@ -47,20 +48,18 @@
-
-
+
+
-
+
-
-
-
+
+
-
@@ -71,31 +70,263 @@
-
-
-
+
+
+
-
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -103,9 +334,7 @@
-
-
-
+
diff --git a/components/rgbgraphics/example/rgbunit.lfm b/components/rgbgraphics/example/rgbunit.lfm
index a13d00933..a0d552d35 100644
--- a/components/rgbgraphics/example/rgbunit.lfm
+++ b/components/rgbgraphics/example/rgbunit.lfm
@@ -1,56 +1,64 @@
object FormExample: TFormExample
+ Left = 267
+ Height = 514
+ Top = 150
+ Width = 645
+ HorzScrollBar.Page = 644
+ VertScrollBar.Page = 513
ActiveControl = ButtonRedLine
Caption = 'LazRGBGraphics Example'
- ClientHeight = 443
- ClientWidth = 575
+ ClientHeight = 514
+ ClientWidth = 645
OnCreate = FormCreate
OnDestroy = FormDestroy
OnPaint = FormPaint
- PixelsPerInch = 96
- HorzScrollBar.Page = 574
- VertScrollBar.Page = 442
- Left = 301
- Height = 443
- Top = 155
- Width = 575
object ButtonRedLine: TButton
+ Left = 6
+ Height = 26
+ Top = 8
+ Width = 89
+ AutoSize = True
BorderSpacing.InnerBorder = 4
Caption = 'Draw red line'
OnClick = ButtonRedLineClick
TabOrder = 0
- Left = 6
- Height = 25
- Top = 8
- Width = 126
end
object ButtonRotate90: TButton
+ Left = 6
+ Height = 26
+ Top = 39
+ Width = 131
+ AutoSize = True
BorderSpacing.InnerBorder = 4
- Caption = 'Rotate 90° clockwise'
+ Caption = 'Rotate 90 clockwise'
OnClick = ButtonRotate90Click
TabOrder = 1
- Left = 6
- Height = 25
- Top = 39
- Width = 126
end
object ButtonInvert: TButton
+ Left = 6
+ Height = 26
+ Top = 72
+ Width = 83
+ AutoSize = True
BorderSpacing.InnerBorder = 4
Caption = 'Invert colors'
OnClick = ButtonInvertClick
TabOrder = 2
- Left = 6
- Height = 25
- Top = 72
- Width = 126
end
object ButtonReplace: TButton
+ Left = 6
+ Height = 26
+ Top = 106
+ Width = 136
+ AutoSize = True
BorderSpacing.InnerBorder = 4
- Caption = 'Replace white with blue'
+ Caption = 'Replace red with blue'
OnClick = ButtonReplaceClick
TabOrder = 3
- Left = 6
- Height = 25
- Top = 106
- Width = 126
+ end
+ object OpenPictureDialog: TOpenPictureDialog
+ Title = 'Open picture'
+ left = 211
+ top = 81
end
end
diff --git a/components/rgbgraphics/example/rgbunit.lrs b/components/rgbgraphics/example/rgbunit.lrs
index 45e656205..8c0a2a822 100644
--- a/components/rgbgraphics/example/rgbunit.lrs
+++ b/components/rgbgraphics/example/rgbunit.lrs
@@ -1,19 +1,23 @@
+{ This is an automatically generated lazarus resource file }
+
LazarusResources.Add('TFormExample','FORMDATA',[
- 'TPF0'#12'TFormExample'#11'FormExample'#13'ActiveControl'#7#13'ButtonRedLine'
- +#7'Caption'#6#22'LazRGBGraphics Example'#12'ClientHeight'#3#187#1#11'ClientW'
- +'idth'#3'?'#2#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#7
- +'OnPaint'#7#9'FormPaint'#13'PixelsPerInch'#2'`'#18'HorzScrollBar.Page'#3'>'#2
- +#18'VertScrollBar.Page'#3#186#1#4'Left'#3'-'#1#6'Height'#3#187#1#3'Top'#3#155
- +#0#5'Width'#3'?'#2#0#7'TButton'#13'ButtonRedLine'#25'BorderSpacing.InnerBord'
- +'er'#2#4#7'Caption'#6#13'Draw red line'#7'OnClick'#7#18'ButtonRedLineClick'#8
- +'TabOrder'#2#0#4'Left'#2#6#6'Height'#2#25#3'Top'#2#8#5'Width'#2'~'#0#0#7'TBu'
- +'tton'#14'ButtonRotate90'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#20
- +'Rotate 90'#176' clockwise'#7'OnClick'#7#19'ButtonRotate90Click'#8'TabOrder'
- +#2#1#4'Left'#2#6#6'Height'#2#25#3'Top'#2''''#5'Width'#2'~'#0#0#7'TButton'#12
- +'ButtonInvert'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#13'Invert colo'
- +'rs'#7'OnClick'#7#17'ButtonInvertClick'#8'TabOrder'#2#2#4'Left'#2#6#6'Height'
- +#2#25#3'Top'#2'H'#5'Width'#2'~'#0#0#7'TButton'#13'ButtonReplace'#25'BorderSp'
- +'acing.InnerBorder'#2#4#7'Caption'#6#23'Replace white with blue'#7'OnClick'#7
- +#18'ButtonReplaceClick'#8'TabOrder'#2#3#4'Left'#2#6#6'Height'#2#25#3'Top'#2
- +'j'#5'Width'#2'~'#0#0#0
+ 'TPF0'#12'TFormExample'#11'FormExample'#4'Left'#3#11#1#6'Height'#3#2#2#3'Top'
+ +#3#150#0#5'Width'#3#133#2#18'HorzScrollBar.Page'#3#132#2#18'VertScrollBar.Pa'
+ +'ge'#3#1#2#13'ActiveControl'#7#13'ButtonRedLine'#7'Caption'#6#22'LazRGBGraph'
+ +'ics Example'#12'ClientHeight'#3#2#2#11'ClientWidth'#3#133#2#8'OnCreate'#7#10
+ +'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#7'OnPaint'#7#9'FormPaint'#0#7'TB'
+ +'utton'#13'ButtonRedLine'#4'Left'#2#6#6'Height'#2#26#3'Top'#2#8#5'Width'#2'Y'
+ +#8'AutoSize'#9#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#13'Draw red li'
+ +'ne'#7'OnClick'#7#18'ButtonRedLineClick'#8'TabOrder'#2#0#0#0#7'TButton'#14'B'
+ +'uttonRotate90'#4'Left'#2#6#6'Height'#2#26#3'Top'#2''''#5'Width'#3#131#0#8'A'
+ +'utoSize'#9#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#19'Rotate 90 cloc'
+ +'kwise'#7'OnClick'#7#19'ButtonRotate90Click'#8'TabOrder'#2#1#0#0#7'TButton'
+ +#12'ButtonInvert'#4'Left'#2#6#6'Height'#2#26#3'Top'#2'H'#5'Width'#2'S'#8'Aut'
+ +'oSize'#9#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#13'Invert colors'#7
+ +'OnClick'#7#17'ButtonInvertClick'#8'TabOrder'#2#2#0#0#7'TButton'#13'ButtonRe'
+ +'place'#4'Left'#2#6#6'Height'#2#26#3'Top'#2'j'#5'Width'#3#136#0#8'AutoSize'#9
+ +#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#21'Replace red with blue'#7
+ +'OnClick'#7#18'ButtonReplaceClick'#8'TabOrder'#2#3#0#0#18'TOpenPictureDialog'
+ +#17'OpenPictureDialog'#5'Title'#6#12'Open picture'#4'left'#3#211#0#3'top'#2
+ +'Q'#0#0#0
]);
diff --git a/components/rgbgraphics/example/rgbunit.pas b/components/rgbgraphics/example/rgbunit.pas
index c6f1c0321..7b6b0e787 100644
--- a/components/rgbgraphics/example/rgbunit.pas
+++ b/components/rgbgraphics/example/rgbunit.pas
@@ -22,13 +22,15 @@
}
unit RGBUnit;
-{$mode objfpc}{$H+}
+{$ifdef fpc}
+ {$mode objfpc}{$H+}
+{$endif}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
- RGBGraphics;
+ RGBGraphics, ExtDlgs, ExtCtrls;
type
@@ -39,6 +41,7 @@ type
ButtonInvert: TButton;
ButtonRotate90: TButton;
ButtonRedLine: TButton;
+ OpenPictureDialog: TOpenPictureDialog;
procedure ButtonInvertClick(Sender: TObject);
procedure ButtonRedLineClick(Sender: TObject);
procedure ButtonReplaceClick(Sender: TObject);
@@ -53,6 +56,7 @@ type
var
FormExample: TFormExample;
RGBBitmap: TRGB32Bitmap;
+ RGBMask: TRGBMask;
implementation
@@ -60,7 +64,31 @@ implementation
procedure TFormExample.FormCreate(Sender: TObject);
begin
- RGBBitmap := TRGB32Bitmap.CreateFromFile('splash_logo.xpm');
+ if OpenPictureDialog.Execute then
+ begin
+ RGBBitmap := TRGB32Bitmap.CreateFromFile(OpenPictureDialog.FileName);
+ end
+ else
+ begin
+ RGBBitmap := TRGB32Bitmap.Create(400, 300);
+ RGBBitmap.Canvas.DrawMode := dmFill;
+ RGBBitmap.Canvas.Fill(clBlack);
+ RGBBitmap.Canvas.FillColor := clRed;
+ RGBBitmap.Canvas.Ellipse(100, 0, 300, 200);
+ RGBBitmap.Canvas.FillColor := clGreen;
+ RGBBitmap.Canvas.Ellipse(50, 100, 250, 300);
+ RGBBitmap.Canvas.FillColor := clBlue;
+ RGBBitmap.Canvas.Ellipse(150, 100, 350, 300);
+ RGBBitmap.Canvas.FillColor := clWhite;
+ RGBBitmap.Canvas.Ellipse(150, 100, 250, 200);
+ RGBBitmap.Canvas.DrawMode := dmFillAndOutline;
+ end;
+
+
+ RGBMask := TRGBMask.Create(160, 100);
+
+ RGBMask.Clear;
+ RGBMask.Ellipse(10, 10, 150, 90);
end;
procedure TFormExample.ButtonRedLineClick(Sender: TObject);
@@ -73,13 +101,13 @@ end;
procedure TFormExample.ButtonReplaceClick(Sender: TObject);
begin
- RGBBitmap.Canvas.EraseMode := emReplace;
- RGBBitmap.Canvas.FillColor := clWhite;
+ RGBBitmap.Canvas.EraseMode := ermReplace;
+ RGBBitmap.Canvas.FillColor := clRed;
RGBBitmap.Canvas.PaperColor := clBlue;
RGBBitmap.Canvas.FillRect(0, 0, Pred(RGBBitmap.Width), Pred(RGBBitmap.Height));
- RGBBitmap.Canvas.EraseMode := emNone;
+ RGBBitmap.Canvas.EraseMode := ermNone;
Invalidate;
end;
@@ -87,6 +115,7 @@ end;
procedure TFormExample.ButtonInvertClick(Sender: TObject);
begin
RGBBitmap.Invert;
+ RGBMask.Invert;
Invalidate;
end;
@@ -94,6 +123,7 @@ end;
procedure TFormExample.ButtonRotate90Click(Sender: TObject);
begin
RGBBitmap.Rotate90;
+ RGBMask.Rotate90;
Invalidate;
end;
@@ -101,16 +131,20 @@ end;
procedure TFormExample.FormDestroy(Sender: TObject);
begin
RGBBitmap.Free;
+ RGBMask.Free;
end;
procedure TFormExample.FormPaint(Sender: TObject);
begin
if RGBBitmap = nil then Exit;
- // draw bitmap 2x smaller
- RGBBitmap.Canvas.StretchDrawTo(Canvas, 140, 10, RGBBitmap.Width div 2,
- RGBBitmap.Height div 2);
+ // draw bitmap
+ RGBBitmap.Canvas.DrawTo(Canvas, 180, 10);
+
+ RGBMask.DrawTo(Canvas, 10, 160);
+ RGBMask.DrawShapeTo(Canvas, 10, 340);
end;
+
initialization
{$I rgbunit.lrs}
diff --git a/components/rgbgraphics/lazrgbgraphics.lpk b/components/rgbgraphics/lazrgbgraphics.lpk
index b0e871d89..10684cb31 100644
--- a/components/rgbgraphics/lazrgbgraphics.lpk
+++ b/components/rgbgraphics/lazrgbgraphics.lpk
@@ -4,16 +4,23 @@
+
-
+
+
+
+
+
+
+
@@ -22,8 +29,8 @@
"/>
-
-
+
+
@@ -40,14 +47,29 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
@@ -55,6 +77,7 @@
+
diff --git a/components/rgbgraphics/rgbcarbonroutines.pas b/components/rgbgraphics/rgbcarbonroutines.pas
new file mode 100644
index 000000000..8cd9ae330
--- /dev/null
+++ 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.
+
diff --git a/components/rgbgraphics/rgbgraphics.pas b/components/rgbgraphics/rgbgraphics.pas
index cc6a3e8cc..093288d5f 100644
--- a/components/rgbgraphics/rgbgraphics.pas
+++ b/components/rgbgraphics/rgbgraphics.pas
@@ -33,7 +33,7 @@ interface
uses
Classes, SysUtils, LCLIntf,
- LCLType, LCLProc, Interfaces, FPImage, LResources, IntfGraphics,
+ LCLType, LCLProc, FPImage, LResources, IntfGraphics,
Graphics, Forms, Math, Clipbrd,
RGBTypes, RGBRoutines, RGBUtils;
@@ -120,7 +120,7 @@ type
procedure SetOutlineColor(const AValue: TColor);
procedure SetPaperColor(const AValue: TColor);
protected
- function PixelMasked(X, Y: Integer): Boolean; inline;
+ function PixelMasked(X, Y: Integer): Boolean;
function SamePixelUnsafe(X, Y: Integer; Value: TRGB32Pixel): Boolean;
function SamePixelUnmasked(X, Y: Integer; Value: TRGB32Pixel): Boolean;
@@ -224,6 +224,19 @@ type
implementation
+function AbsByte(Src: Integer): Byte; inline;
+begin
+ if Src >= 0 then Result := Src
+ else Result := -Src;
+end;
+
+function RGB32PixelDifference(A, B: TRGB32Pixel): TPixelDifference; inline;
+begin
+ Result := AbsByte(((A shr 16) and $FF) - ((B shr 16) and $FF))
+ + AbsByte(((A shr 8) and $FF) - ((B shr 8) and $FF))
+ + AbsByte((A and $FF) - (B and $FF));
+end;
+
{ TRGB32Bitmap }
constructor TRGB32Bitmap.Create(AWidth, AHeight: Integer);
@@ -257,7 +270,6 @@ begin
Image := TLazIntfImage.Create(0, 0);
Reader := GetFPImageReaderForFileExtension(ExtractFileExt(FileName)).Create;
try
- Image.GetDescriptionFromDevice(0);
Image.LoadFromFile(FileName, Reader);
CreateFromLazIntfImage(Image);
finally
@@ -345,7 +357,6 @@ begin
Image := TLazIntfImage.Create(0, 0);
Writer := GetFPImageWriterForFileExtension(ExtractFileExt(FileName)).Create;
try
- Image.GetDescriptionFromDevice(0);
inherited SaveToLazIntfImage(Image);
Image.SaveToFile(FileName, Writer);
finally
@@ -515,38 +526,38 @@ var
P: PRGB32Pixel;
begin
P := FOwner.Get32PixelPtr(X, Y);
- if P <> nil then Result := RGB32PixelToColorInline(P^)
+ if P <> nil then Result := RGB32PixelToColor(P^)
else Result := clNone;
end;
function TRGB32Canvas.GetFillColor: TColor;
begin
- Result := RGB32PixelToColorInline(FFillColor);
+ Result := RGB32PixelToColor(FFillColor);
end;
function TRGB32Canvas.GetOutlineColor: TColor;
begin
- Result := RGB32PixelToColorInline(FOutlineColor);
+ Result := RGB32PixelToColor(FOutlineColor);
end;
function TRGB32Canvas.GetPaperColor: TColor;
begin
- Result := RGB32PixelToColorInline(FPaperColor);
+ Result := RGB32PixelToColor(FPaperColor);
end;
procedure TRGB32Canvas.SetFillColor(const AValue: TColor);
begin
- FFillColor := ColorToRGB32PixelInline(AValue);
+ FFillColor := ColorToRGB32Pixel(AValue);
end;
procedure TRGB32Canvas.SetOutlineColor(const AValue: TColor);
begin
- FOutlineColor := ColorToRGB32PixelInline(AValue);
+ FOutlineColor := ColorToRGB32Pixel(AValue);
end;
procedure TRGB32Canvas.SetPaperColor(const AValue: TColor);
begin
- FPaperColor := ColorToRGB32PixelInline(AValue);
+ FPaperColor := ColorToRGB32Pixel(AValue);
end;
function TRGB32Canvas.PixelMasked(X, Y: Integer): Boolean;
@@ -565,13 +576,13 @@ end;
function TRGB32Canvas.SamePixelUnsafe(X, Y: Integer; Value: TRGB32Pixel): Boolean;
begin
- Result := PixelMasked(X, Y) and (RGB32PixelDifferenceInline(FOwner.Get32PixelPtrUnsafe(X, Y)^, Value)
+ Result := PixelMasked(X, Y) and (RGB32PixelDifference(FOwner.Get32PixelUnsafe(X, Y), Value)
<= FFloodFillTolerance);
end;
function TRGB32Canvas.SamePixelUnmasked(X, Y: Integer; Value: TRGB32Pixel): Boolean;
begin
- Result := RGB32PixelDifferenceInline(FOwner.Get32PixelPtrUnsafe(X, Y)^, Value)
+ Result := RGB32PixelDifference(FOwner.Get32PixelUnsafe(X, Y), Value)
<= FFloodFillTolerance;
end;
diff --git a/components/rgbgraphics/rgbgtkroutines.pas b/components/rgbgraphics/rgbgtkroutines.pas
new file mode 100644
index 000000000..966c55371
--- /dev/null
+++ b/components/rgbgraphics/rgbgtkroutines.pas
@@ -0,0 +1,84 @@
+{
+ /***************************************************************************
+ 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 RGBGTKRoutines;
+
+{$ifdef fpc}
+ {$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+ SysUtils, Classes, LCLType,
+{$IFDEF LCLgtk2}
+ glib2, gdk2, gtk2,
+{$ENDIF}
+{$IFDEF LCLgtk}
+ glib, gdk, gtk,
+{$ENDIF}
+ gtkDef, gtkProc,
+ 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
+ P: TPoint;
+begin
+ P := GetDCOffset(TDeviceContext(Dest));
+ Inc(DstX, P.X);
+ Inc(DstY, P.Y);
+
+ gdk_draw_rgb_32_image(TDeviceContext(Dest).Drawable, TDeviceContext(Dest).GC,
+ DstX, DstY, SrcWidth, SrcHeight, GDK_RGB_DITHER_NONE,
+ Pguchar(Bitmap.GetPixelPtrUnsafe(SrcX, SrcY)), Bitmap.RowPixelStride shl 2);
+end;
+
+procedure WidgetSetDrawRGB8Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY,
+ SrcWidth, SrcHeight: Integer; Bitmap: TRGB8BitmapCore);
+var
+ P: TPoint;
+begin
+ P := GetDCOffset(TDeviceContext(Dest));
+ Inc(DstX, P.X);
+ Inc(DstY, P.Y);
+
+ gdk_draw_gray_image(TDeviceContext(Dest).Drawable, TDeviceContext(Dest).GC,
+ DstX, DstY, SrcWidth, SrcHeight, GDK_RGB_DITHER_NONE,
+ Pguchar(Bitmap.Get8PixelPtrUnsafe(SrcX, SrcY)), Bitmap.RowPixelStride);
+end;
+
+initialization
+ gdk_rgb_init;
+
+end.
+
diff --git a/components/rgbgraphics/rgbroutines.pas b/components/rgbgraphics/rgbroutines.pas
index bff709c02..4aa17f3d2 100644
--- a/components/rgbgraphics/rgbroutines.pas
+++ b/components/rgbgraphics/rgbroutines.pas
@@ -20,7 +20,7 @@
Abstract:
This unit contains routines for manipulating rgb bitmaps (stretching,
- drawing on canvas, rotating...) and for drawing primitives (lines,
+ drawing on canvas...) and for drawing primitives (lines,
ellipses...).
}
@@ -28,42 +28,36 @@ unit RGBRoutines;
{$ifdef fpc}
{$mode objfpc}{$H+}
- {$define hasinline}
{$endif}
-{$ifndef fpc}
- {$define Windows}
-{$endif}
-
-{$ifdef win32}
- {$define Windows}
-{$endif}
-
interface
uses
SysUtils, Math, Forms, LCLIntf,
- LCLType, LCLProc, InterfaceBase, Interfaces, FPImage, IntfGraphics,
-{$IFDEF Windows}
- Windows,
-{$ELSE}
- {$IFDEF gtk2}
- glib2, gdk2, gtk2, gtkDef, gtkProc,
- {$DEFINE gtk}
- {$ELSE}
- glib, gdk, gtk, gtkDef, gtkProc,
- {$DEFINE gtk}
- {$ENDIF}
-{$ENDIF}
+ LCLType, LCLProc, FPImage, IntfGraphics,
Classes,
+{$IFDEF LCLwin32}
+ RGBWinRoutines,
+{$ENDIF}
+{$IFDEF LCLgtk}
+ {$DEFINE StretchRGB32}
+ RGBGTKRoutines,
+{$ENDIF}
+{$IFDEF LCLgtk2}
+ {$DEFINE StretchRGB32}
+ RGBGTKRoutines,
+{$ENDIF}
+{$IFDEF LCLcarbon}
+ {$DEFINE StretchRGB32}
+ RGBCarbonRoutines,
+{$ENDIF}
RGBTypes, RGBUtils;
-
procedure DrawRGB32Bitmap(Dst: TRGB32BitmapCore; X, Y: Integer; Src: TRGB32BitmapCore); overload;
procedure DrawRGB8Bitmap(Dst: TRGB8BitmapCore; X, Y: Integer; Src: TRGB8BitmapCore); overload;
procedure StretchRGB32BitmapTrunc(Dst, Src: TRGB32BitmapCore);
procedure StretchRGB8BitmapTrunc(Dst, Src: TRGB8BitmapCore);
-
+
procedure DrawRGB32Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer;
Bitmap: TRGB32BitmapCore); overload;
procedure StretchDrawRGB32Bitmap(Dest: HDC; DstX, DstY, DstWidth, DstHeight: Integer;
@@ -74,21 +68,6 @@ uses
procedure DrawRGB8Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer;
Bitmap: TRGB8BitmapCore); overload;
- procedure FlipHorzRGBBitmap(Bitmap: TRGBBitmapCore);
- procedure FlipVertRGBBitmap(Bitmap: TRGBBitmapCore);
-
- // intensity tables
- function GetIntensityFloatTable(A, B: Single): TIntensityFloatTable;
-
- // rotate clockwise
- procedure Rotate90CWRGBBitmap(Bitmap: TRGBBitmapCore);
- procedure Rotate180CWRGBBitmap(Bitmap: TRGBBitmapCore);
- procedure Rotate270CWRGBBitmap(Bitmap: TRGBBitmapCore);
-
- procedure InvertRGBBitmap(Bitmap: TRGBBitmapCore);
- procedure GrayscaleRGB32Bitmap(Bitmap: TRGB32BitmapCore);
- procedure DisableRGB32Bitmap(Bitmap: TRGB32BitmapCore);
-
type
TDrawPixelProcedure = procedure (X, Y: Integer) of Object;
TGetPixelFunction = function (X, Y: Integer): TRGB32Pixel of Object;
@@ -97,7 +76,6 @@ type
procedure LineBresenham(X1, Y1, X2, Y2: Integer; DrawPixel: TDrawPixelProcedure);
procedure FillPixelRect(X1, Y1, X2, Y2: Integer; DrawPixel: TDrawPixelProcedure);
- procedure FillPixelRow(X1, X2, Y: Integer; DrawPixel: TDrawPixelProcedure); {$ifdef hasinline}inline;{$endif}
procedure NormalRectangle(X1, Y1, X2, Y2: Integer;
DrawOutlinePixel, DrawFillPixel: TDrawPixelProcedure);
@@ -410,7 +388,7 @@ procedure StretchRGB32BitmapTrunc(Dst: TRGB32BitmapCore;
var
Cols: TIntArray;
Rows: TIntArray;
- X, Y, PX, TX, OX, PY, TY, OY: Integer;
+ X, Y: Integer;
SX, SY, DX, DY: Integer;
I, J, C: Integer;
PD, PS, PDLine, PSLine: PRGB32Pixel;
@@ -539,17 +517,11 @@ procedure DrawRGB32Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth,
Bitmap: TRGB32BitmapCore);
var
Clip: TRect;
-{$IFDEF Win32}
- Info: BITMAPINFO;
-{$ENDIF}
-{$IFDEF gtk}
- P: TPoint;
-{$ENDIF}
begin
if (Bitmap = nil) or (Bitmap.Pixels = nil) then Exit;
if (Bitmap.Width <= 0) or (Bitmap.Height <= 0) then Exit;
if (SrcWidth <= 0) or (SrcHeight <= 0) then Exit;
- Widgetset.GetClipBox(Dest, @Clip);
+ GetClipBox(Dest, @Clip);
if (DstX >= Clip.Right) or (DstY >= Clip.Bottom) or
(DstX + SrcWidth < Clip.Left) or (DstY + SrcHeight < Clip.Top) then Exit;
@@ -558,63 +530,25 @@ begin
ClipDimension(Clip.Left, Clip.Right, DstX, SrcX, SrcWidth);
ClipDimension(Clip.Top, Clip.Bottom, DstY, SrcY, SrcHeight);
- {$IFDEF Windows}
- with Info.bmiHeader do
- begin
- biSize := SizeOf(BITMAPINFOHEADER);
- biWidth := Bitmap.Width;
- biHeight := Bitmap.Height;
- biPlanes := 1;
- biBitCount := 32;
- biCompression := BI_RGB;
- biSizeImage := 0;
- biClrImportant := 0;
- end;
-
- SetStretchBltMode(Dest, COLORONCOLOR);
- StretchDIBits(Dest, DstX, Pred(DstY + SrcHeight), SrcWidth, -SrcHeight,
- SrcX, SrcY, SrcWidth, SrcHeight, Bitmap.Pixels, Info, DIB_RGB_COLORS, SRCCOPY);
- {$ENDIF}
-
- {$IFDEF gtk}
- P := GetDCOffset(TDeviceContext(Dest));
- Inc(DstX, P.X);
- Inc(DstY, P.Y);
-
- gdk_draw_rgb_32_image(TDeviceContext(Dest).Drawable, TDeviceContext(Dest).GC,
- DstX, DstY, SrcWidth, SrcHeight, GDK_RGB_DITHER_NONE,
- Pguchar(Bitmap.GetPixelPtrUnsafe(SrcX, SrcY)), Bitmap.RowPixelStride shl 2);
- {$ENDIF}
+ WidgetSetDrawRGB32Bitmap(Dest, DstX, DstY, SrcX, SrcY, SrcWidth, SrcHeight, Bitmap);
end;
// ! SrcX < 0, SrcY < 0, SrcX + SrcWidth > Bitmap.Width, SrcY + SrcHeight > Bitmap.Height
// ! results in mash
-{$DEFINE StretchRGB32}
-{$IFDEF Windows}
-{ $UNDEF StretchRGB32}
-{$ENDIF}
procedure StretchDrawRGB32Bitmap(Dest: HDC; DstX, DstY, DstWidth, DstHeight: Integer;
SrcX, SrcY, SrcWidth, SrcHeight: Integer; Bitmap: TRGB32BitmapCore);
var
Clip: TRect;
{$IFDEF StretchRGB32}
- {$IFDEF gtk}
- P: TPoint;
- {$ENDIF}
Temp: TRGB32BitmapCore;
X, Y, W, H: Integer;
-{$ELSE}
- {$IFDEF Windows}
- Info: BITMAPINFO;
- {$ENDIF}
{$ENDIF}
-
begin
if (Bitmap = nil) or (Bitmap.Pixels = nil) then Exit;
if (Bitmap.Width <= 0) or (Bitmap.Height <= 0) then Exit;
if (SrcWidth <= 0) or (SrcHeight <= 0) then Exit;
if (DstWidth <= 0) or (DstHeight <= 0) then Exit;
- Widgetset.GetClipBox(Dest, @Clip);
+ GetClipBox(Dest, @Clip);
if (DstX >= Clip.Right) or (DstY >= Clip.Bottom) or
(DstX + DstWidth < Clip.Left) or (DstY + DstHeight < Clip.Top) then Exit;
@@ -640,21 +574,8 @@ begin
Temp.Free;
end;
{$ELSE}
- with Info.bmiHeader do
- begin
- biSize := SizeOf(BITMAPINFOHEADER);
- biWidth := Bitmap.Width;
- biHeight := Bitmap.Height;
- biPlanes := 1;
- biBitCount := 32;
- biCompression := BI_RGB;
- biSizeImage := 0;
- biClrImportant := 0;
- end;
-
- SetStretchBltMode(Dest, COLORONCOLOR);
- StretchDIBits(Dest, DstX, Pred(DstY + DstHeight), DstWidth, -DstHeight, SrcX, SrcY,
- SrcWidth, SrcHeight, Bitmap.Pixels, Info, DIB_RGB_COLORS, SRCCOPY);
+ WidgetSetStretchDrawRGB32Bitmap(Dest, DstX, DstY, DstWidth, DstHeight,
+ SrcX, SrcY, SrcWidth, SrcHeight, Bitmap);
{$ENDIF}
end;
@@ -795,7 +716,7 @@ begin
if (Bitmap = nil) or (Bitmap.Pixels = nil) then Exit;
if (Bitmap.Width <= 0) or (Bitmap.Height <= 0) then Exit;
if (DstWidth <= 0) or (DstHeight <= 0) then Exit;
- Widgetset.GetClipBox(Dest, @Clip);
+ GetClipBox(Dest, @Clip);
ZoomX := DstWidth / Bitmap.Width;
ZoomY := DstHeight / Bitmap.Height;
@@ -814,19 +735,11 @@ procedure DrawRGB8Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, S
Bitmap: TRGB8BitmapCore);
var
Clip: TRect;
-{$IFDEF Win32}
- Info: PBITMAPINFO;
- I: Byte;
- PColor: PRGBQUAD;
-{$ENDIF}
-{$IFDEF gtk}
- P: TPoint;
-{$ENDIF}
begin
if (Bitmap = nil) or (Bitmap.Pixels = nil) then Exit;
if (Bitmap.Width <= 0) or (Bitmap.Height <= 0) then Exit;
if (SrcWidth <= 0) or (SrcHeight <= 0) then Exit;
- Widgetset.GetClipBox(Dest, @Clip);
+ GetClipBox(Dest, @Clip);
if (DstX >= Clip.Right) or (DstY >= Clip.Bottom) or
(DstX + SrcWidth < Clip.Left) or (DstY + SrcHeight < Clip.Top) then Exit;
@@ -835,243 +748,7 @@ begin
ClipDimension(Clip.Left, Clip.Right, DstX, SrcX, SrcWidth);
ClipDimension(Clip.Top, Clip.Bottom, DstY, SrcY, SrcHeight);
- {$IFDEF Windows}
- GetMem(Info, SizeOf(BITMAPINFO) + 256 * SizeOf(RGBQUAD));
- try
- with Info^.bmiHeader do
- begin
- biSize := SizeOf(BITMAPINFOHEADER);
- biWidth := Bitmap.Width;
- biHeight := Bitmap.Height;
- biPlanes := 1;
- biBitCount := 8;
- biCompression := BI_RGB;
- biSizeImage := 0;
- biClrUsed := 256;
- biClrImportant := 0;
- end;
-
- PColor := @(Info^.bmiColors[0]);
- for I := 0 to 255 do
- begin
- PColor^.rgbRed := I;
- PColor^.rgbGreen := I;
- PColor^.rgbBlue := I;
- Inc(PColor);
- end;
-
- SetStretchBltMode(Dest, COLORONCOLOR);
- StretchDIBits(Dest, DstX, Pred(DstY + SrcHeight), SrcWidth, -SrcHeight,
- SrcX, SrcY, SrcWidth, SrcHeight, Bitmap.Pixels, Info^, DIB_RGB_COLORS, SRCCOPY);
- finally
- FreeMem(Info);
- end;
- {$ENDIF}
-
- {$IFDEF gtk}
- P := GetDCOffset(TDeviceContext(Dest));
- Inc(DstX, P.X);
- Inc(DstY, P.Y);
-
- gdk_draw_gray_image(TDeviceContext(Dest).Drawable, TDeviceContext(Dest).GC,
- DstX, DstY, SrcWidth, SrcHeight, GDK_RGB_DITHER_NONE,
- Pguchar(Bitmap.Get8PixelPtrUnsafe(SrcX, SrcY)), Bitmap.RowPixelStride);
- {$ENDIF}
-end;
-
-
-procedure FlipHorzRGBBitmap(Bitmap: TRGBBitmapCore);
-var
- X, Y: Integer;
- PNew, POld: PRGBPixel;
-begin
- for Y := 0 to Pred(Bitmap.Height) do
- begin
- PNew := Bitmap.GetPixelPtrUnsafe(0, Y);
- POld := Bitmap.GetPixelPtrUnsafe(Pred(Bitmap.Width), Y);
- for X := 0 to Pred(Bitmap.Width shr 1) do
- begin
- SwapRGBPixels(PNew, POld, Bitmap.SizeOfPixel);
- Inc(PNew, Bitmap.SizeOfPixel);
- Dec(POld, Bitmap.SizeOfPixel);
- end;
- end;
-end;
-
-procedure FlipVertRGBBitmap(Bitmap: TRGBBitmapCore);
-var
- X, Y: Integer;
- PNew, POld: PRGBPixel;
-begin
- for Y := 0 to Pred(Bitmap.Height shr 1) do
- begin
- PNew := Bitmap.GetPixelPtrUnsafe(0, Y);
- POld := Bitmap.GetPixelPtrUnsafe(0, Pred(Bitmap.Height) - Y);
- for X := 0 to Pred(Bitmap.Width) do
- begin
- SwapRGBPixels(PNew, POld, Bitmap.SizeOfPixel);
- Inc(PNew, Bitmap.SizeOfPixel);
- Inc(POld, Bitmap.SizeOfPixel);
- end;
- end;
-end;
-
-(*
- Creates look-up table T[I = 0..255] = A + I * B.
-*)
-
-function GetIntensityFloatTable(A, B: Single): TIntensityFloatTable;
-var
- I: Integer;
- C: Single;
-begin
- C := A;
- for I := 0 to High(Result) do
- begin
- Result[I] := FloatToIntensityFloatInline(C);
- C := C + B;
- end;
-end;
-
-procedure Rotate90CWRGBBitmap(Bitmap: TRGBBitmapCore);
-var
- X, Y: Integer;
- PNew, POld: PRGBPixel;
- Result: TRGBBitmapCore;
-begin
- Result := TRGBBitmapCore.Create(Bitmap.Height, Bitmap.Width, Bitmap.SizeOfPixel);
- try
- for Y := 0 to Pred(Bitmap.Height) do
- begin
- PNew := Result.GetPixelPtrUnsafe(Pred(Bitmap.Height) - Y, 0);
- POld := Bitmap.GetPixelPtrUnsafe(0, Y);
- for X := 0 to Pred(Bitmap.Width) do
- begin
- CopyRGBPixels(POld, PNew, Result.SizeOfPixel);
- Inc(PNew, Result.RowPixelStride * Result.SizeOfPixel);
- Inc(POld, Result.SizeOfPixel);
- end;
- end;
- Bitmap.SwapWith(Result);
- finally
- FreeAndNil(Result);
- end;
-end;
-
-
-procedure Rotate180CWRGBBitmap(Bitmap: TRGBBitmapCore);
-var
- X, Y: Integer;
- PNew, POld: PRGBPixel;
-begin
- for Y := 0 to Pred(Bitmap.Height shr 1) do
- begin
- PNew := Bitmap.GetPixelPtrUnsafe(0, Y);
- POld := Bitmap.GetPixelPtrUnsafe(Pred(Bitmap.Width), Pred(Bitmap.Height) - Y);
- for X := 0 to Pred(Bitmap.Width) do
- begin
- SwapRGBPixels(PNew, POld, Bitmap.SizeOfPixel);
- Inc(PNew, Bitmap.SizeOfPixel);
- Dec(POld, Bitmap.SizeOfPixel);
- end;
- end;
- if Odd(Bitmap.Height) then
- begin
- PNew := Bitmap.GetPixelPtrUnsafe(0, Bitmap.Height shr 1);
- POld := Bitmap.GetPixelPtrUnsafe(Pred(Bitmap.Width), Bitmap.Height shr 1);
- for X := 0 to Pred(Bitmap.Width shr 1) do
- begin
- SwapRGBPixels(PNew, POld, Bitmap.SizeOfPixel);
- Inc(PNew, Bitmap.SizeOfPixel);
- Dec(POld, Bitmap.SizeOfPixel);
- end;
- end;
-end;
-
-procedure Rotate270CWRGBBitmap(Bitmap: TRGBBitmapCore);
-var
- X, Y: Integer;
- PNew, POld: PRGBPixel;
- Result: TRGBBitmapCore;
-begin
- Result := TRGBBitmapCore.Create(Bitmap.Height, Bitmap.Width, Bitmap.SizeOfPixel);
- try
- for Y := 0 to Pred(Bitmap.Height) do
- begin
- PNew := Result.GetPixelPtrUnsafe(Y, Pred(Bitmap.Width));
- POld := Bitmap.GetPixelPtrUnsafe(0, Y);
- for X := 0 to Pred(Bitmap.Width) do
- begin
- CopyRGBPixels(POld, PNew, Result.SizeOfPixel);
- Dec(PNew, Result.RowPixelStride * Result.SizeOfPixel);
- Inc(POld, Result.SizeOfPixel);
- end;
- end;
- Bitmap.SwapWith(Result);
- finally
- FreeAndNil(Result);
- end;
-end;
-
-procedure InvertRGBBitmap(Bitmap: TRGBBitmapCore);
-var
- I: Integer;
- P: PRGBPixel;
-begin
- P := Bitmap.Pixels;
- for I := 0 to Pred(Bitmap.Height * Bitmap.RowPixelStride * Bitmap.SizeOfPixel) do
- begin
- P^ := $FF - P^;
- Inc(P);
- end;
-end;
-
-procedure GrayscaleRGB32Bitmap(Bitmap: TRGB32BitmapCore);
-var
- X, Y: Integer;
- P: PRGB32Pixel;
- S: Byte;
- R, G, B: TIntensityFloatTable;
-begin
- // R * 0.299 + G * 0.587 + B * 0.114
- R := GetIntensityFloatTable(0, 0.299);
- G := GetIntensityFloatTable(0, 0.587);
- B := GetIntensityFloatTable(0, 0.114);
- for Y := 0 to Pred(Bitmap.Height) do
- begin
- P := Bitmap.Get32PixelPtr(0, Y);
- for X := 0 to Pred(Bitmap.Width) do
- begin
- S := RoundIntensityFloatInline(R[GetRedInline(P^)] + G[GetGreenInline(P^)]
- + B[GetBlueInline(P^)]);
- P^ := RGBToRGB32PixelInline(S, S, S);
- Inc(P);
- end;
- end;
-end;
-
-procedure DisableRGB32Bitmap(Bitmap: TRGB32BitmapCore);
-var
- X, Y: Integer;
- P: PRGB32Pixel;
- S: Byte;
- R, G, B: TIntensityFloatTable;
-begin
- // 128 + R * 0.299 / 4 + G * 0.587 / 4 + B * 0.114 / 4
- R := GetIntensityFloatTable(128, 0.299 / 4);
- G := GetIntensityFloatTable(0, 0.587 / 4);
- B := GetIntensityFloatTable(0, 0.114 / 4);
- for Y := 0 to Pred(Bitmap.Height) do
- begin
- P := Bitmap.Get32PixelPtr(0, Y);
- for X := 0 to Pred(Bitmap.Width) do
- begin
- S := RoundIntensityFloatInline(R[GetRedInline(P^)] + G[GetGreenInline(P^)]
- + B[GetBlueInline(P^)]);
- P^ := RGBToRGB32PixelInline(S, S, S);
- Inc(P);
- end;
- end;
+ WidgetSetDrawRGB8Bitmap(Dest, DstX, DstY, SrcX, SrcY, SrcWidth, SrcHeight, Bitmap);
end;
(*
@@ -1153,7 +830,7 @@ begin
for X := X1 to X2 do DrawPixel(X, Y);
end;
-procedure FillPixelRow(X1, X2, Y: Integer; DrawPixel: TDrawPixelProcedure);
+procedure FillPixelRow(X1, X2, Y: Integer; DrawPixel: TDrawPixelProcedure); inline;
var
X: Integer;
begin
@@ -1343,7 +1020,7 @@ var
Stack: Array of Integer;
StackCount: Integer;
- function CheckPixel(AX, AY: Integer): Boolean; {$ifdef hasinline}inline;{$endif}
+ function CheckPixel(AX, AY: Integer): Boolean; inline;
begin
if Visited[AX + AY * W] = 1 then Result := False
else
@@ -1352,7 +1029,7 @@ var
end;
end;
- procedure Push(AX, AY: Integer); {$ifdef hasinline}inline;{$endif}
+ procedure Push(AX, AY: Integer); inline;
begin
if StackCount >= High(Stack) then SetLength(Stack, Length(Stack) shl 1);
@@ -1360,7 +1037,7 @@ var
Inc(StackCount);
end;
- procedure Pop(var AX, AY: Integer); {$ifdef hasinline}inline;{$endif}
+ procedure Pop(var AX, AY: Integer); inline;
begin
Dec(StackCount);
AX := Stack[StackCount] and $FFFF;
@@ -1417,10 +1094,6 @@ begin
end;
end;
-initialization
- {$IFDEF gtk}
- gdk_rgb_init;
- {$ENDIF}
end.
diff --git a/components/rgbgraphics/rgbtypes.pas b/components/rgbgraphics/rgbtypes.pas
index 38b11495d..f004e6736 100644
--- a/components/rgbgraphics/rgbtypes.pas
+++ b/components/rgbgraphics/rgbtypes.pas
@@ -28,21 +28,17 @@ unit RGBTypes;
{$ifdef fpc}
{$mode objfpc}{$H+}
- {$define hasinline}
{$endif}
-{$ifndef fpc}
- {$define Windows}
-{$endif}
-
-{$ifdef win32}
- {$define Windows}
+{$ifdef LCLwin32}
+ {$define RGB}
{$endif}
interface
uses
- Classes, SysUtils, FPImage, IntfGraphics, Graphics, Math, LCLProc;
+ Classes, SysUtils, FPImage, IntfGraphics, Graphics, Math, LCLProc,
+ RGBUtils;
type
PRGBPixel = PByte;
@@ -74,6 +70,7 @@ type
FWidth: Integer;
FHeight: Integer;
FRowPixelStride: Integer;
+ function GetSize: Integer;
public
constructor Create(AWidth, AHeight: Integer; ASizeOfPixel: Integer); virtual;
constructor CreateAsCopy(ABitmap: TRGBBitmapCore; ASizeOfPixel: Integer); virtual;
@@ -82,8 +79,8 @@ type
procedure Assign(Source: TPersistent); override;
procedure SwapWith(ABitmap: TRGBBitmapCore); virtual;
public
- function GetPixelPtrUnsafe(X, Y: Integer): PRGBPixel; {$ifdef hasinline}inline;{$endif}
- function GetPixelPtr(X, Y: Integer): PRGBPixel; {$ifdef hasinline}inline;{$endif}
+ function GetPixelPtrUnsafe(X, Y: Integer): PRGBPixel;
+ function GetPixelPtr(X, Y: Integer): PRGBPixel;
procedure Clear; virtual;
procedure ClearWhite; virtual;
@@ -99,6 +96,7 @@ type
property Height: Integer read FHeight;
property Pixels: PRGBPixel read FPixels;
property RowPixelStride: Integer read FRowPixelStride;
+ property Size: Integer read GetSize;
property SizeOfPixel: Integer read FSizeOfPixel;
end;
@@ -116,12 +114,12 @@ type
procedure Assign(Source: TPersistent); override;
procedure SwapWith(ABitmap: TRGBBitmapCore); override;
public
- function Get8PixelPtrUnsafe(X, Y: Integer): PRGB8Pixel; {$ifdef hasinline}inline;{$endif}
- function Get8PixelPtr(X, Y: Integer): PRGB8Pixel; {$ifdef hasinline}inline;{$endif}
+ function Get8PixelPtrUnsafe(X, Y: Integer): PRGB8Pixel;
+ function Get8PixelPtr(X, Y: Integer): PRGB8Pixel;
function Get8PixelUnsafe(X, Y: Integer): TRGB8Pixel;
- procedure Set8PixelUnsafe(X, Y: Integer; Value: TRGB8Pixel); {$ifdef hasinline}inline;{$endif}
- procedure Set8Pixel(X, Y: Integer; Value: TRGB8Pixel); {$ifdef hasinline}inline;{$endif}
+ procedure Set8PixelUnsafe(X, Y: Integer; Value: TRGB8Pixel);
+ procedure Set8Pixel(X, Y: Integer; Value: TRGB8Pixel);
end;
{ TRGB32BitmapCore }
@@ -137,39 +135,127 @@ type
procedure SaveToLazIntfImage(AImage: TLazIntfImage); virtual;
procedure SaveToLazIntfImage(AImage: TLazIntfImage; const ARect: TRect); virtual;
public
- function Get32PixelPtrUnsafe(X, Y: Integer): PRGB32Pixel; {$ifdef hasinline}inline;{$endif}
- function Get32PixelPtr(X, Y: Integer): PRGB32Pixel; {$ifdef hasinline}inline;{$endif}
+ function Get32PixelPtrUnsafe(X, Y: Integer): PRGB32Pixel;
+ function Get32PixelPtr(X, Y: Integer): PRGB32Pixel;
function Get32PixelUnsafe(X, Y: Integer): TRGB32Pixel;
- procedure Set32PixelUnsafe(X, Y: Integer; Value: TRGB32Pixel); {$ifdef hasinline}inline;{$endif}
- procedure Set32Pixel(X, Y: Integer; Value: TRGB32Pixel); {$ifdef hasinline}inline;{$endif}
+ procedure Set32PixelUnsafe(X, Y: Integer; Value: TRGB32Pixel);
+ procedure Set32Pixel(X, Y: Integer; Value: TRGB32Pixel);
end;
-
- procedure SwapRGBPixels(A, B: PRGBPixel; const Size: Integer); {$ifdef hasinline}inline;{$endif}
- procedure CopyRGBPixels(Src, Dest: PRGBPixel; const Size: Integer); {$ifdef hasinline}inline;{$endif}
+ procedure FlipHorzRGBBitmap(Bitmap: TRGBBitmapCore);
+ procedure FlipVertRGBBitmap(Bitmap: TRGBBitmapCore);
+
+ // intensity tables
+ function GetIntensityFloatTable(A, B: Single): TIntensityFloatTable;
+
+ // rotate clockwise
+ procedure Rotate90CWRGBBitmap(Bitmap: TRGBBitmapCore);
+ procedure Rotate180CWRGBBitmap(Bitmap: TRGBBitmapCore);
+ procedure Rotate270CWRGBBitmap(Bitmap: TRGBBitmapCore);
+
+ procedure InvertRGBBitmap(Bitmap: TRGBBitmapCore);
+ procedure GrayscaleRGB32Bitmap(Bitmap: TRGB32BitmapCore);
+ procedure DisableRGB32Bitmap(Bitmap: TRGB32BitmapCore);
+
function RGB32PixelToColor(P: TRGB32Pixel): TColor;
function ColorToRGB32Pixel(C: TColor): TRGB32Pixel;
- function GetRedInline(P: TRGB32Pixel): Byte; {$ifdef hasinline}inline;{$endif}
- function GetGreenInline(P: TRGB32Pixel): Byte; {$ifdef hasinline}inline;{$endif}
- function GetBlueInline(P: TRGB32Pixel): Byte; {$ifdef hasinline}inline;{$endif}
- function RGBToRGB32PixelInline(R, G, B: Byte): TRGB32Pixel; {$ifdef hasinline}inline;{$endif}
-
- function RGB32PixelToColorInline(P: TRGB32Pixel): TColor; {$ifdef hasinline}inline;{$endif}
- function ColorToRGB32PixelInline(C: TColor): TRGB32Pixel; {$ifdef hasinline}inline;{$endif}
-
- function RGB32PixelDifferenceInline(A, B: TRGB32Pixel): TPixelDifference; {$ifdef hasinline}inline;{$endif}
-
- function FloatToIntensityFloatInline(F: Extended): TIntensityFloat; {$ifdef hasinline}inline;{$endif}
- function RoundIntensityFloatInline(V: TIntensityFloat): Byte; {$ifdef hasinline}inline;{$endif}
-
implementation
-uses
- RGBRoutines, RGBUtils;
+function GetRedInline(P: TRGB32Pixel): Byte; inline;
+begin
+ {$IFDEF RGB}
+ Result := (P and $FF0000) shr 16;
+ {$ELSE}
+ Result := P and $FF;
+ {$ENDIF}
+end;
-procedure SwapRGBPixels(A, B: PRGBPixel; const Size: Integer);
+function GetGreenInline(P: TRGB32Pixel): Byte; inline;
+begin
+ {$IFDEF RGB}
+ Result := (P and $FF00) shr 8;
+ {$ELSE}
+ Result := (P and $FF00) shr 8;
+ {$ENDIF}
+end;
+
+function GetBlueInline(P: TRGB32Pixel): Byte; inline;
+begin
+ {$IFDEF RGB}
+ Result := P and $FF;
+ {$ELSE}
+ Result := (P and $FF0000) shr 16;
+ {$ENDIF}
+end;
+
+function RGBToRGB32PixelInline(R, G, B: Byte): TRGB32Pixel; inline;
+begin
+ {$IFDEF RGB}
+ Result := B or (G shl 8) or (R shl 16);
+ {$ELSE}
+ Result := R or (G shl 8) or (B shl 16);
+ {$ENDIF}
+end;
+
+function RGB32PixelToColorInline(P: TRGB32Pixel): TColor; inline;
+begin
+ {$IFDEF RGB}
+ Result := ((P and $FF0000) shr 16) or (P and $FF00) or ((P and $FF) shl 16);
+ {$ELSE}
+ Result := P and $FFFFFF;
+ {$ENDIF}
+end;
+
+function ColorToRGB32PixelInline(C: TColor): TRGB32Pixel; inline;
+begin
+ {$IFDEF RGB}
+ Result := ((C and $FF0000) shr 16) or (C and $FF00) or ((C and $FF) shl 16);
+ {$ELSE}
+ Result := C and $FFFFFF;
+ {$ENDIF}
+end;
+
+function FPColorToRGB32PixelInline(F: TFPColor): TRGB32Pixel; inline;
+begin
+ {$IFDEF RGB}
+ Result := ((F.Blue shr 8) and $FF) or (F.Green and $FF00) or ((F.Red shl 8) and $FF0000);
+ {$ELSE}
+ Result := ((F.Red shr 8) and $FF) or (F.Green and $FF00) or ((F.Blue shl 8) and $FF0000);
+ {$ENDIF}
+end;
+
+function RGB32PixelToFPColorInline(P: TRGB32Pixel): TFPColor; inline;
+begin
+ {$IFDEF RGB}
+ Result.Red := (P shr 16) and $FF;
+ Result.Red := Result.Red or (Result.Red shl 8);
+ Result.Green := P and $FF00;
+ Result.Green := Result.Green or (Result.Green shr 8);
+ Result.Blue := P and $FF;
+ Result.Blue := Result.Blue or (Result.Blue shl 8);
+ {$ELSE}
+ Result.Red := P and $FF;
+ Result.Red := Result.Red or (Result.Red shl 8);
+ Result.Green := P and $FF00;
+ Result.Green := Result.Green or (Result.Green shr 8);
+ Result.Blue := (P shr 16) and $FF;
+ Result.Blue := Result.Blue or (Result.Blue shl 8);
+ {$ENDIF}
+end;
+
+function RGB32PixelToColor(P: TRGB32Pixel): TColor;
+begin
+ Result := RGB32PixelToColorInline(P);
+end;
+
+function ColorToRGB32Pixel(C: TColor): TRGB32Pixel;
+begin
+ Result := ColorToRGB32PixelInline(C);
+end;
+
+procedure SwapRGBPixels(A, B: PRGBPixel; const Size: Integer); inline;
var
T32: TRGB32Pixel;
T8: TRGB8Pixel;
@@ -188,7 +274,7 @@ begin
end;
end;
-procedure CopyRGBPixels(Src, Dest: PRGBPixel; const Size: Integer);
+procedure CopyRGBPixels(Src, Dest: PRGBPixel; const Size: Integer); inline;
begin
if Size = 4 then PRGB32Pixel(Dest)^ := PRGB32Pixel(Src)^
else
@@ -197,124 +283,218 @@ begin
end;
end;
-function GetRedInline(P: TRGB32Pixel): Byte;
+function GetRGBBitmapPixelPtr(const Bitmap: TRGBBitmapCore; X, Y: Integer): PRGBPixel; inline;
begin
- {$IFDEF Windows}
- Result := (P and $FF0000) shr 16;
- {$ELSE}
- Result := P and $FF;
- {$ENDIF}
+ Result := Bitmap.FPixels;
+ Inc(Result, Y * Bitmap.FRowPixelStride * Bitmap.FSizeOfPixel + X * Bitmap.FSizeOfPixel);
end;
-function GetGreenInline(P: TRGB32Pixel): Byte;
-begin
- {$IFDEF Windows}
- Result := (P and $FF00) shr 8;
- {$ELSE}
- Result := (P and $FF00) shr 8;
- {$ENDIF}
-end;
-
-function GetBlueInline(P: TRGB32Pixel): Byte;
-begin
- {$IFDEF Windows}
- Result := P and $FF;
- {$ELSE}
- Result := (P and $FF0000) shr 16;
- {$ENDIF}
-end;
-
-function RGBToRGB32PixelInline(R, G, B: Byte): TRGB32Pixel;
-begin
- {$IFDEF Windows}
- Result := B or (G shl 8) or (R shl 16);
- {$ELSE}
- Result := R or (G shl 8) or (B shl 16);
- {$ENDIF}
-end;
-
-// TODO: check on big-endian arch.
-function RGB32PixelToColorInline(P: TRGB32Pixel): TColor;
-begin
- {$IFDEF Windows}
- Result := ((P and $FF0000) shr 16) or (P and $FF00) or ((P and $FF) shl 16);
- {$ELSE}
- Result := P and $FFFFFF;
- {$ENDIF}
-end;
-
-function ColorToRGB32PixelInline(C: TColor): TRGB32Pixel;
-begin
- {$IFDEF Windows}
- Result := ((C and $FF0000) shr 16) or (C and $FF00) or ((C and $FF) shl 16);
- {$ELSE}
- Result := C and $FFFFFF;
- {$ENDIF}
-end;
-
-function FPColorToRGB32PixelInline(F: TFPColor): TRGB32Pixel;
-begin
- {$IFDEF Windows}
- Result := ((F.Blue shr 8) and $FF) or (F.Green and $FF00) or ((F.Red shl 8) and $FF0000);
- {$ELSE}
- Result := ((F.Red shr 8) and $FF) or (F.Green and $FF00) or ((F.Blue shl 8) and $FF0000);
- {$ENDIF}
-end;
-
-function RGB32PixelToFPColorInline(P: TRGB32Pixel): TFPColor;
-begin
- {$IFDEF Windows}
- Result.Red := (P shr 16) and $FF;
- Result.Red := Result.Red or (Result.Red shl 8);
- Result.Green := P and $FF00;
- Result.Green := Result.Green or (Result.Green shr 8);
- Result.Blue := P and $FF;
- Result.Blue := Result.Blue or (Result.Blue shl 8);
- {$ELSE}
- Result.Red := P and $FF;
- Result.Red := Result.Red or (Result.Red shl 8);
- Result.Green := P and $FF00;
- Result.Green := Result.Green or (Result.Green shr 8);
- Result.Blue := (P shr 16) and $FF;
- Result.Blue := Result.Blue or (Result.Blue shl 8);
- {$ENDIF}
-end;
-
-function AbsByte(Src: Integer): Byte; {$ifdef hasinline}inline;{$endif}
-begin
- if Src >= 0 then Result := Src
- else Result := -Src;
-end;
-
-function RGB32PixelDifferenceInline(A, B: TRGB32Pixel): TPixelDifference;
-begin
- Result := AbsByte(((A shr 16) and $FF) - ((B shr 16) and $FF))
- + AbsByte(((A shr 8) and $FF) - ((B shr 8) and $FF))
- + AbsByte((A and $FF) - (B and $FF));
-end;
-
-function RGB32PixelToColor(P: TRGB32Pixel): TColor;
-begin
- Result := RGB32PixelToColorInline(P);
-end;
-
-function ColorToRGB32Pixel(C: TColor): TRGB32Pixel;
-begin
- Result := ColorToRGB32PixelInline(C);
-end;
-
-function FloatToIntensityFloatInline(F: Extended): TIntensityFloat;
-begin
- Result := Round(F * 256);
-end;
-
-function RoundIntensityFloatInline(V: TIntensityFloat): Byte;
+function RoundIntensityFloatInline(V: TIntensityFloat): Byte; inline;
begin
Result := Max(0, Min(255, (V + 128) shr 8));
end;
+procedure FlipHorzRGBBitmap(Bitmap: TRGBBitmapCore);
+var
+ X, Y: Integer;
+ PNew, POld: PRGBPixel;
+begin
+ for Y := 0 to Pred(Bitmap.Height) do
+ begin
+ PNew := Bitmap.GetPixelPtrUnsafe(0, Y);
+ POld := Bitmap.GetPixelPtrUnsafe(Pred(Bitmap.Width), Y);
+ for X := 0 to Pred(Bitmap.Width shr 1) do
+ begin
+ SwapRGBPixels(PNew, POld, Bitmap.SizeOfPixel);
+ Inc(PNew, Bitmap.SizeOfPixel);
+ Dec(POld, Bitmap.SizeOfPixel);
+ end;
+ end;
+end;
+
+procedure FlipVertRGBBitmap(Bitmap: TRGBBitmapCore);
+var
+ X, Y: Integer;
+ PNew, POld: PRGBPixel;
+begin
+ for Y := 0 to Pred(Bitmap.Height shr 1) do
+ begin
+ PNew := Bitmap.GetPixelPtrUnsafe(0, Y);
+ POld := Bitmap.GetPixelPtrUnsafe(0, Pred(Bitmap.Height) - Y);
+ for X := 0 to Pred(Bitmap.Width) do
+ begin
+ SwapRGBPixels(PNew, POld, Bitmap.SizeOfPixel);
+ Inc(PNew, Bitmap.SizeOfPixel);
+ Inc(POld, Bitmap.SizeOfPixel);
+ end;
+ end;
+end;
+
+(*
+ Creates look-up table T[I = 0..255] = A + I * B.
+*)
+
+function GetIntensityFloatTable(A, B: Single): TIntensityFloatTable;
+var
+ I: Integer;
+ C: Single;
+begin
+ C := A;
+ for I := 0 to High(Result) do
+ begin
+ Result[I] := Round(C * 256);
+ C := C + B;
+ end;
+end;
+
+procedure Rotate90CWRGBBitmap(Bitmap: TRGBBitmapCore);
+var
+ X, Y: Integer;
+ PNew, POld: PRGBPixel;
+ Result: TRGBBitmapCore;
+begin
+ Result := TRGBBitmapCore.Create(Bitmap.Height, Bitmap.Width, Bitmap.SizeOfPixel);
+ try
+ for Y := 0 to Pred(Bitmap.Height) do
+ begin
+ PNew := Result.GetPixelPtrUnsafe(Pred(Bitmap.Height) - Y, 0);
+ POld := Bitmap.GetPixelPtrUnsafe(0, Y);
+ for X := 0 to Pred(Bitmap.Width) do
+ begin
+ CopyRGBPixels(POld, PNew, Result.SizeOfPixel);
+ Inc(PNew, Result.RowPixelStride * Result.SizeOfPixel);
+ Inc(POld, Result.SizeOfPixel);
+ end;
+ end;
+ Bitmap.SwapWith(Result);
+ finally
+ FreeAndNil(Result);
+ end;
+end;
+
+
+procedure Rotate180CWRGBBitmap(Bitmap: TRGBBitmapCore);
+var
+ X, Y: Integer;
+ PNew, POld: PRGBPixel;
+begin
+ for Y := 0 to Pred(Bitmap.Height shr 1) do
+ begin
+ PNew := Bitmap.GetPixelPtrUnsafe(0, Y);
+ POld := Bitmap.GetPixelPtrUnsafe(Pred(Bitmap.Width), Pred(Bitmap.Height) - Y);
+ for X := 0 to Pred(Bitmap.Width) do
+ begin
+ SwapRGBPixels(PNew, POld, Bitmap.SizeOfPixel);
+ Inc(PNew, Bitmap.SizeOfPixel);
+ Dec(POld, Bitmap.SizeOfPixel);
+ end;
+ end;
+ if Odd(Bitmap.Height) then
+ begin
+ PNew := Bitmap.GetPixelPtrUnsafe(0, Bitmap.Height shr 1);
+ POld := Bitmap.GetPixelPtrUnsafe(Pred(Bitmap.Width), Bitmap.Height shr 1);
+ for X := 0 to Pred(Bitmap.Width shr 1) do
+ begin
+ SwapRGBPixels(PNew, POld, Bitmap.SizeOfPixel);
+ Inc(PNew, Bitmap.SizeOfPixel);
+ Dec(POld, Bitmap.SizeOfPixel);
+ end;
+ end;
+end;
+
+procedure Rotate270CWRGBBitmap(Bitmap: TRGBBitmapCore);
+var
+ X, Y: Integer;
+ PNew, POld: PRGBPixel;
+ Result: TRGBBitmapCore;
+begin
+ Result := TRGBBitmapCore.Create(Bitmap.Height, Bitmap.Width, Bitmap.SizeOfPixel);
+ try
+ for Y := 0 to Pred(Bitmap.Height) do
+ begin
+ PNew := Result.GetPixelPtrUnsafe(Y, Pred(Bitmap.Width));
+ POld := Bitmap.GetPixelPtrUnsafe(0, Y);
+ for X := 0 to Pred(Bitmap.Width) do
+ begin
+ CopyRGBPixels(POld, PNew, Result.SizeOfPixel);
+ Dec(PNew, Result.RowPixelStride * Result.SizeOfPixel);
+ Inc(POld, Result.SizeOfPixel);
+ end;
+ end;
+ Bitmap.SwapWith(Result);
+ finally
+ FreeAndNil(Result);
+ end;
+end;
+
+procedure InvertRGBBitmap(Bitmap: TRGBBitmapCore);
+var
+ I: Integer;
+ P: PRGBPixel;
+begin
+ P := Bitmap.Pixels;
+ for I := 0 to Pred(Bitmap.Height * Bitmap.RowPixelStride * Bitmap.SizeOfPixel) do
+ begin
+ P^ := $FF - P^;
+ Inc(P);
+ end;
+end;
+
+procedure GrayscaleRGB32Bitmap(Bitmap: TRGB32BitmapCore);
+var
+ X, Y: Integer;
+ P: PRGB32Pixel;
+ S: Byte;
+ R, G, B: TIntensityFloatTable;
+begin
+ // R * 0.299 + G * 0.587 + B * 0.114
+ R := GetIntensityFloatTable(0, 0.299);
+ G := GetIntensityFloatTable(0, 0.587);
+ B := GetIntensityFloatTable(0, 0.114);
+ for Y := 0 to Pred(Bitmap.Height) do
+ begin
+ P := Bitmap.Get32PixelPtr(0, Y);
+ for X := 0 to Pred(Bitmap.Width) do
+ begin
+ S := RoundIntensityFloatInline(R[GetRedInline(P^)] + G[GetGreenInline(P^)]
+ + B[GetBlueInline(P^)]);
+ P^ := RGBToRGB32PixelInline(S, S, S);
+ Inc(P);
+ end;
+ end;
+end;
+
+procedure DisableRGB32Bitmap(Bitmap: TRGB32BitmapCore);
+var
+ X, Y: Integer;
+ P: PRGB32Pixel;
+ S: Byte;
+ R, G, B: TIntensityFloatTable;
+begin
+ // 128 + R * 0.299 / 4 + G * 0.587 / 4 + B * 0.114 / 4
+ R := GetIntensityFloatTable(128, 0.299 / 4);
+ G := GetIntensityFloatTable(0, 0.587 / 4);
+ B := GetIntensityFloatTable(0, 0.114 / 4);
+ for Y := 0 to Pred(Bitmap.Height) do
+ begin
+ P := Bitmap.Get32PixelPtr(0, Y);
+ for X := 0 to Pred(Bitmap.Width) do
+ begin
+ S := RoundIntensityFloatInline(R[GetRedInline(P^)] + G[GetGreenInline(P^)]
+ + B[GetBlueInline(P^)]);
+ P^ := RGBToRGB32PixelInline(S, S, S);
+ Inc(P);
+ end;
+ end;
+end;
+
{ TRGBBitmapCore }
+function TRGBBitmapCore.GetSize: Integer;
+begin
+ Result := Height * RowPixelStride * SizeOfPixel;
+end;
+
constructor TRGBBitmapCore.Create(AWidth, AHeight: Integer; ASizeOfPixel: Integer);
begin
inherited Create;
@@ -371,9 +551,6 @@ begin
end;
procedure TRGBBitmapCore.SwapWith(ABitmap: TRGBBitmapCore);
-var
- Temp: Pointer;
- TempInt: Integer;
begin
if ABitmap = nil then Exit;
@@ -386,26 +563,25 @@ end;
function TRGBBitmapCore.GetPixelPtrUnsafe(X, Y: Integer): PRGBPixel;
begin
- Result := FPixels;
- Inc(Result, Y * FRowPixelStride * FSizeOfPixel + X * FSizeOfPixel);
+ Result := GetRGBBitmapPixelPtr(Self, X, Y);
end;
function TRGBBitmapCore.GetPixelPtr(X, Y: Integer): PRGBPixel;
begin
if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
- Result := GetPixelPtrUnsafe(X, Y)
+ Result := GetRGBBitmapPixelPtr(Self, X, Y)
else
Result := nil;
end;
procedure TRGBBitmapCore.Clear;
begin
- FillByte(Pixels^, Height * RowPixelStride * SizeOfPixel, 0);
+ FillByte(Pixels^, Size, 0);
end;
procedure TRGBBitmapCore.ClearWhite;
begin
- FillByte(Pixels^, Height * RowPixelStride * SizeOfPixel, $FF);
+ FillByte(Pixels^, Size, $FF);
end;
procedure TRGBBitmapCore.Invert;
@@ -430,7 +606,7 @@ end;
procedure TRGBBitmapCore.Rotate180;
begin
- Rotate180CWRGBBitmap(Self);
+ Rotate180CWRGBBitmap(Self);
end;
procedure TRGBBitmapCore.Rotate270;
@@ -497,7 +673,6 @@ var
begin
W := ARect.Right - ARect.Left;
H := ARect.Bottom - ARect.Top;
- AImage.GetDescriptionFromDevice(0);
AImage.SetSize(W, H);
try
for J := 0 to Pred(H) do
@@ -517,34 +692,32 @@ end;
function TRGB32BitmapCore.Get32PixelPtrUnsafe(X, Y: Integer
): PRGB32Pixel;
begin
- Result := PRGB32Pixel(GetPixelPtrUnsafe(X, Y));
+ Result := PRGB32Pixel(GetRGBBitmapPixelPtr(Self, X, Y));
end;
function TRGB32BitmapCore.Get32PixelPtr(X, Y: Integer): PRGB32Pixel;
begin
- Result := PRGB32Pixel(GetPixelPtr(X, Y));
+ if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
+ Result := PRGB32Pixel(GetRGBBitmapPixelPtr(Self, X, Y))
+ else
+ Result := nil;
end;
function TRGB32BitmapCore.Get32PixelUnsafe(X, Y: Integer): TRGB32Pixel;
begin
- Result := Get32PixelPtrUnsafe(X, Y)^;
+ Result := GetRGBBitmapPixelPtr(Self, X, Y)^;
end;
procedure TRGB32BitmapCore.Set32PixelUnsafe(X, Y: Integer;
Value: TRGB32Pixel);
begin
- Get32PixelPtrUnsafe(X, Y)^ := Value;
+ GetRGBBitmapPixelPtr(Self, X, Y)^ := Value;
end;
procedure TRGB32BitmapCore.Set32Pixel(X, Y: Integer; Value: TRGB32Pixel);
-var
- P: PRGB32Pixel;
begin
- P := Get32PixelPtr(X, Y);
- if P <> nil then
- begin
- P^ := Value;
- end;
+ if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
+ PRGB32Pixel(GetRGBBitmapPixelPtr(Self, X, Y))^ := Value;
end;
{ TRGB8BitmapCore }
@@ -616,34 +789,33 @@ end;
function TRGB8BitmapCore.Get8PixelPtrUnsafe(X, Y: Integer): PRGB8Pixel;
begin
- Result := GetPixelPtrUnsafe(X, Y);
+ Result := GetRGBBitmapPixelPtr(Self, X, Y);
end;
function TRGB8BitmapCore.Get8PixelPtr(X, Y: Integer): PRGB8Pixel;
begin
- Result := GetPixelPtr(X, Y);
+ if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
+ Result := GetRGBBitmapPixelPtr(Self, X, Y)
+ else
+ Result := nil;
end;
function TRGB8BitmapCore.Get8PixelUnsafe(X, Y: Integer): TRGB8Pixel;
begin
- Result := GetPixelPtrUnsafe(X, Y)^;
+ Result := GetRGBBitmapPixelPtr(Self, X, Y)^;
end;
procedure TRGB8BitmapCore.Set8PixelUnsafe(X, Y: Integer; Value: TRGB8Pixel);
begin
- GetPixelPtrUnsafe(X, Y)^ := Value;
+ GetRGBBitmapPixelPtr(Self, X, Y)^ := Value;
end;
procedure TRGB8BitmapCore.Set8Pixel(X, Y: Integer; Value: TRGB8Pixel);
-var
- P: PRGB8Pixel;
begin
- P := Get8PixelPtr(X, Y);
- if P <> nil then
- begin
- P^ := Value;
- end;
+ if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
+ GetRGBBitmapPixelPtr(Self, X, Y)^ := Value;
end;
+
end.
diff --git a/components/rgbgraphics/rgbutils.pas b/components/rgbgraphics/rgbutils.pas
index 2e0b9801d..d16b2725e 100644
--- a/components/rgbgraphics/rgbutils.pas
+++ b/components/rgbgraphics/rgbutils.pas
@@ -24,7 +24,6 @@ unit RGBUtils;
{$ifdef fpc}
{$mode objfpc}{$H+}
- {$define hasinline}
{$endif}
interface
@@ -41,7 +40,7 @@ type
procedure SwapInt(var A, B: Integer);
procedure SwapPtr(var A, B: Pointer);
- procedure MinMax(var A, B: Integer); {$ifdef hasinline}inline;{$endif}
+ procedure MinMax(var A, B: Integer);
procedure SortRect(var X1, Y1, X2, Y2: Integer); overload;
procedure SortRect(var R: TRect); overload;
diff --git a/components/rgbgraphics/rgbwinroutines.pas b/components/rgbgraphics/rgbwinroutines.pas
new file mode 100644
index 000000000..954e90b62
--- /dev/null
+++ b/components/rgbgraphics/rgbwinroutines.pas
@@ -0,0 +1,133 @@
+{
+ /***************************************************************************
+ RGBWinRoutines.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 win32 interface.
+
+}
+unit RGBWinRoutines;
+
+{$ifdef fpc}
+ {$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+ SysUtils, Windows, 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);
+var
+ Info: BITMAPINFO;
+begin
+ with Info.bmiHeader do
+ begin
+ biSize := SizeOf(BITMAPINFOHEADER);
+ biWidth := Bitmap.Width;
+ biHeight := Bitmap.Height;
+ biPlanes := 1;
+ biBitCount := 32;
+ biCompression := BI_RGB;
+ biSizeImage := 0;
+ biClrImportant := 0;
+ end;
+
+ SetStretchBltMode(Dest, COLORONCOLOR);
+ StretchDIBits(Dest, DstX, Pred(DstY + SrcHeight), SrcWidth, -SrcHeight,
+ SrcX, SrcY, SrcWidth, SrcHeight, Bitmap.Pixels, Info, DIB_RGB_COLORS, SRCCOPY);
+end;
+
+procedure WidgetSetStretchDrawRGB32Bitmap(Dest: HDC; DstX, DstY, DstWidth,
+ DstHeight: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer;
+ Bitmap: TRGB32BitmapCore);
+var
+ Info: BITMAPINFO;
+begin
+ with Info.bmiHeader do
+ begin
+ biSize := SizeOf(BITMAPINFOHEADER);
+ biWidth := Bitmap.Width;
+ biHeight := Bitmap.Height;
+ biPlanes := 1;
+ biBitCount := 32;
+ biCompression := BI_RGB;
+ biSizeImage := 0;
+ biClrImportant := 0;
+ end;
+
+ SetStretchBltMode(Dest, COLORONCOLOR);
+ StretchDIBits(Dest, DstX, Pred(DstY + DstHeight), DstWidth, -DstHeight, SrcX, SrcY,
+ SrcWidth, SrcHeight, Bitmap.Pixels, Info, DIB_RGB_COLORS, SRCCOPY);
+end;
+
+procedure WidgetSetDrawRGB8Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY,
+ SrcWidth, SrcHeight: Integer; Bitmap: TRGB8BitmapCore);
+var
+ Info: PBITMAPINFO;
+ I: Byte;
+ PColor: PRGBQUAD;
+begin
+ GetMem(Info, SizeOf(BITMAPINFO) + 256 * SizeOf(RGBQUAD));
+ try
+ with Info^.bmiHeader do
+ begin
+ biSize := SizeOf(BITMAPINFOHEADER);
+ biWidth := Bitmap.Width;
+ biHeight := Bitmap.Height;
+ biPlanes := 1;
+ biBitCount := 8;
+ biCompression := BI_RGB;
+ biSizeImage := 0;
+ biClrUsed := 256;
+ biClrImportant := 0;
+ end;
+
+ PColor := @(Info^.bmiColors[0]);
+ for I := 0 to 255 do
+ begin
+ PColor^.rgbRed := I;
+ PColor^.rgbGreen := I;
+ PColor^.rgbBlue := I;
+ Inc(PColor);
+ end;
+
+ SetStretchBltMode(Dest, COLORONCOLOR);
+ StretchDIBits(Dest, DstX, Pred(DstY + SrcHeight), SrcWidth, -SrcHeight,
+ SrcX, SrcY, SrcWidth, SrcHeight, Bitmap.Pixels, Info^, DIB_RGB_COLORS, SRCCOPY);
+ finally
+ FreeMem(Info);
+ end;
+end;
+
+
+end.
+