sync: restore source from Google Drive
Sync changed files to Google Drive / sync (push) Successful in 1h45m13s
Sync changed files to Google Drive / sync (push) Successful in 1h45m13s
This commit is contained in:
admin_d committed
1 parent
e2d8247e91
commit
7063d1b1c9
993 files changed
+949976
No files matched your search
@@ -0,0 +1,761 @@
|
||||
// SPDX-License-Identifier: LGPL-3.0-linking-exception
|
||||
unit BGRADithering;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
BGRAClasses, SysUtils, BGRAFilterType, BGRAPalette, BGRABitmapTypes;
|
||||
|
||||
type
|
||||
TOutputPixelProc = procedure(X,Y: Int32or64; AColorIndex: Int32or64; AColor: TBGRAPixel) of object;
|
||||
|
||||
{ TDitheringTask }
|
||||
|
||||
TDitheringTask = class(TFilterTask)
|
||||
protected
|
||||
FBounds: TRect;
|
||||
FIgnoreAlpha: boolean;
|
||||
FPalette: TBGRACustomApproxPalette;
|
||||
FCurrentOutputScanline: PBGRAPixel;
|
||||
FCurrentOutputY: Int32or64;
|
||||
FOutputPixel : TOutputPixelProc;
|
||||
FDrawMode: TDrawMode;
|
||||
procedure UpdateCurrentLine(Y: Int32or64); inline;
|
||||
procedure OutputPixel(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
|
||||
procedure OutputPixelSet(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
|
||||
procedure OutputPixelSetExceptTransparent(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
|
||||
procedure OutputPixelLinearBlend(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
|
||||
procedure OutputPixelDraw(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
|
||||
procedure OutputPixelXor(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
|
||||
procedure ApproximateColor(const AColor: TBGRAPixel; out AApproxColor: TBGRAPixel; out AIndex: integer);
|
||||
procedure SetDrawMode(AValue: TDrawMode);
|
||||
procedure UpdateOutputPixel;
|
||||
public
|
||||
constructor Create(ASource: IBGRAScanner; APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap; AIgnoreAlpha: boolean; ABounds: TRect); overload;
|
||||
constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean; ABounds: TRect); overload;
|
||||
constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean); overload;
|
||||
property OnOutputPixel: TOutputPixelProc read FOutputPixel write FOutputPixel;
|
||||
property DrawMode: TDrawMode read FDrawMode write SetDrawMode;
|
||||
end;
|
||||
|
||||
{ TNearestColorTask }
|
||||
|
||||
TNearestColorTask = class(TDitheringTask)
|
||||
protected
|
||||
procedure DoExecute; override;
|
||||
end;
|
||||
|
||||
{ TFloydSteinbergDitheringTask }
|
||||
|
||||
TFloydSteinbergDitheringTask = class(TDitheringTask)
|
||||
protected
|
||||
procedure DoExecute; override;
|
||||
end;
|
||||
|
||||
{ TDitheringToIndexedImage }
|
||||
|
||||
TDitheringToIndexedImage = class
|
||||
protected
|
||||
FBitOrder: TRawImageBitOrder;
|
||||
FByteOrder: TRawImageByteOrder;
|
||||
FBitsPerPixel: integer;
|
||||
FLineOrder: TRawImageLineOrder;
|
||||
FPalette: TBGRACustomApproxPalette;
|
||||
FIgnoreAlpha: boolean;
|
||||
FTransparentColorIndex: Int32or64;
|
||||
|
||||
//following variables are used during dithering
|
||||
FCurrentScanlineSize: PtrInt;
|
||||
FCurrentData: PByte;
|
||||
FCurrentOutputY: Int32or64;
|
||||
FCurrentOutputScanline: PByte;
|
||||
FCurrentBitOrderMask: Int32or64;
|
||||
FCurrentMaxY: Int32or64;
|
||||
|
||||
procedure SetPalette(AValue: TBGRACustomApproxPalette);
|
||||
procedure SetIgnoreAlpha(AValue: boolean);
|
||||
procedure SetLineOrder(AValue: TRawImageLineOrder);
|
||||
procedure SetBitOrder(AValue: TRawImageBitOrder); virtual;
|
||||
procedure SetBitsPerPixel(AValue: integer); virtual;
|
||||
procedure SetByteOrder(AValue: TRawImageByteOrder); virtual;
|
||||
procedure OutputPixelSubByte(X,Y: Int32or64; AColorIndex: Int32or64; {%H-}AColor: TBGRAPixel); virtual;
|
||||
procedure OutputPixelFullByte(X,Y: Int32or64; AColorIndex: Int32or64; {%H-}AColor: TBGRAPixel); virtual;
|
||||
function GetScanline(Y: Int32or64): Pointer; virtual;
|
||||
function GetTransparentColorIndex: integer;
|
||||
procedure SetTransparentColorIndex(AValue: integer);
|
||||
public
|
||||
constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer); overload; //use platform byte order
|
||||
constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer; AByteOrder: TRawImageByteOrder); overload; //maybe necessary if larger than 8 bits per pixel
|
||||
|
||||
function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap): Pointer; overload; //use minimum scanline size
|
||||
function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer; overload;
|
||||
procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer); overload; //use minimum scanline size
|
||||
procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt); overload;
|
||||
function ComputeMinimumScanlineSize(AWidthInPixels: integer): PtrInt;
|
||||
function AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): pointer;
|
||||
|
||||
//optional customization of format
|
||||
property BitsPerPixel: integer read FBitsPerPixel write SetBitsPerPixel;
|
||||
property BitOrder: TRawImageBitOrder read FBitOrder write SetBitOrder;
|
||||
property ByteOrder: TRawImageByteOrder read FByteOrder write SetByteOrder;
|
||||
property LineOrder: TRawImageLineOrder read FLineOrder write SetLineOrder;
|
||||
|
||||
property Palette: TBGRACustomApproxPalette read FPalette write SetPalette;
|
||||
property IgnoreAlpha: boolean read FIgnoreAlpha write SetIgnoreAlpha;
|
||||
|
||||
//when there is no transparent color in the palette, or that IgnoreAlpha is set to True,
|
||||
//this allows to define the index for the fully transparent color
|
||||
property DefaultTransparentColorIndex: integer read GetTransparentColorIndex write SetTransparentColorIndex;
|
||||
end;
|
||||
|
||||
function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
|
||||
AIgnoreAlpha: boolean): TDitheringTask; overload;
|
||||
function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
|
||||
AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload;
|
||||
function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect): TDitheringTask; overload;
|
||||
function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
|
||||
AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload;
|
||||
|
||||
function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
|
||||
|
||||
implementation
|
||||
|
||||
uses BGRABlend;
|
||||
|
||||
function AbsRGBADiff(const c1, c2: TExpandedPixel): Int32or64;
|
||||
begin
|
||||
result := abs(c1.alpha-c2.alpha);
|
||||
inc(result, abs(c1.red-c2.red) );
|
||||
inc(result, abs(c1.green-c2.green) );
|
||||
inc(result, abs(c1.blue-c2.blue) );
|
||||
end;
|
||||
|
||||
function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
|
||||
AIgnoreAlpha: boolean): TDitheringTask;
|
||||
begin
|
||||
result := CreateDitheringTask(AAlgorithm, ABitmap, APalette, AIgnoreAlpha, rect(0,0,ABitmap.width, ABitmap.Height));
|
||||
end;
|
||||
|
||||
function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
|
||||
AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask;
|
||||
begin
|
||||
result := nil;
|
||||
case AAlgorithm of
|
||||
daNearestNeighbor: result := TNearestColorTask.Create(ABitmap, APalette, False, AIgnoreAlpha, ABounds);
|
||||
daFloydSteinberg: result := TFloydSteinbergDitheringTask.Create(ABitmap, APalette, False, AIgnoreAlpha, ABounds);
|
||||
else raise exception.Create('Unknown algorithm');
|
||||
end;
|
||||
end;
|
||||
|
||||
function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm;
|
||||
ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect
|
||||
): TDitheringTask;
|
||||
begin
|
||||
result := CreateDitheringTask(AAlgorithm, ASource, ADestination, nil, true, ABounds);
|
||||
end;
|
||||
|
||||
function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm;
|
||||
ASource: IBGRAScanner; ADestination: TBGRACustomBitmap;
|
||||
APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABounds: TRect
|
||||
): TDitheringTask;
|
||||
begin
|
||||
result := nil;
|
||||
case AAlgorithm of
|
||||
daNearestNeighbor: result := TNearestColorTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds);
|
||||
daFloydSteinberg: result := TFloydSteinbergDitheringTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds);
|
||||
else raise exception.Create('Unknown algorithm');
|
||||
end;
|
||||
end;
|
||||
|
||||
function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm;
|
||||
ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
|
||||
var
|
||||
palette16bit: TBGRA16BitPalette;
|
||||
dither: TDitheringTask;
|
||||
begin
|
||||
palette16bit := TBGRA16BitPalette.Create;
|
||||
dither := CreateDitheringTask(AAlgorithm, ABitmap, palette16bit, false);
|
||||
result := dither.Execute;
|
||||
dither.Free;
|
||||
palette16bit.Free;
|
||||
end;
|
||||
|
||||
{ TDitheringToIndexedImage }
|
||||
|
||||
procedure TDitheringToIndexedImage.SetBitsPerPixel(AValue: integer);
|
||||
begin
|
||||
if not (AValue in [1,2,4,8,16,32]) then
|
||||
raise exception.Create('Invalid value for bits per pixel. Allowed values: 1,2,4,8,16,32.');
|
||||
if FBitsPerPixel=AValue then Exit;
|
||||
FBitsPerPixel:=AValue;
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.SetByteOrder(AValue: TRawImageByteOrder);
|
||||
begin
|
||||
if FByteOrder=AValue then Exit;
|
||||
FByteOrder:=AValue;
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.OutputPixelSubByte(X, Y: Int32or64;
|
||||
AColorIndex: Int32or64; AColor: TBGRAPixel);
|
||||
var p: PByte;
|
||||
begin
|
||||
if y <> FCurrentOutputY then
|
||||
begin
|
||||
FCurrentOutputY := y;
|
||||
FCurrentOutputScanline := GetScanline(Y);
|
||||
end;
|
||||
if AColorIndex = -1 then AColorIndex := FTransparentColorIndex;
|
||||
case FBitsPerPixel of
|
||||
1: begin
|
||||
p := FCurrentOutputScanline+(x shr 3);
|
||||
p^ := p^ or ((AColorIndex and 1) shl ((x xor FCurrentBitOrderMask) and 7));
|
||||
end;
|
||||
2: begin
|
||||
p := FCurrentOutputScanline+(x shr 2);
|
||||
p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 3) shl 1));
|
||||
end;
|
||||
4: begin
|
||||
p := FCurrentOutputScanline+(x shr 1);
|
||||
p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 1) shl 2));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.OutputPixelFullByte(X, Y: Int32or64;
|
||||
AColorIndex: Int32or64; AColor: TBGRAPixel);
|
||||
begin
|
||||
if y <> FCurrentOutputY then
|
||||
begin
|
||||
FCurrentOutputY := y;
|
||||
FCurrentOutputScanline := GetScanline(Y);
|
||||
end;
|
||||
if AColorIndex = -1 then AColorIndex := FTransparentColorIndex;
|
||||
case FBitsPerPixel of
|
||||
8: (FCurrentOutputScanline+x)^ := AColorIndex;
|
||||
16: (PWord(FCurrentOutputScanline)+x)^ := AColorIndex;
|
||||
32: (PLongWord(FCurrentOutputScanline)+x)^ := AColorIndex;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDitheringToIndexedImage.GetScanline(Y: Int32or64): Pointer;
|
||||
begin
|
||||
if FLineOrder = riloTopToBottom then
|
||||
result := FCurrentData + Y*FCurrentScanlineSize
|
||||
else
|
||||
result := FCurrentData + (FCurrentMaxY-Y)*FCurrentScanlineSize
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.SetIgnoreAlpha(AValue: boolean);
|
||||
begin
|
||||
if FIgnoreAlpha=AValue then Exit;
|
||||
FIgnoreAlpha:=AValue;
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.SetTransparentColorIndex(AValue: integer);
|
||||
begin
|
||||
if FTransparentColorIndex=AValue then Exit;
|
||||
FTransparentColorIndex:=AValue;
|
||||
end;
|
||||
|
||||
function TDitheringToIndexedImage.GetTransparentColorIndex: integer;
|
||||
begin
|
||||
result := FTransparentColorIndex;
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.SetPalette(AValue: TBGRACustomApproxPalette);
|
||||
begin
|
||||
if FPalette=AValue then Exit;
|
||||
FPalette:=AValue;
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.SetLineOrder(AValue: TRawImageLineOrder);
|
||||
begin
|
||||
if FLineOrder=AValue then Exit;
|
||||
FLineOrder:=AValue;
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.SetBitOrder(AValue: TRawImageBitOrder);
|
||||
begin
|
||||
if FBitOrder=AValue then Exit;
|
||||
FBitOrder:=AValue;
|
||||
end;
|
||||
|
||||
constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer);
|
||||
begin
|
||||
BitsPerPixel:= ABitsPerPixelForIndices;
|
||||
BitOrder := riboReversedBits; //convention in BMP format
|
||||
{$IFDEF ENDIAN_LITTLE}
|
||||
ByteOrder:= riboLSBFirst;
|
||||
{$ELSE}
|
||||
ByteOrder:= riboMSBFirst;
|
||||
{$ENDIF}
|
||||
Palette := APalette;
|
||||
IgnoreAlpha:= AIgnoreAlpha;
|
||||
end;
|
||||
|
||||
constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer;
|
||||
AByteOrder: TRawImageByteOrder);
|
||||
begin
|
||||
BitsPerPixel:= ABitsPerPixelForIndices;
|
||||
BitOrder := riboReversedBits; //convention in BMP format
|
||||
ByteOrder:= AByteOrder;
|
||||
Palette := APalette;
|
||||
IgnoreAlpha:= AIgnoreAlpha;
|
||||
end;
|
||||
|
||||
function TDitheringToIndexedImage.ComputeMinimumScanlineSize(
|
||||
AWidthInPixels: integer): PtrInt;
|
||||
begin
|
||||
result := (AWidthInPixels*FBitsPerPixel+7) shr 3;
|
||||
end;
|
||||
|
||||
function TDitheringToIndexedImage.AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap;
|
||||
AScanlineSize: PtrInt): pointer;
|
||||
var size: integer;
|
||||
begin
|
||||
size := AScanlineSize * AImage.Height;
|
||||
GetMem(result, size);
|
||||
Fillchar(result^, size, 0);
|
||||
end;
|
||||
|
||||
function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm;
|
||||
AImage: TBGRACustomBitmap): Pointer;
|
||||
begin
|
||||
result := DitherImage(AAlgorithm, AImage, ComputeMinimumScanlineSize(AImage.Width));
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm;
|
||||
AImage: TBGRACustomBitmap; AData: Pointer);
|
||||
begin
|
||||
DitherImageTo(AAlgorithm, AImage, AData, ComputeMinimumScanlineSize(AImage.Width));
|
||||
end;
|
||||
|
||||
function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm;
|
||||
AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer;
|
||||
begin
|
||||
result := AllocateSpaceForIndexedData(AImage, AScanlineSize);
|
||||
DitherImageTo(AAlgorithm, AImage, result, AScanlineSize);
|
||||
end;
|
||||
|
||||
procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm;
|
||||
AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt);
|
||||
var ditherTask: TDitheringTask;
|
||||
begin
|
||||
FCurrentOutputY := -1;
|
||||
FCurrentOutputScanline := nil;
|
||||
FCurrentData := AData;
|
||||
FCurrentMaxY:= AImage.Height-1;
|
||||
FCurrentScanlineSize:= AScanlineSize;
|
||||
|
||||
ditherTask := CreateDitheringTask(AAlgorithm, AImage, FPalette, FIgnoreAlpha);
|
||||
try
|
||||
ditherTask.Inplace := True; //do not allocate destination
|
||||
if BitsPerPixel >= 8 then
|
||||
ditherTask.OnOutputPixel := @OutputPixelFullByte
|
||||
else
|
||||
begin
|
||||
ditherTask.OnOutputPixel:= @OutputPixelSubByte;
|
||||
if BitOrder = riboBitsInOrder then
|
||||
FCurrentBitOrderMask := 0
|
||||
else
|
||||
FCurrentBitOrderMask := $ff;
|
||||
end;
|
||||
ditherTask.Execute;
|
||||
finally
|
||||
ditherTask.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDitheringTask }
|
||||
|
||||
procedure TDitheringTask.SetDrawMode(AValue: TDrawMode);
|
||||
begin
|
||||
if FDrawMode=AValue then Exit;
|
||||
FDrawMode:=AValue;
|
||||
UpdateOutputPixel;
|
||||
end;
|
||||
|
||||
procedure TDitheringTask.UpdateOutputPixel;
|
||||
begin
|
||||
case FDrawMode of
|
||||
dmSet: FOutputPixel := @OutputPixelSet;
|
||||
dmSetExceptTransparent: FOutputPixel := @OutputPixelSetExceptTransparent;
|
||||
dmLinearBlend: FOutputPixel := @OutputPixelLinearBlend;
|
||||
dmXor: FOutputPixel := @OutputPixelXor;
|
||||
else
|
||||
{dmDrawWithTransparency} FOutputPixel := @OutputPixelDraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDitheringTask.UpdateCurrentLine(Y: Int32or64);
|
||||
begin
|
||||
if Y <> FCurrentOutputY then
|
||||
begin
|
||||
FCurrentOutputY := Y;
|
||||
FCurrentOutputScanline := Destination.ScanLine[y];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDitheringTask.OutputPixel(X, Y: Int32or64; AColorIndex: Int32or64;
|
||||
AColor: TBGRAPixel);
|
||||
begin
|
||||
UpdateCurrentLine(y);
|
||||
PutPixels(FCurrentOutputScanline+x, @AColor, 1, FDrawMode, 255);
|
||||
end;
|
||||
|
||||
procedure TDitheringTask.OutputPixelSet(X, Y: Int32or64;
|
||||
AColorIndex: Int32or64; AColor: TBGRAPixel);
|
||||
begin
|
||||
UpdateCurrentLine(y);
|
||||
(FCurrentOutputScanline+x)^ := AColor;
|
||||
end;
|
||||
|
||||
procedure TDitheringTask.OutputPixelSetExceptTransparent(X, Y: Int32or64;
|
||||
AColorIndex: Int32or64; AColor: TBGRAPixel);
|
||||
begin
|
||||
UpdateCurrentLine(y);
|
||||
if AColor.alpha = 255 then (FCurrentOutputScanline+x)^ := AColor;
|
||||
end;
|
||||
|
||||
procedure TDitheringTask.OutputPixelLinearBlend(X, Y: Int32or64;
|
||||
AColorIndex: Int32or64; AColor: TBGRAPixel);
|
||||
begin
|
||||
UpdateCurrentLine(y);
|
||||
FastBlendPixelInline(FCurrentOutputScanline+x, AColor);
|
||||
end;
|
||||
|
||||
procedure TDitheringTask.OutputPixelDraw(X, Y: Int32or64;
|
||||
AColorIndex: Int32or64; AColor: TBGRAPixel);
|
||||
begin
|
||||
UpdateCurrentLine(y);
|
||||
DrawPixelInlineWithAlphaCheck(FCurrentOutputScanline+x, AColor);
|
||||
end;
|
||||
|
||||
procedure TDitheringTask.OutputPixelXor(X, Y: Int32or64;
|
||||
AColorIndex: Int32or64; AColor: TBGRAPixel);
|
||||
begin
|
||||
UpdateCurrentLine(y);
|
||||
PLongWord(FCurrentOutputScanline+x)^ := PLongWord(FCurrentOutputScanline+x)^ xor PLongWord(@AColor)^;
|
||||
end;
|
||||
|
||||
procedure TDitheringTask.ApproximateColor(const AColor: TBGRAPixel;
|
||||
out AApproxColor: TBGRAPixel; out AIndex: integer);
|
||||
begin
|
||||
if FPalette <> nil then
|
||||
begin
|
||||
AIndex := FPalette.FindNearestColorIndex(AColor, FIgnoreAlpha);
|
||||
if AIndex = -1 then
|
||||
AApproxColor := BGRAPixelTransparent
|
||||
else
|
||||
AApproxColor := FPalette.Color[AIndex];
|
||||
end else
|
||||
begin
|
||||
if AColor.alpha = 0 then
|
||||
begin
|
||||
AApproxColor := BGRAPixelTransparent;
|
||||
AIndex := -1;
|
||||
end else
|
||||
begin
|
||||
AApproxColor := AColor;
|
||||
AIndex := 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TDitheringTask.Create(ASource: IBGRAScanner;
|
||||
APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap;
|
||||
AIgnoreAlpha: boolean; ABounds: TRect);
|
||||
begin
|
||||
FPalette := APalette;
|
||||
SetSource(ASource);
|
||||
FBounds := ABounds;
|
||||
FIgnoreAlpha:= AIgnoreAlpha;
|
||||
FCurrentOutputY := -1;
|
||||
FCurrentOutputScanline:= nil;
|
||||
Destination := ADestination;
|
||||
FDrawMode:= dmSet;
|
||||
UpdateOutputPixel;
|
||||
end;
|
||||
|
||||
constructor TDitheringTask.Create(bmp: TBGRACustomBitmap;
|
||||
APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean;
|
||||
ABounds: TRect);
|
||||
begin
|
||||
FPalette := APalette;
|
||||
SetSource(bmp);
|
||||
FBounds := ABounds;
|
||||
FIgnoreAlpha:= AIgnoreAlpha;
|
||||
FCurrentOutputY := -1;
|
||||
FCurrentOutputScanline:= nil;
|
||||
InPlace := AInPlace;
|
||||
FDrawMode:= dmSet;
|
||||
UpdateOutputPixel;
|
||||
end;
|
||||
|
||||
constructor TDitheringTask.Create(bmp: TBGRACustomBitmap;
|
||||
APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean);
|
||||
begin
|
||||
FPalette := APalette;
|
||||
SetSource(bmp);
|
||||
FBounds := rect(0,0,bmp.Width,bmp.Height);
|
||||
FIgnoreAlpha:= AIgnoreAlpha;
|
||||
FCurrentOutputY := -1;
|
||||
FCurrentOutputScanline:= nil;
|
||||
InPlace := AInPlace;
|
||||
FDrawMode:= dmSet;
|
||||
UpdateOutputPixel;
|
||||
end;
|
||||
|
||||
{ TFloydSteinbergDitheringTask }
|
||||
|
||||
procedure TFloydSteinbergDitheringTask.DoExecute;
|
||||
const
|
||||
ErrorPrecisionShift = 4;
|
||||
MaxColorDiffForDiffusion = 4096;
|
||||
type
|
||||
TAccPixel = record
|
||||
red,green,blue,alpha: Int32or64;
|
||||
end;
|
||||
TLine = array of TAccPixel;
|
||||
|
||||
procedure AddError(var dest: TAccPixel; const src: TAccPixel; factor: Int32or64); inline;
|
||||
const maxError = 65536 shl ErrorPrecisionShift;
|
||||
minError = -(65536 shl ErrorPrecisionShift);
|
||||
begin
|
||||
inc(dest.alpha, src.alpha * factor);
|
||||
if dest.alpha > maxError then dest.alpha := maxError;
|
||||
if dest.alpha < minError then dest.alpha := minError;
|
||||
inc(dest.red, src.red * factor);
|
||||
if dest.red > maxError then dest.red := maxError;
|
||||
if dest.red < minError then dest.red := minError;
|
||||
inc(dest.green, src.green * factor);
|
||||
if dest.green > maxError then dest.green := maxError;
|
||||
if dest.green < minError then dest.green := minError;
|
||||
inc(dest.blue, src.blue * factor);
|
||||
if dest.blue > maxError then dest.blue := maxError;
|
||||
if dest.blue < minError then dest.blue := minError;
|
||||
end;
|
||||
|
||||
var
|
||||
w,h: Int32or64;
|
||||
|
||||
var
|
||||
p,pNext: PExpandedPixel;
|
||||
destX,destY: Int32or64;
|
||||
orig,cur,approxExp: TExpandedPixel;
|
||||
approx: TBGRAPixel;
|
||||
approxIndex: integer;
|
||||
curPix,diff: TAccPixel;
|
||||
i: Int32or64;
|
||||
yWrite: Int32or64;
|
||||
tempLine, currentLine, nextLine: TLine;
|
||||
|
||||
nextScan,curScan: PExpandedPixel;
|
||||
|
||||
function ClampWordDiv(AValue: Int32or64): Word; inline;
|
||||
begin
|
||||
if AValue < 0 then AValue := -((-AValue) shr ErrorPrecisionShift) else AValue := AValue shr ErrorPrecisionShift;
|
||||
if AValue < 0 then
|
||||
result := 0
|
||||
else if AValue > 65535 then
|
||||
result := 65535
|
||||
else
|
||||
result := AValue;
|
||||
end;
|
||||
|
||||
function Div16(AValue: Int32or64): Int32or64; inline;
|
||||
begin
|
||||
if AValue < 0 then
|
||||
result := -((-AValue) shr 4)
|
||||
else
|
||||
result := AValue shr 4;
|
||||
end;
|
||||
|
||||
begin
|
||||
w := FBounds.Right-FBounds.Left;
|
||||
h := FBounds.Bottom-FBounds.Top;
|
||||
if (w <= 0) or (h <= 0) then exit;
|
||||
setlength(currentLine,w);
|
||||
setlength(nextLine,w);
|
||||
curScan := nil;
|
||||
nextScan := RequestSourceExpandedScanLine(FBounds.Left, FBounds.Top, FBounds.Right-FBounds.Left);
|
||||
for yWrite := 0 to h-1 do
|
||||
begin
|
||||
if GetShouldStop(yWrite) then break;
|
||||
ReleaseSourceExpandedScanLine(curScan);
|
||||
curScan := nextScan;
|
||||
nextScan := nil;
|
||||
p := curScan;
|
||||
destX := FBounds.Left;
|
||||
destY := yWrite+FBounds.Top;
|
||||
if yWrite < h-1 then
|
||||
nextScan := RequestSourceExpandedScanLine(FBounds.Left,yWrite+FBounds.Top+1, FBounds.Right-FBounds.Left);
|
||||
pNext := nextScan;
|
||||
if odd(yWrite) then
|
||||
begin
|
||||
inc(p, w);
|
||||
inc(destX, w);
|
||||
if pNext<>nil then inc(pNext, w);
|
||||
for i := w-1 downto 0 do
|
||||
begin
|
||||
dec(p);
|
||||
dec(destX);
|
||||
if pNext<>nil then dec(pNext);
|
||||
if p^.alpha <> 0 then
|
||||
begin
|
||||
orig := p^;
|
||||
with currentLine[i] do
|
||||
begin
|
||||
curPix.alpha := alpha+Int32or64(orig.alpha shl ErrorPrecisionShift);
|
||||
curPix.red := red+Int32or64(orig.red shl ErrorPrecisionShift);
|
||||
curPix.green := green+Int32or64(orig.green shl ErrorPrecisionShift);
|
||||
curPix.blue := blue+Int32or64(orig.blue shl ErrorPrecisionShift);
|
||||
cur.alpha := ClampWordDiv(curPix.alpha);
|
||||
cur.red := ClampWordDiv(curPix.red);
|
||||
cur.green := ClampWordDiv(curPix.green);
|
||||
cur.blue := ClampWordDiv(curPix.blue);
|
||||
end;
|
||||
ApproximateColor(GammaCompression(cur), approx, approxIndex);
|
||||
approxExp := GammaExpansion(approx);
|
||||
diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift));
|
||||
if (approxExp.alpha = 0) or (cur.alpha = 0) then
|
||||
begin
|
||||
diff.red := 0;
|
||||
diff.green := 0;
|
||||
diff.blue := 0;
|
||||
end else
|
||||
begin
|
||||
diff.red := Div16(curPix.red - (approxExp.red shl ErrorPrecisionShift));
|
||||
diff.green := Div16(curPix.green - (approxExp.green shl ErrorPrecisionShift));
|
||||
diff.blue := Div16(curPix.blue - (approxExp.blue shl ErrorPrecisionShift));
|
||||
end;
|
||||
if i > 0 then
|
||||
begin
|
||||
if AbsRGBADiff((p-1)^,orig) < MaxColorDiffForDiffusion then
|
||||
AddError(currentLine[i-1], diff, 7);
|
||||
end;
|
||||
if nextLine <> nil then
|
||||
begin
|
||||
if i > 0 then
|
||||
begin
|
||||
if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then
|
||||
AddError(nextLine[i-1], diff, 1);
|
||||
end;
|
||||
if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then
|
||||
AddError(nextLine[i], diff, 5);
|
||||
if i < w-1 then
|
||||
begin
|
||||
if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then
|
||||
AddError(nextLine[i+1], diff, 3);
|
||||
end;
|
||||
end;
|
||||
OnOutputPixel(destX,destY,approxIndex,approx);
|
||||
end else
|
||||
begin
|
||||
ApproximateColor(BGRAPixelTransparent, approx, approxIndex);
|
||||
OnOutputPixel(destX,destY,approxIndex,approx);
|
||||
end;
|
||||
end
|
||||
end
|
||||
else
|
||||
for i := 0 to w-1 do
|
||||
begin
|
||||
if p^.alpha <> 0 then
|
||||
begin
|
||||
orig := p^;
|
||||
with currentLine[i] do
|
||||
begin
|
||||
curPix.alpha := alpha+Int32or64(orig.alpha shl ErrorPrecisionShift);
|
||||
curPix.red := red+Int32or64(orig.red shl ErrorPrecisionShift);
|
||||
curPix.green := green+Int32or64(orig.green shl ErrorPrecisionShift);
|
||||
curPix.blue := blue+Int32or64(orig.blue shl ErrorPrecisionShift);
|
||||
cur.alpha := ClampWordDiv(curPix.alpha);
|
||||
cur.red := ClampWordDiv(curPix.red);
|
||||
cur.green := ClampWordDiv(curPix.green);
|
||||
cur.blue := ClampWordDiv(curPix.blue);
|
||||
end;
|
||||
ApproximateColor(GammaCompression(cur), approx, approxIndex);
|
||||
approxExp := GammaExpansion(approx);
|
||||
diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift));
|
||||
if (approxExp.alpha = 0) or (cur.alpha = 0) then
|
||||
begin
|
||||
diff.red := 0;
|
||||
diff.green := 0;
|
||||
diff.blue := 0;
|
||||
end else
|
||||
begin
|
||||
diff.red := Div16(curPix.red - (approxExp.red shl ErrorPrecisionShift));
|
||||
diff.green := Div16(curPix.green - (approxExp.green shl ErrorPrecisionShift));
|
||||
diff.blue := Div16(curPix.blue - (approxExp.blue shl ErrorPrecisionShift));
|
||||
end;
|
||||
if i < w-1 then
|
||||
begin
|
||||
if AbsRGBADiff((p+1)^,orig) < MaxColorDiffForDiffusion then
|
||||
AddError(currentLine[i+1], diff, 7);
|
||||
end;
|
||||
if pNext <> nil then
|
||||
begin
|
||||
if i > 0 then
|
||||
begin
|
||||
if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then
|
||||
AddError(nextLine[i-1], diff, 3);
|
||||
end;
|
||||
if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then
|
||||
AddError(nextLine[i], diff, 5);
|
||||
if i < w-1 then
|
||||
begin
|
||||
if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then
|
||||
AddError(nextLine[i+1], diff, 1);
|
||||
end;
|
||||
end;
|
||||
OnOutputPixel(destX,destY,approxIndex,approx);
|
||||
end else
|
||||
begin
|
||||
ApproximateColor(BGRAPixelTransparent, approx, approxIndex);
|
||||
OnOutputPixel(destX,destY,approxIndex,approx);
|
||||
end;
|
||||
inc(p);
|
||||
inc(destX);
|
||||
if pNext<>nil then inc(pNext);
|
||||
end;
|
||||
tempLine := currentLine;
|
||||
currentLine := nextLine;
|
||||
nextLine := tempLine;
|
||||
if yWrite = h-2 then
|
||||
nextLine := nil
|
||||
else fillchar(nextLine[0], sizeof(nextLine[0])*w, 0);
|
||||
end;
|
||||
ReleaseSourceExpandedScanLine(curScan);
|
||||
ReleaseSourceExpandedScanLine(nextScan);
|
||||
Destination.InvalidateBitmap;
|
||||
end;
|
||||
|
||||
{ TNearestColorTask }
|
||||
|
||||
procedure TNearestColorTask.DoExecute;
|
||||
var yb,xb: Int32or64;
|
||||
curScan,psrc: PBGRAPixel;
|
||||
colorIndex: LongInt;
|
||||
colorValue: TBGRAPixel;
|
||||
begin
|
||||
for yb := FBounds.Top to FBounds.Bottom - 1 do
|
||||
begin
|
||||
if GetShouldStop(yb) then break;
|
||||
curScan := RequestSourceScanLine(FBounds.Left,yb,FBounds.Right-FBounds.Left);
|
||||
psrc := curScan;
|
||||
for xb := FBounds.Left to FBounds.Right-1 do
|
||||
begin
|
||||
ApproximateColor(psrc^, colorValue, colorIndex);
|
||||
OnOutputPixel(xb,yb,colorIndex,colorValue);
|
||||
inc(psrc);
|
||||
end;
|
||||
ReleaseSourceScanLine(curScan);
|
||||
end;
|
||||
Destination.InvalidateBitmap;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in new issue
Block a user