You've already forked lazarus-ccr
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1525 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
554
applications/lazimageeditor/bmprgbgraph.pas
Normal file
554
applications/lazimageeditor/bmprgbgraph.pas
Normal file
@ -0,0 +1,554 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
RGBGraphics.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:
|
||||
TRGB32Bitmap is a memory image which allows fast pixel manipulations.
|
||||
TExtCanvas is a TRGB32Bitmap canvas for drawing primitives and
|
||||
drawing bitmap image into TCanvas.
|
||||
}
|
||||
unit BmpRGBGraph;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}{$H+}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLIntf, FPWriteBMP, LCLType, LCLProc, FPImage, LResources,
|
||||
IntfGraphics, GraphType, Graphics, Forms, Math, Clipbrd, BmpRGBTypes, BmpRGBUtils;
|
||||
|
||||
type
|
||||
|
||||
TMaskFillMode = (mfAdd, mfRemove, mfXOR);
|
||||
|
||||
{ TRGBMask }
|
||||
|
||||
TRGBMask = class(TRGB8BitmapCore)
|
||||
private
|
||||
FBGPen: TPen;
|
||||
FFGPen: TPen;
|
||||
FFillMode: TMaskFillMode;
|
||||
FMaskedPixels: Integer;
|
||||
protected
|
||||
procedure CreatePens; virtual;
|
||||
public
|
||||
constructor Create(AWidth, AHeight: Integer); override;
|
||||
constructor CreateAsCopy(ABitmap: TRGBBitmapCore); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure LoadFromLazIntfImageAlpha(AImage: TLazIntfImage); override;
|
||||
procedure SwapWith(ABitmap: TRGBBitmapCore); override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure UpdateMaskedPixels;
|
||||
|
||||
procedure Draw(X, Y: Integer; AMask: TRGBMask);
|
||||
|
||||
procedure DrawShapeTo(ACanvas: TCanvas; X, Y: Integer);
|
||||
procedure StretchDrawShapeTo(ACanvas: TCanvas; DstX, DstY, DstWidth, DstHeight: Integer);
|
||||
procedure StretchDrawShapePortionTo(ACanvas: TCanvas; DstX, DstY, DstWidth, DstHeight: Integer;
|
||||
DX, DY, DW, DH: Integer);
|
||||
|
||||
procedure DrawTo(ACanvas: TCanvas; X, Y: Integer);
|
||||
procedure StretchTrunc(AWidth, AHeight: Integer); virtual;
|
||||
|
||||
procedure Rectangle(X1, Y1, X2, Y2: Integer);
|
||||
procedure Ellipse(X1, Y1, X2, Y2: Integer);
|
||||
|
||||
procedure Clear; override;
|
||||
procedure ClearWhite; override;
|
||||
procedure Invert; override;
|
||||
public
|
||||
function GetFillProcedure: TDrawPixelProcedure; virtual;
|
||||
function IsEmpty: Boolean;
|
||||
property BackgroundPen: TPen read FBGPen;
|
||||
property ForegroundPen: TPen read FFGPen;
|
||||
property FillMode: TMaskFillMode read FFillMode write FFillMode;
|
||||
end;
|
||||
|
||||
TSmoothMethod = (smAreaPixel, smBilinear, smBicubic);
|
||||
|
||||
{ TRGB32Bitmap }
|
||||
|
||||
TRGB32Bitmap = class(TRGB32BitmapCore)
|
||||
private
|
||||
FMask: TRGBMask;
|
||||
protected
|
||||
function CreateDefaultLazIntfImage: TLazIntfImage;
|
||||
public
|
||||
constructor Create(AWidth, AHeight: Integer); override;
|
||||
constructor CreateAsCopy(ABitmap: TRGBBitmapCore); override;
|
||||
constructor CreateFromLazIntfImage(AImage: TLazIntfImage); override;
|
||||
|
||||
constructor CreateFromFile(const FileName: String); virtual;
|
||||
constructor CreateFromBitmap(ABitmap: TRasterImage); virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure SwapWith(ABitmap: TRGBBitmapCore); override;
|
||||
procedure SaveToLazIntfImage(AImage: TLazIntfImage; const ARect: TRect); override;
|
||||
|
||||
procedure SaveToStream(Stream: TStream); virtual;
|
||||
procedure SaveToStream(Stream: TStream; AWriterClass: TFPCustomImageWriterClass); virtual;
|
||||
procedure SaveToStream(Stream: TStream; const ARect: TRect;
|
||||
AWriterClass: TFPCustomImageWriterClass); virtual;
|
||||
|
||||
procedure SaveToFile(const FileName: String); virtual;
|
||||
procedure SaveToLazarusResource(const FileName, Name: String); virtual;
|
||||
public
|
||||
procedure Draw(X, Y: Integer; ABitmap: TRGB32Bitmap);
|
||||
|
||||
procedure StretchTrunc(AWidth, AHeight: Integer); virtual;
|
||||
procedure StretchSmooth(AWidth, AHeight: Integer; Method: TSmoothMethod); virtual;
|
||||
|
||||
procedure Grayscale; virtual;
|
||||
procedure Disable; virtual;
|
||||
|
||||
procedure CutToClipboard; virtual;
|
||||
procedure CopyToClipboard; virtual;
|
||||
procedure Delete; virtual;
|
||||
|
||||
procedure FlipHorz; override;
|
||||
procedure FlipVert; override;
|
||||
procedure Rotate90; override;
|
||||
procedure Rotate180; override;
|
||||
procedure Rotate270; override;
|
||||
public
|
||||
property Mask: TRGBMask read FMask write FMask;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TRGB32Bitmap }
|
||||
|
||||
function TRGB32Bitmap.CreateDefaultLazIntfImage: TLazIntfImage;
|
||||
var
|
||||
RID: TRawImageDescription;
|
||||
DC: HDC;
|
||||
begin
|
||||
DC := GetDC(0);
|
||||
try
|
||||
RawImage_DescriptionFromDevice(DC, RID);
|
||||
finally
|
||||
ReleaseDC(0, DC);
|
||||
end;
|
||||
|
||||
Result := TLazIntfImage.Create(0, 0);
|
||||
Result.DataDescription := RID;
|
||||
end;
|
||||
|
||||
constructor TRGB32Bitmap.Create(AWidth, AHeight: Integer);
|
||||
begin
|
||||
inherited;
|
||||
FMask := TRGBMask.Create(AWidth, AHeight);
|
||||
end;
|
||||
|
||||
constructor TRGB32Bitmap.CreateAsCopy(ABitmap: TRGBBitmapCore);
|
||||
begin
|
||||
inherited;
|
||||
if ABitmap is TRGB32Bitmap then
|
||||
FMask := TRGBMask.CreateAsCopy((ABitmap as TRGB32Bitmap).Mask)
|
||||
else
|
||||
FMask := TRGBMask.Create(ABitmap.Width, ABitmap.Height);
|
||||
end;
|
||||
|
||||
constructor TRGB32Bitmap.CreateFromLazIntfImage(AImage: TLazIntfImage);
|
||||
begin
|
||||
inherited CreateFromLazIntfImage(AImage);
|
||||
FMask.LoadFromLazIntfImageAlpha(AImage);
|
||||
end;
|
||||
|
||||
constructor TRGB32Bitmap.CreateFromFile(const FileName: String);
|
||||
var
|
||||
Image: TLazIntfImage;
|
||||
begin
|
||||
Image := CreateDefaultLazIntfImage;
|
||||
try
|
||||
Image.LoadFromFile(FileName);
|
||||
CreateFromLazIntfImage(Image);
|
||||
finally
|
||||
Image.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TRGB32Bitmap.CreateFromBitmap(ABitmap: TRasterImage);
|
||||
var
|
||||
Image: TLazIntfImage;
|
||||
begin
|
||||
Image := ABitmap.CreateIntfImage;
|
||||
try
|
||||
CreateFromLazIntfImage(Image);
|
||||
finally
|
||||
Image.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TRGB32Bitmap.Destroy;
|
||||
begin
|
||||
FMask.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.Assign(Source: TPersistent);
|
||||
begin
|
||||
inherited Assign(Source);
|
||||
if Source is TRGB32Bitmap then
|
||||
begin
|
||||
Mask.Assign((Source as TRGB32Bitmap).Mask);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.SwapWith(ABitmap: TRGBBitmapCore);
|
||||
begin
|
||||
inherited SwapWith(ABitmap);
|
||||
if ABitmap is TRGB32Bitmap then
|
||||
begin
|
||||
Mask.SwapWith((ABitmap as TRGB32Bitmap).Mask);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.SaveToLazIntfImage(AImage: TLazIntfImage; const ARect: TRect);
|
||||
begin
|
||||
inherited SaveToLazIntfImage(AImage, ARect);
|
||||
if not Mask.IsEmpty then FMask.SaveToLazIntfImageAlpha(AImage, ARect);
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.SaveToStream(Stream: TStream);
|
||||
begin
|
||||
SaveToStream(Stream, Bounds(0, 0, Width, Height), TLazWriterXPM);
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.SaveToStream(Stream: TStream;
|
||||
AWriterClass: TFPCustomImageWriterClass);
|
||||
begin
|
||||
SaveToStream(Stream, Bounds(0, 0, Width, Height), AWriterClass);
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.SaveToStream(Stream: TStream; const ARect: TRect;
|
||||
AWriterClass: TFPCustomImageWriterClass);
|
||||
var
|
||||
Image: TLazIntfImage;
|
||||
Writer: TFPCustomImageWriter;
|
||||
begin
|
||||
Image := CreateDefaultLazIntfImage;
|
||||
Writer := AWriterClass.Create;
|
||||
try
|
||||
SaveToLazIntfImage(Image, ARect);
|
||||
Image.SaveToStream(Stream, Writer);
|
||||
finally
|
||||
Writer.Free;
|
||||
Image.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.SaveToFile(const FileName: String);
|
||||
var
|
||||
Image: TLazIntfImage;
|
||||
begin
|
||||
Image := CreateDefaultLazIntfImage;
|
||||
try
|
||||
inherited SaveToLazIntfImage(Image);
|
||||
Image.SaveToFile(FileName);
|
||||
finally
|
||||
Image.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.SaveToLazarusResource(const FileName, Name: String);
|
||||
var
|
||||
PixmapStream, ResourceStream: TMemoryStream;
|
||||
FileStream: TFileStream;
|
||||
begin
|
||||
PixmapStream := TMemoryStream.Create;
|
||||
ResourceStream := TMemoryStream.Create;
|
||||
try
|
||||
SaveToStream(PixmapStream);
|
||||
PixmapStream.Position := 0;
|
||||
|
||||
BinaryToLazarusResourceCode(PixmapStream, ResourceStream, Name, 'XPM');
|
||||
|
||||
ResourceStream.Position := 0;
|
||||
FileStream := TFileStream.Create(FileName, fmCreate);
|
||||
try
|
||||
FileStream.CopyFrom(ResourceStream, ResourceStream.Size);
|
||||
finally
|
||||
FileStream.Free;
|
||||
end;
|
||||
finally
|
||||
PixmapStream.Free;
|
||||
ResourceStream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.Draw(X, Y: Integer; ABitmap: TRGB32Bitmap);
|
||||
begin
|
||||
Canvas.Draw(X, Y, ABitmap);
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.StretchTrunc(AWidth, AHeight: Integer);
|
||||
var
|
||||
Result: TRGB32Bitmap;
|
||||
begin
|
||||
if (AWidth = Width) and (AHeight = Height) then Exit;
|
||||
Result := TRGB32Bitmap.Create(AWidth, AHeight);
|
||||
try
|
||||
// StretchRGB32BitmapTrunc(Result, Self);
|
||||
inherited SwapWith(Result);
|
||||
Mask.StretchTrunc(AWidth, AHeight);
|
||||
finally
|
||||
FreeAndNil(Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.StretchSmooth(AWidth, AHeight: Integer; Method: TSmoothMethod);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.Grayscale;
|
||||
begin
|
||||
GrayscaleRGB32Bitmap(Self);
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.Disable;
|
||||
begin
|
||||
DisableRGB32Bitmap(Self);
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.CutToClipboard;
|
||||
begin
|
||||
CopyToClipboard;
|
||||
Delete;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.CopyToClipboard;
|
||||
var
|
||||
PixmapStream, BitmapStream: TMemoryStream;
|
||||
PixmapWriter, BitmapWriter: TFPCustomImageWriter;
|
||||
Image: TLazIntfImage;
|
||||
R: TRect;
|
||||
begin
|
||||
PixmapStream := TMemoryStream.Create;
|
||||
BitmapStream := TMemoryStream.Create;
|
||||
Image := CreateDefaultLazIntfImage;
|
||||
PixmapWriter := TLazWriterXPM.Create;
|
||||
BitmapWriter := TFPWriterBMP.Create;
|
||||
try
|
||||
Clipboard.Open;
|
||||
try
|
||||
Clipboard.Clear;
|
||||
|
||||
Image.SaveToStream(PixmapStream, PixmapWriter);
|
||||
Clipboard.AddFormat(PredefinedClipboardFormat(pcfPixmap), PixmapStream);
|
||||
|
||||
Image.SaveToStream(BitmapStream, BitmapWriter);
|
||||
Clipboard.AddFormat(PredefinedClipboardFormat(pcfBitmap), BitmapStream);
|
||||
finally
|
||||
Clipboard.Close;
|
||||
end;
|
||||
finally
|
||||
PixmapStream.Free;
|
||||
BitmapStream.Free;
|
||||
Image.Free;
|
||||
PixmapWriter.Free;
|
||||
BitmapWriter.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.Delete;
|
||||
begin
|
||||
Fill(PaperColor);
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.FlipHorz;
|
||||
begin
|
||||
inherited FlipHorz;
|
||||
Mask.FlipHorz;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.FlipVert;
|
||||
begin
|
||||
inherited FlipVert;
|
||||
Mask.FlipVert;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.Rotate90;
|
||||
begin
|
||||
inherited Rotate90;
|
||||
Mask.Rotate90;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.Rotate180;
|
||||
begin
|
||||
inherited Rotate180;
|
||||
Mask.Rotate180;
|
||||
end;
|
||||
|
||||
procedure TRGB32Bitmap.Rotate270;
|
||||
begin
|
||||
inherited Rotate270;
|
||||
Mask.Rotate270;
|
||||
end;
|
||||
|
||||
{ TRGBMask }
|
||||
|
||||
procedure TRGBMask.CreatePens;
|
||||
begin
|
||||
FBGPen := TPen.Create;
|
||||
FBGPen.Color := clYellow;
|
||||
|
||||
FFGPen := TPen.Create;
|
||||
FFGPen.Color := clBlue;
|
||||
//FFGPen.Style := psDot;
|
||||
end;
|
||||
|
||||
function TRGBMask.GetFillProcedure: TDrawPixelProcedure;
|
||||
begin
|
||||
end;
|
||||
|
||||
constructor TRGBMask.Create(AWidth, AHeight: Integer);
|
||||
begin
|
||||
inherited Create(AWidth, AHeight);
|
||||
Clear;
|
||||
|
||||
CreatePens;
|
||||
end;
|
||||
|
||||
constructor TRGBMask.CreateAsCopy(ABitmap: TRGBBitmapCore);
|
||||
begin
|
||||
inherited CreateAsCopy(ABitmap);
|
||||
UpdateMaskedPixels;
|
||||
CreatePens;
|
||||
end;
|
||||
|
||||
procedure TRGBMask.SwapWith(ABitmap: TRGBBitmapCore);
|
||||
begin
|
||||
inherited SwapWith(ABitmap);
|
||||
UpdateMaskedPixels;
|
||||
end;
|
||||
|
||||
procedure TRGBMask.Assign(Source: TPersistent);
|
||||
begin
|
||||
inherited Assign(Source);
|
||||
UpdateMaskedPixels;
|
||||
end;
|
||||
|
||||
procedure TRGBMask.UpdateMaskedPixels;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBMask.Draw(X, Y: Integer; AMask: TRGBMask);
|
||||
begin
|
||||
// DrawRGB8Bitmap(Self, X, Y, AMask);
|
||||
UpdateMaskedPixels;
|
||||
end;
|
||||
|
||||
destructor TRGBMask.Destroy;
|
||||
begin
|
||||
FBGPen.Free;
|
||||
FFGPen.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TRGBMask.LoadFromLazIntfImageAlpha(AImage: TLazIntfImage);
|
||||
begin
|
||||
inherited LoadFromLazIntfImageAlpha(AImage);
|
||||
UpdateMaskedPixels;
|
||||
end;
|
||||
|
||||
procedure TRGBMask.DrawShapeTo(ACanvas: TCanvas; X, Y: Integer);
|
||||
begin
|
||||
StretchDrawShapeTo(ACanvas, X, Y, Width, Height);
|
||||
end;
|
||||
|
||||
procedure TRGBMask.StretchDrawShapeTo(ACanvas: TCanvas; DstX, DstY, DstWidth,
|
||||
DstHeight: Integer);
|
||||
begin
|
||||
StretchDrawShapePortionTo(ACanvas, DstX, DstY, DstWidth, DstHeight,
|
||||
0, 0, Width, Height);
|
||||
end;
|
||||
|
||||
procedure TRGBMask.StretchDrawShapePortionTo(ACanvas: TCanvas; DstX, DstY,
|
||||
DstWidth, DstHeight: Integer; DX, DY, DW, DH: Integer);
|
||||
begin
|
||||
if ACanvas <> nil then
|
||||
// StretchDrawRGBMaskShapePortion(ACanvas.Handle, DstX, DstY, DstWidth, DstHeight,
|
||||
// Self, DX, DY, DW, DH, FBGPen.Reference.Handle, FFGPen.Reference.Handle);
|
||||
end;
|
||||
|
||||
procedure TRGBMask.DrawTo(ACanvas: TCanvas; X, Y: Integer);
|
||||
begin
|
||||
if ACanvas <> nil then
|
||||
// DrawRGB8Bitmap(ACanvas.Handle, X, Y, 0, 0, Width, Height, Self);
|
||||
end;
|
||||
|
||||
procedure TRGBMask.StretchTrunc(AWidth, AHeight: Integer);
|
||||
var
|
||||
Result: TRGBMask;
|
||||
begin
|
||||
if (AWidth = Width) and (AHeight = Height) then Exit;
|
||||
Result := TRGBMask.Create(AWidth, AHeight);
|
||||
try
|
||||
// StretchRGB8BitmapTrunc(Result, Self);
|
||||
SwapWith(Result);
|
||||
finally
|
||||
FreeAndNil(Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGBMask.Rectangle(X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
//FillPixelRect(X1, Y1, X2, Y2, GetFillProcedure);
|
||||
end;
|
||||
|
||||
procedure TRGBMask.Ellipse(X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
//EllipticRectangle(X1, Y1, X2, Y2, 0, 0, GetFillProcedure, GetFillProcedure);
|
||||
end;
|
||||
|
||||
procedure TRGBMask.Clear;
|
||||
begin
|
||||
inherited Clear;
|
||||
FMaskedPixels := 0;
|
||||
end;
|
||||
|
||||
procedure TRGBMask.ClearWhite;
|
||||
begin
|
||||
inherited ClearWhite;
|
||||
|
||||
FMaskedPixels := Width * Height;
|
||||
end;
|
||||
|
||||
procedure TRGBMask.Invert;
|
||||
begin
|
||||
inherited Invert;
|
||||
|
||||
FMaskedPixels := Width * Height - FMaskedPixels;
|
||||
end;
|
||||
|
||||
function TRGBMask.IsEmpty: Boolean;
|
||||
begin
|
||||
Result := FMaskedPixels = 0;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
771
applications/lazimageeditor/bmprgbtypes.pas
Normal file
771
applications/lazimageeditor/bmprgbtypes.pas
Normal file
@ -0,0 +1,771 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
RGBTypes.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:
|
||||
TRGB32Pixel - TRGB32Bitmap picture element, contains red, green and blue
|
||||
component and is platform dependent!
|
||||
TRGBBitmapCore - universal RGB bitmap core.
|
||||
TRGB32BitmapCore - 32-bit core of TRGB32Bitmap.
|
||||
}
|
||||
unit BmpRGBTypes;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}{$H+}
|
||||
{$endif}
|
||||
|
||||
{$ifdef LCLwin32}
|
||||
{$define RGB}
|
||||
{$endif}
|
||||
{$ifdef LCLqt}
|
||||
{$define RGB}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FPImage, IntfGraphics, Graphics, Math, LCLProc,
|
||||
BmpRGBUtils;
|
||||
|
||||
const
|
||||
MAXRANDOMDENSITY = $FFFF;
|
||||
|
||||
type
|
||||
TRandomDensity = Word;
|
||||
TDrawMode = (dmFillAndOutline, dmOutline, dmFill);
|
||||
TEraseMode = (ermNone, ermErase, ermReplace);
|
||||
TDrawPixelProcedure = procedure (X, Y: Integer) of Object;
|
||||
|
||||
TPixelDifference = Word;
|
||||
const
|
||||
MAXDIFFERENCE = 255 + 255 + 255;
|
||||
type
|
||||
// integral float with 1/256 precision
|
||||
TIntensityFloat = Integer;
|
||||
TIntensityFloatTable = Array [0..255] of TIntensityFloat;
|
||||
|
||||
{ TRGBBitmapCore }
|
||||
|
||||
TRGBBitmapCore = class(TBitmap)
|
||||
private
|
||||
FSizeOfPixel: Integer;
|
||||
FRowPixelStride: Integer;
|
||||
FDataOwner: Boolean;
|
||||
FDrawMode: TDrawMode;
|
||||
FEraseMode: TEraseMode;
|
||||
FFillColor: TColor;
|
||||
FFloodFillTolerance: TPixelDifference;
|
||||
FOutlineColor: TColor;
|
||||
FPaperColor: TColor;
|
||||
FRandomDensity: TRandomDensity;
|
||||
FRandomEnabled: Boolean;
|
||||
FRectangleRoundness: Integer;
|
||||
function GetFillColor: TColor;
|
||||
function GetOutlineColor: TColor;
|
||||
function GetPaperColor: TColor;
|
||||
procedure SetFillColor(const AValue: TColor);
|
||||
procedure SetOutlineColor(const AValue: TColor);
|
||||
procedure SetPaperColor(const AValue: TColor);
|
||||
function GetSize: Integer;
|
||||
protected
|
||||
function PixelMasked(X, Y: Integer): Boolean;
|
||||
|
||||
procedure DrawOutlinePixel(X, Y: Integer);
|
||||
procedure DrawFillPixel(X, Y: Integer);
|
||||
procedure DrawPaperPixel(X, Y: Integer);
|
||||
|
||||
procedure DrawReplacePixel(X, Y: Integer);
|
||||
|
||||
procedure DrawRandomOutlinePixel(X, Y: Integer);
|
||||
procedure DrawRandomFillPixel(X, Y: Integer);
|
||||
procedure DrawRandomPaperPixel(X, Y: Integer);
|
||||
|
||||
procedure DrawEmptyPixel(X, Y: Integer);
|
||||
|
||||
function GetOutlineProcedure: TDrawPixelProcedure; virtual;
|
||||
function GetFillProcedure: TDrawPixelProcedure; virtual;
|
||||
public
|
||||
constructor Create(AWidth, AHeight: Integer; ASizeOfPixel: Integer); virtual;
|
||||
constructor CreateAsCopy(ABitmap: TRGBBitmapCore; ASizeOfPixel: Integer); virtual;
|
||||
constructor CreateFromData(AData: Pointer; AWidth, AHeight: Integer; ASizeOfPixel: Integer; ADataOwner: Boolean = False); virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure SwapWith(ABitmap: TRGBBitmapCore); virtual;
|
||||
public
|
||||
procedure Clear; virtual;
|
||||
procedure ClearWhite; virtual;
|
||||
procedure Invert; virtual;
|
||||
|
||||
procedure FlipHorz; virtual;
|
||||
procedure FlipVert; virtual;
|
||||
procedure Rotate90; virtual;
|
||||
procedure Rotate180; virtual;
|
||||
procedure Rotate270; virtual;
|
||||
public
|
||||
procedure SetColor(X, Y: Integer; Value: TColor);
|
||||
function GetColor(X, Y: Integer): TColor;
|
||||
|
||||
procedure Fill(Color: TColor);
|
||||
procedure FillEllipse(X1, Y1, X2, Y2: Integer);
|
||||
procedure MaskFloodFill(X, Y: Integer);
|
||||
// Alpha drawing methods
|
||||
procedure AlphaRectangle(X1, Y1, X2, Y2, AAlpha: Integer);
|
||||
// Effect drawing methods
|
||||
procedure FuzzyRectangle(X1, Y1, X2, Y2: Integer);
|
||||
public
|
||||
procedure DrawTo(ACanvas: TCanvas; X, Y: Integer);
|
||||
procedure StretchDrawTo(ACanvas: TCanvas; DstX, DstY, DstWidth, DstHeight: Integer);
|
||||
|
||||
property EraseMode: TEraseMode read FEraseMode write FEraseMode;
|
||||
property DrawMode: TDrawMode read FDrawMode write FDrawMode;
|
||||
property FloodFillTolerance: TPixelDifference read FFloodFillTolerance
|
||||
write FFloodFillTolerance;
|
||||
|
||||
property Width;
|
||||
property Height;
|
||||
|
||||
property FillColor: TColor read GetFillColor write SetFillColor;
|
||||
property OutlineColor: TColor read GetOutlineColor write SetOutlineColor;
|
||||
property PaperColor: TColor read GetPaperColor write SetPaperColor;
|
||||
|
||||
property RandomEnabled: Boolean read FRandomEnabled write FRandomEnabled;
|
||||
property RandomDensity: TRandomDensity read FRandomDensity write FRandomDensity;
|
||||
|
||||
property RectangleRoundness: Integer read FRectangleRoundness write FRectangleRoundness;
|
||||
property DataOwner: Boolean read FDataOwner;
|
||||
property Size: Integer read GetSize;
|
||||
property SizeOfPixel: Integer read FSizeOfPixel;
|
||||
end;
|
||||
|
||||
{ TRGB8BitmapCore }
|
||||
|
||||
TRGB8BitmapCore = class(TRGBBitmapCore)
|
||||
public
|
||||
constructor Create(AWidth, AHeight: Integer); virtual;
|
||||
constructor CreateAsCopy(ABitmap: TRGBBitmapCore); virtual;
|
||||
constructor CreateFromData(AData: Pointer; AWidth, AHeight: Integer; ADataOwner: Boolean = False); virtual;
|
||||
|
||||
procedure LoadFromLazIntfImageAlpha(AImage: TLazIntfImage); virtual;
|
||||
procedure SaveToLazIntfImageAlpha(AImage: TLazIntfImage); virtual;
|
||||
procedure SaveToLazIntfImageAlpha(AImage: TLazIntfImage; const ARect: TRect); virtual;
|
||||
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure SwapWith(ABitmap: TRGBBitmapCore); override;
|
||||
public
|
||||
end;
|
||||
|
||||
{ TRGB32BitmapCore }
|
||||
|
||||
TRGB32BitmapCore = class(TRGBBitmapCore)
|
||||
private
|
||||
public
|
||||
constructor Create(AWidth, AHeight: Integer); virtual;
|
||||
constructor CreateAsCopy(ABitmap: TRGBBitmapCore); virtual;
|
||||
constructor CreateFromLazIntfImage(AImage: TLazIntfImage); virtual;
|
||||
constructor CreateFromData(AData: Pointer; AWidth, AHeight: Integer; ADataOwner: Boolean = False); virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure SwapWith(ABitmap: TRGBBitmapCore); override;
|
||||
procedure SaveToLazIntfImage(AImage: TLazIntfImage); virtual;
|
||||
procedure SaveToLazIntfImage(AImage: TLazIntfImage; const ARect: TRect); virtual;
|
||||
public
|
||||
published
|
||||
end;
|
||||
|
||||
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);
|
||||
|
||||
implementation
|
||||
|
||||
uses BmpRGBGraph;
|
||||
|
||||
function AbsByte(Src: Integer): Byte; inline;
|
||||
begin
|
||||
if Src >= 0 then Result := Src
|
||||
else Result := -Src;
|
||||
end;
|
||||
|
||||
function RoundIntensityFloatInline(V: TIntensityFloat): Byte; inline;
|
||||
begin
|
||||
Result := Max(0, Min(255, (V + 128) shr 8));
|
||||
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 FlipHorzRGBBitmap(Bitmap: TRGBBitmapCore);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure FlipVertRGBBitmap(Bitmap: TRGBBitmapCore);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure Rotate90CWRGBBitmap(Bitmap: TRGBBitmapCore);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure Rotate180CWRGBBitmap(Bitmap: TRGBBitmapCore);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure Rotate270CWRGBBitmap(Bitmap: TRGBBitmapCore);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure InvertRGBBitmap(Bitmap: TRGBBitmapCore);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure GrayscaleRGB32Bitmap(Bitmap: TRGB32BitmapCore);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure DisableRGB32Bitmap(Bitmap: TRGB32BitmapCore);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ TRGBBitmapCore }
|
||||
|
||||
function TRGBBitmapCore.GetSize: Integer;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
constructor TRGBBitmapCore.Create(AWidth, AHeight: Integer; ASizeOfPixel: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
Width := AWidth;
|
||||
Height := AHeight;
|
||||
// TODO: check on 64-bit arch.
|
||||
// 32-bit alignment
|
||||
FRowPixelStride := (((AWidth * ASizeOfPixel + 3) shr 2) shl 2) div ASizeOfPixel;
|
||||
FSizeOfPixel := ASizeOfPixel;
|
||||
|
||||
FDataOwner := True;
|
||||
|
||||
FRandomDensity := MAXRANDOMDENSITY;
|
||||
FFloodFillTolerance := 0;
|
||||
FRectangleRoundness := 0;
|
||||
end;
|
||||
|
||||
constructor TRGBBitmapCore.CreateAsCopy(ABitmap: TRGBBitmapCore; ASizeOfPixel: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
Width := ABitmap.Width;
|
||||
Height := ABitmap.Height;
|
||||
FSizeOfPixel := ASizeOfPixel;
|
||||
|
||||
FDataOwner := True;
|
||||
end;
|
||||
|
||||
constructor TRGBBitmapCore.CreateFromData(AData: Pointer; AWidth, AHeight: Integer;
|
||||
ASizeOfPixel: Integer; ADataOwner: Boolean);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
Width := AWidth;
|
||||
Height := AHeight;
|
||||
// TODO: check on 64-bit arch.
|
||||
// 32-bit alignment
|
||||
FRowPixelStride := (((AWidth * ASizeOfPixel + 3) shr 2) shl 2) div ASizeOfPixel;
|
||||
FSizeOfPixel := ASizeOfPixel;
|
||||
FDataOwner := ADataOwner;
|
||||
end;
|
||||
|
||||
destructor TRGBBitmapCore.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.Assign(Source: TPersistent);
|
||||
begin
|
||||
if Source = nil then Exit;
|
||||
if Source = Self then Exit;
|
||||
if Source is TRGBBitmapCore then
|
||||
begin
|
||||
Width := (Source as TRGBBitmapCore).Width;
|
||||
Height := (Source as TRGBBitmapCore).Height;
|
||||
FSizeOfPixel := (Source as TRGBBitmapCore).SizeOfPixel;
|
||||
end
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.SwapWith(ABitmap: TRGBBitmapCore);
|
||||
begin
|
||||
if ABitmap = nil then Exit;
|
||||
SwapInt(Width, ABitmap.Width);
|
||||
SwapInt(Height, ABitmap.Height);
|
||||
SwapInt(FRowPixelStride, ABitmap.FRowPixelStride);
|
||||
SwapInt(FSizeOfPixel, ABitmap.FSizeOfPixel);
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.Clear;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.ClearWhite;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.Invert;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.FlipHorz;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.FlipVert;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.Rotate90;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.Rotate180;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.Rotate270;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.SetColor(X, Y: Integer; Value: TColor);
|
||||
begin
|
||||
Canvas.Pixels[X, Y] := Value;
|
||||
end;
|
||||
|
||||
function TRGBBitmapCore.GetColor(X, Y: Integer): TColor;
|
||||
begin
|
||||
if (X > 0) and (X < Width) and (Y > 0) and (Y < Height) then Result := Canvas.Pixels[X, Y]
|
||||
else Result := clNone;
|
||||
end;
|
||||
|
||||
function TRGBBitmapCore.GetFillColor: TColor;
|
||||
begin
|
||||
Result := FFillColor;
|
||||
end;
|
||||
|
||||
function TRGBBitmapCore.GetOutlineColor: TColor;
|
||||
begin
|
||||
Result := FOutlineColor;
|
||||
end;
|
||||
|
||||
function TRGBBitmapCore.GetPaperColor: TColor;
|
||||
begin
|
||||
Result := FPaperColor;
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.SetFillColor(const AValue: TColor);
|
||||
begin
|
||||
FFillColor := AValue;
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.SetOutlineColor(const AValue: TColor);
|
||||
begin
|
||||
FOutlineColor := AValue;
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.SetPaperColor(const AValue: TColor);
|
||||
begin
|
||||
FPaperColor := AValue;
|
||||
end;
|
||||
|
||||
function TRGBBitmapCore.PixelMasked(X, Y: Integer): Boolean;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.DrawOutlinePixel(X, Y: Integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.DrawFillPixel(X, Y: Integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.DrawPaperPixel(X, Y: Integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.DrawReplacePixel(X, Y: Integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.DrawRandomOutlinePixel(X, Y: Integer);
|
||||
begin
|
||||
if PixelMasked(X, Y) and (Random(MAXRANDOMDENSITY) < FRandomDensity) then
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.DrawRandomFillPixel(X, Y: Integer);
|
||||
begin
|
||||
if PixelMasked(X, Y) and (Random(MAXRANDOMDENSITY) < FRandomDensity) then
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.DrawRandomPaperPixel(X, Y: Integer);
|
||||
begin
|
||||
if PixelMasked(X, Y) and (Random(MAXRANDOMDENSITY) < FRandomDensity) then
|
||||
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.DrawEmptyPixel(X, Y: Integer);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
function TRGBBitmapCore.GetOutlineProcedure: TDrawPixelProcedure;
|
||||
begin
|
||||
if not FRandomEnabled then
|
||||
begin
|
||||
case DrawMode of
|
||||
dmFillAndOutline, dmOutline:
|
||||
begin
|
||||
case EraseMode of
|
||||
ermNone: Result := @DrawOutlinePixel;
|
||||
ermErase: Result := @DrawPaperPixel;
|
||||
ermReplace: Result := @DrawReplacePixel;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
Result := @DrawEmptyPixel;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
case EraseMode of
|
||||
ermNone: Result := @DrawRandomFillPixel;
|
||||
ermErase: Result := @DrawRandomPaperPixel;
|
||||
ermReplace: Result := @DrawRandomFillPixel;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRGBBitmapCore.GetFillProcedure: TDrawPixelProcedure;
|
||||
begin
|
||||
if not FRandomEnabled then
|
||||
begin
|
||||
case DrawMode of
|
||||
dmFillAndOutline, dmFill:
|
||||
begin
|
||||
case EraseMode of
|
||||
ermNone: Result := @DrawFillPixel;
|
||||
ermErase: Result := @DrawPaperPixel;
|
||||
ermReplace: Result := @DrawReplacePixel;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
Result := @DrawEmptyPixel;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
case EraseMode of
|
||||
ermNone: Result := @DrawRandomFillPixel;
|
||||
ermErase: Result := @DrawRandomPaperPixel;
|
||||
ermReplace: Result := @DrawRandomFillPixel;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.Fill(Color: TColor);
|
||||
var
|
||||
I, J: Integer;
|
||||
begin
|
||||
Canvas.Brush.Color := Color;
|
||||
Canvas.FillRect(Rect(0, 0, Width, Height));
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.FillEllipse(X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
Canvas.Brush.Color := clRed;
|
||||
Canvas.FillRect(Rect(0, 0, Width, Height));
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.MaskFloodFill(X, Y: Integer);
|
||||
begin
|
||||
Canvas.Brush.Color := clBlack;
|
||||
Canvas.FillRect(Rect(0, 0, Width, Height));
|
||||
end;
|
||||
|
||||
// AAlpha is the alpha of the rectangle, ranging from
|
||||
// 0 - fully transparent to 100 - fully opaque
|
||||
procedure TRGBBitmapCore.AlphaRectangle(X1, Y1, X2, Y2, AAlpha: Integer);
|
||||
var
|
||||
OldColor, NewColor: Integer;
|
||||
X, Y: LongInt;
|
||||
OldR, OldG, OldB, NewR, NewG, NewB: Byte;
|
||||
begin
|
||||
// If the rectangle is fully opaque this is the same as a normal rectangle
|
||||
if AAlpha = 100 then
|
||||
begin
|
||||
Canvas.Rectangle(X1, Y1, X2, Y2);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// if it is fully transparent there is nothing to draw
|
||||
if AAlpha = 0 then Exit;
|
||||
|
||||
// A partially transparent rectangle
|
||||
for Y := Y1 to Y2 do
|
||||
for X := X1 to X2 do
|
||||
begin
|
||||
OldColor := GetColor(X, Y);
|
||||
RedGreenBlue(OldColor, OldR, OldG, OldB);
|
||||
|
||||
NewR := ((100 - AAlpha) * OldR + AAlpha * Red(FillColor)) div 100;
|
||||
NewG := ((100 - AAlpha) * OldG + AAlpha * Green(FillColor)) div 100;
|
||||
NewB := ((100 - AAlpha) * OldB + AAlpha * Blue(FillColor)) div 100;
|
||||
|
||||
SetColor(X, Y, RGBToColor(NewR, NewG, NewB));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.FuzzyRectangle(X1, Y1, X2, Y2: Integer);
|
||||
var
|
||||
X, Y: LongInt;
|
||||
deltaX, deltaY: Integer;
|
||||
begin
|
||||
for Y := Y1 to Y2 do
|
||||
for X := X1 to X2 do
|
||||
begin
|
||||
// This computation has a good effect of making text illegible,
|
||||
// but keeping the overal image with the same colors
|
||||
deltaX := X mod 5;
|
||||
deltaY := deltaX;
|
||||
|
||||
// Makes sure we won't get any invalid pixel positions
|
||||
if X < 5 then deltaX := -deltaX;
|
||||
if Y < 5 then deltaY := -deltaY;
|
||||
|
||||
// Change the color
|
||||
SetColor(X, Y, GetColor(X - deltaX, Y - deltaY));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.DrawTo(ACanvas: TCanvas; X, Y: Integer);
|
||||
begin
|
||||
if ACanvas <> nil then
|
||||
ACanvas.Draw(X, Y, Self);
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.StretchDrawTo(ACanvas: TCanvas; DstX, DstY, DstWidth,
|
||||
DstHeight: Integer);
|
||||
begin
|
||||
if ACanvas <> nil then
|
||||
ACanvas.StretchDraw(Rect(DstX, DstY, DstWidth, DstHeight), Self);
|
||||
end;
|
||||
|
||||
{ TRGB32BitmapCore }
|
||||
|
||||
constructor TRGB32BitmapCore.Create(AWidth, AHeight: Integer);
|
||||
begin
|
||||
inherited Create(AWidth, AHeight, 1);
|
||||
end;
|
||||
|
||||
constructor TRGB32BitmapCore.CreateAsCopy(ABitmap: TRGBBitmapCore);
|
||||
begin
|
||||
if ABitmap.SizeOfPixel = 0 then
|
||||
inherited CreateAsCopy(ABitmap, 1);
|
||||
end;
|
||||
|
||||
constructor TRGB32BitmapCore.CreateFromLazIntfImage(AImage: TLazIntfImage);
|
||||
var
|
||||
I, J: Integer;
|
||||
begin
|
||||
Create(AImage.Width, AImage.Height);
|
||||
|
||||
for J := 0 to Pred(Height) do
|
||||
begin
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TRGB32BitmapCore.CreateFromData(AData: Pointer; AWidth, AHeight: Integer;
|
||||
ADataOwner: Boolean);
|
||||
begin
|
||||
inherited CreateFromData(AData, AWidth, AHeight, 0, ADataOwner);
|
||||
end;
|
||||
|
||||
procedure TRGB32BitmapCore.Assign(Source: TPersistent);
|
||||
begin
|
||||
if (Source is TRGBBitmapCore) and ((Source as TRGBBitmapCore).SizeOfPixel = 0) then
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
procedure TRGB32BitmapCore.SwapWith(ABitmap: TRGBBitmapCore);
|
||||
begin
|
||||
if ABitmap.SizeOfPixel = 0 then
|
||||
inherited SwapWith(ABitmap);
|
||||
end;
|
||||
|
||||
procedure TRGB32BitmapCore.SaveToLazIntfImage(AImage: TLazIntfImage);
|
||||
begin
|
||||
SaveToLazIntfImage(AImage, Bounds(0, 0, Width, Height));
|
||||
end;
|
||||
|
||||
procedure TRGB32BitmapCore.SaveToLazIntfImage(AImage: TLazIntfImage; const ARect: TRect);
|
||||
var
|
||||
I, J: Integer;
|
||||
W, H: Integer;
|
||||
begin
|
||||
W := ARect.Right - ARect.Left;
|
||||
H := ARect.Bottom - ARect.Top;
|
||||
AImage.SetSize(W, H);
|
||||
try
|
||||
for J := 0 to Pred(H) do
|
||||
begin
|
||||
|
||||
for I := 0 to Pred(W) do
|
||||
begin
|
||||
|
||||
|
||||
end;
|
||||
end;
|
||||
except
|
||||
AImage.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TRGB32BitmapCore.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
{ TRGB8BitmapCore }
|
||||
|
||||
constructor TRGB8BitmapCore.Create(AWidth, AHeight: Integer);
|
||||
begin
|
||||
inherited Create(AWidth, AHeight, 1);
|
||||
end;
|
||||
|
||||
constructor TRGB8BitmapCore.CreateAsCopy(ABitmap: TRGBBitmapCore);
|
||||
begin
|
||||
if ABitmap.SizeOfPixel = 0 then
|
||||
inherited CreateAsCopy(ABitmap, 1);
|
||||
end;
|
||||
|
||||
constructor TRGB8BitmapCore.CreateFromData(AData: Pointer; AWidth, AHeight: Integer;
|
||||
ADataOwner: Boolean);
|
||||
begin
|
||||
inherited CreateFromData(AData, AWidth, AHeight, 0, ADataOwner);
|
||||
end;
|
||||
|
||||
procedure TRGB8BitmapCore.LoadFromLazIntfImageAlpha(AImage: TLazIntfImage);
|
||||
var
|
||||
I, J: Integer;
|
||||
begin
|
||||
for J := 0 to Pred(Height) do
|
||||
begin
|
||||
for I := 0 to Pred(Width) do
|
||||
begin
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGB8BitmapCore.SaveToLazIntfImageAlpha(AImage: TLazIntfImage);
|
||||
begin
|
||||
SaveToLazIntfImageAlpha(AImage, Bounds(0, 0, Width, Height));
|
||||
end;
|
||||
|
||||
procedure TRGB8BitmapCore.SaveToLazIntfImageAlpha(AImage: TLazIntfImage;
|
||||
const ARect: TRect);
|
||||
var
|
||||
I, J: Integer;
|
||||
F: TFPColor;
|
||||
begin
|
||||
for J := 0 to Pred(AImage.Height) do
|
||||
begin
|
||||
for I := 0 to Pred(AImage.Width) do
|
||||
begin
|
||||
F := AImage.Colors[I, J];
|
||||
// F.alpha := P^ shl 8;
|
||||
AImage.Colors[I, J] := F;
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRGB8BitmapCore.Assign(Source: TPersistent);
|
||||
begin
|
||||
if (Source is TRGBBitmapCore) and ((Source as TRGBBitmapCore).SizeOfPixel = 0) then
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
procedure TRGB8BitmapCore.SwapWith(ABitmap: TRGBBitmapCore);
|
||||
begin
|
||||
inherited SwapWith(ABitmap);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
184
applications/lazimageeditor/bmprgbutils.pas
Normal file
184
applications/lazimageeditor/bmprgbutils.pas
Normal file
@ -0,0 +1,184 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
RGBUtils.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:
|
||||
}
|
||||
unit BmpRGBUtils;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}{$H+}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TIntArray = array of Integer;
|
||||
|
||||
function DivideTrunc(Src, Dest: Integer): TIntArray;
|
||||
function GetMidPoints(const A: TIntArray): TIntArray;
|
||||
function GetDifference(const A: TIntArray): TIntArray;
|
||||
|
||||
procedure SwapInt(A, B: Integer);
|
||||
procedure SwapPtr(var A, B: Pointer);
|
||||
procedure MinMax(var A, B: Integer);
|
||||
|
||||
procedure SortRect(var X1, Y1, X2, Y2: Integer); overload;
|
||||
procedure SortRect(var R: TRect); overload;
|
||||
|
||||
procedure ClipDimension(ClipMin, ClipMax: Integer;
|
||||
var DstPos, SrcPos, SrcSize: Integer);
|
||||
|
||||
operator =(A, B: TPoint): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
(*
|
||||
DivideTrunc divides bigger value of Src and Dest into array of chunks.
|
||||
Length(Result) = Min(Src, Dest)
|
||||
*)
|
||||
function DivideTrunc(Src, Dest: Integer): TIntArray;
|
||||
var
|
||||
I: Integer;
|
||||
VMax, VMin: Integer;
|
||||
P, D: Single;
|
||||
begin
|
||||
if Dest > Src then
|
||||
begin
|
||||
VMax := Dest;
|
||||
VMin := Src;
|
||||
end
|
||||
else
|
||||
begin
|
||||
VMax := Src;
|
||||
VMin := Dest;
|
||||
end;
|
||||
SetLength(Result, VMin);
|
||||
|
||||
P := 0;
|
||||
D := VMax / VMin;
|
||||
for I := 0 to High(Result) do
|
||||
begin
|
||||
Result[I] := Round(P + D) - Round(P);
|
||||
P := P + D;
|
||||
end;
|
||||
end;
|
||||
|
||||
(*
|
||||
GetMidPoints returns array of absolute positions of the middle in each chunk.
|
||||
*)
|
||||
function GetMidPoints(const A: TIntArray): TIntArray;
|
||||
var
|
||||
I, P, V: Integer;
|
||||
begin
|
||||
SetLength(Result, Length(A));
|
||||
P := 0;
|
||||
for I := 0 to High(A) do
|
||||
begin
|
||||
V := A[I];
|
||||
Result[I] := V shr 1 + P;
|
||||
Inc(P, V);
|
||||
end;
|
||||
end;
|
||||
|
||||
(*
|
||||
GetDifference returns array of diffences between positions.
|
||||
*)
|
||||
function GetDifference(const A: TIntArray): TIntArray;
|
||||
var
|
||||
I, P: Integer;
|
||||
begin
|
||||
SetLength(Result, Length(A));
|
||||
P := 0;
|
||||
for I := 0 to High(A) do
|
||||
begin
|
||||
Result[I] := A[I] - P;
|
||||
P := A[I];
|
||||
end;
|
||||
end;
|
||||
|
||||
operator =(A, B: TPoint): Boolean;
|
||||
begin
|
||||
Result := (A.X = B.X) and (A.Y = B.Y);
|
||||
end;
|
||||
|
||||
procedure SwapInt(A, B: Integer);
|
||||
var
|
||||
C: Integer;
|
||||
begin
|
||||
C := A;
|
||||
A := B;
|
||||
B := C;
|
||||
end;
|
||||
|
||||
procedure SwapPtr(var A, B: Pointer);
|
||||
var
|
||||
C: Pointer;
|
||||
begin
|
||||
C := A;
|
||||
A := B;
|
||||
B := C;
|
||||
end;
|
||||
|
||||
procedure MinMax(var A, B: Integer);
|
||||
var
|
||||
T: Integer;
|
||||
begin
|
||||
if A > B then
|
||||
begin
|
||||
T := A;
|
||||
A := B;
|
||||
B := T;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SortRect(var X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
MinMax(X1, X2);
|
||||
MinMax(Y1, Y2);
|
||||
end;
|
||||
|
||||
procedure SortRect(var R: TRect);
|
||||
begin
|
||||
MinMax(R.Left, R.Right);
|
||||
MinMax(R.Top, R.Bottom);
|
||||
end;
|
||||
|
||||
procedure ClipDimension(ClipMin, ClipMax: Integer;
|
||||
var DstPos, SrcPos, SrcSize: Integer);
|
||||
var
|
||||
C: Integer;
|
||||
begin
|
||||
if ClipMin > DstPos then
|
||||
begin
|
||||
C := ClipMin - DstPos;
|
||||
Inc(SrcPos, C);
|
||||
Dec(SrcSize, C);
|
||||
DstPos := ClipMin;
|
||||
end;
|
||||
|
||||
if ClipMax < DstPos + SrcSize then SrcSize := ClipMax - DstPos;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
@ -31,7 +31,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLType, LCLIntf, Controls, Forms, ExtCtrls, Graphics, Math,
|
||||
ImgEditorGraphics, ImgEditorUtils, ImgEditorTypes;
|
||||
BmpRGBGraph, BmpRGBUtils, BmpRGBTypes;
|
||||
|
||||
type
|
||||
TPictureViewOption = (poShowGrid, poShowMask);
|
||||
|
@ -31,7 +31,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
Buttons, StdCtrls, ComCtrls, PictureCtrls, Math, ImgEditorGraphics, PictureDialog;
|
||||
Buttons, StdCtrls, ComCtrls, PictureCtrls, Math, BmpRGBGraph, PictureDialog;
|
||||
|
||||
type
|
||||
|
||||
|
Reference in New Issue
Block a user