mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-05 10:17:14 +01:00
544 lines
16 KiB
ObjectPascal
544 lines
16 KiB
ObjectPascal
{*****************************************************************************}
|
|
{
|
|
This file is part of the Free Pascal's "Free Components Library".
|
|
Copyright (c) 2005 by Giulio Bernardi
|
|
|
|
This file contains classes used to dither images.
|
|
|
|
See the file COPYING.FPC, 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.
|
|
}
|
|
{*****************************************************************************}
|
|
|
|
{$mode objfpc}{$h+}
|
|
unit FPDitherer;
|
|
|
|
interface
|
|
|
|
uses sysutils, classes, fpimage, fpcolhash;
|
|
|
|
type
|
|
FPDithererException = class (exception);
|
|
|
|
type
|
|
TFPDithererProgressEvent = procedure (Sender: TObject; Stage: TFPImgProgressStage; PercentDone: Byte;
|
|
const Msg: AnsiString; var Continue : Boolean) of object;
|
|
|
|
type
|
|
TFPBaseDitherer = class
|
|
private
|
|
FPalette : TFPPalette;
|
|
FOnProgress : TFPDithererProgressEvent;
|
|
procedure QuickSort(const l, r : integer);
|
|
protected
|
|
FImage : TFPCustomImage;
|
|
FHashMap : TFPColorHashTable;
|
|
FSorted : boolean;
|
|
FUseHash : boolean;
|
|
FUseAlpha : boolean;
|
|
function ColorCompare(const c1, c2 : TFPColor) : shortint;
|
|
function GetColorDinst(const c1, c2 : TFPColor) : integer;
|
|
function SubtractColorInt(const c1, c2 : TFPColor) : int64;
|
|
function SubtractColor(const c1, c2 : TFPColor) : TFPColor;
|
|
procedure InternalDither(const Source : TFPCustomImage; Dest : TFPCustomImage); virtual;
|
|
function FindBestColor(OrigColor : TFPColor; var PalIndex : integer) : integer; virtual;
|
|
procedure Progress (Sender: TObject; Stage: TFPImgProgressStage; PercentDone: Byte; const Msg: AnsiString; var Continue : Boolean); virtual;
|
|
procedure SetUseHash(Value : boolean); virtual;
|
|
procedure SetSorted(Value : boolean); virtual;
|
|
public
|
|
property OnProgress : TFPDithererProgressEvent read FOnProgress write FOnProgress;
|
|
property Palette : TFPPalette read FPalette;
|
|
property PaletteSorted : boolean read FSorted write SetSorted;
|
|
property UseHashMap : boolean read FUseHash write SetUseHash;
|
|
property UseAlpha : boolean read FUseAlpha write FUseAlpha;
|
|
procedure Dither(const Source : TFPCustomImage; Dest : TFPCustomImage);
|
|
procedure SortPalette; virtual;
|
|
constructor Create(ThePalette : TFPPalette); virtual;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
type
|
|
PFPPixelReal = ^TFPPixelReal;
|
|
TFPPixelReal = record { pixel in real form }
|
|
a, r, g, b : real;
|
|
end;
|
|
|
|
PFSPixelLine = ^TFSPixelLine;
|
|
TFSPixelLine = record
|
|
pixels : PFPPixelReal; { a line of pixels }
|
|
Next : PFSPixelLine; { next line of pixels }
|
|
end;
|
|
|
|
type
|
|
TFPFloydSteinbergDitherer = class(TFPBaseDitherer)
|
|
private
|
|
Lines : PFSPixelLine;
|
|
function Color2Real(const c : TFPColor) : TFPPixelReal;
|
|
function Real2Color(r : TFPPixelReal) : TFPColor;
|
|
procedure CreatePixelLine(var line : PFSPixelLine; const row : integer);
|
|
function GetError(const c1, c2 : TFPColor) : TFPPixelReal;
|
|
procedure DistributeErrors(var line : PFSPixelLine; const row : integer; Img : TFPCustomImage);
|
|
procedure DeleteAllPixelLines(var line : PFSPixelLine);
|
|
protected
|
|
procedure InternalDither(const Source : TFPCustomImage; Dest : TFPCustomImage); override;
|
|
public
|
|
constructor Create(ThePalette : TFPPalette); override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TFPBaseDitherer }
|
|
|
|
procedure TFPBaseDitherer.Dither(const Source : TFPCustomImage; Dest : TFPCustomImage);
|
|
begin
|
|
if FPalette.Count=0 then
|
|
raise FPDithererException.Create('Palette is empty');
|
|
if Source=Dest then
|
|
raise FPDithererException.Create('Source and Destination images must be different');
|
|
InternalDither(Source,Dest);
|
|
if FUseHash then
|
|
FHashMap.Clear;
|
|
end;
|
|
|
|
constructor TFPBaseDitherer.Create(ThePalette : TFPPalette);
|
|
begin
|
|
FSorted:=false;
|
|
FUseAlpha:=false;
|
|
FImage:=nil;
|
|
FPalette:=ThePalette;
|
|
FUseHash:=true;
|
|
FHashMap:=TFPColorHashTable.Create;
|
|
end;
|
|
|
|
destructor TFPBaseDitherer.Destroy;
|
|
begin
|
|
if Assigned(FHashMap) then
|
|
FHashMap.Free;
|
|
end;
|
|
|
|
procedure TFPBaseDitherer.SetUseHash(Value : boolean);
|
|
begin
|
|
if Value=FUseHash then exit;
|
|
if Value then
|
|
FHashMap:=TFPColorHashTable.Create
|
|
else
|
|
begin
|
|
FHashMap.Free;
|
|
FHashMap:=nil;
|
|
end;
|
|
FUseHash:=Value;
|
|
end;
|
|
|
|
procedure TFPBaseDitherer.SetSorted(Value : boolean);
|
|
begin
|
|
FSorted:=Value;
|
|
end;
|
|
|
|
procedure TFPBaseDitherer.Progress(Sender: TObject; Stage: TFPImgProgressStage; PercentDone: Byte; const Msg: AnsiString; var Continue : Boolean);
|
|
begin
|
|
if Assigned(FOnProgress) then
|
|
FOnProgress(Sender,Stage,PercentDone,Msg,Continue);
|
|
end;
|
|
|
|
{ rgb triplets are considered like a number having msb in msb(r) and lsb in lsb(b) }
|
|
|
|
function TFPBaseDitherer.SubtractColorInt(const c1, c2 : TFPColor) : int64;
|
|
var whole1, whole2 : int64;
|
|
begin
|
|
whole1:= ((c1.Red and $FF00) shl 8) or (c1.Green and $FF00) or ((c1.Blue and $FF00) shr 8);
|
|
whole2:= ((c2.Red and $FF00) shl 8) or (c2.Green and $FF00) or ((c2.Blue and $FF00) shr 8);
|
|
if FUseAlpha then
|
|
begin
|
|
whole1:=whole1 or ((c1.Alpha and $FF00) shl 16);
|
|
whole2:=whole2 or ((c2.Alpha and $FF00) shl 16);
|
|
end;
|
|
Result:= whole1 - whole2;
|
|
end;
|
|
|
|
{ this is more efficient than calling subtractcolorint and then extracting r g b values }
|
|
function TFPBaseDitherer.GetColorDinst(const c1, c2 : TFPColor) : integer;
|
|
var dinst : integer;
|
|
begin
|
|
dinst:=abs(((c1.Red and $FF00) shr 8) - ((c2.Red and $FF00) shr 8));
|
|
dinst:=dinst+abs(((c1.Green and $FF00) shr 8) - ((c2.Green and $FF00) shr 8));
|
|
dinst:=dinst+abs(((c1.Blue and $FF00) shr 8) - ((c2.Blue and $FF00) shr 8));
|
|
if FUseAlpha then
|
|
dinst:=dinst+abs(((c1.Alpha and $FF00) shr 8) - ((c2.Alpha and $FF00) shr 8));
|
|
Result:= dinst;
|
|
end;
|
|
|
|
function TFPBaseDitherer.SubtractColor(const c1, c2 : TFPColor) : TFPColor;
|
|
var whole : int64;
|
|
begin
|
|
whole:=abs(SubtractColorInt(c1,c2));
|
|
if FUseALpha then
|
|
Result.Alpha:=(whole and $FF000000) shr 16
|
|
else
|
|
Result.Alpha:=AlphaOpaque;
|
|
Result.Red:=(whole and $00FF0000) shr 8;
|
|
Result.Green:=(whole and $0000FF00);
|
|
Result.Blue:=(whole and $000000FF) shl 8;
|
|
end;
|
|
|
|
function TFPBaseDitherer.ColorCompare(const c1, c2 : TFPColor) : shortint;
|
|
var whole : int64;
|
|
begin
|
|
whole:=SubtractColorInt(c1,c2);
|
|
if whole>0 then Result:=1
|
|
else if whole<0 then Result:=-1
|
|
else Result:=0;
|
|
end;
|
|
|
|
procedure TFPBaseDitherer.QuickSort(const l, r : integer);
|
|
var i, j : integer;
|
|
pivot, temp : TFPColor;
|
|
begin
|
|
if l<r then
|
|
begin
|
|
pivot:=FPalette[l];
|
|
i:=l+1;
|
|
j:=r;
|
|
repeat
|
|
while ((i<=r) and (ColorCompare(FPalette[i],pivot)<=0)) do
|
|
inc(i);
|
|
while (ColorCompare(FPalette[j],pivot)=1) do
|
|
dec(j);
|
|
if i<j then
|
|
begin
|
|
temp:=FPalette[i];
|
|
FPalette[i]:=FPalette[j];
|
|
FPalette[j]:=temp;
|
|
end;
|
|
until i > j;
|
|
{ don't swap if they are equal }
|
|
if ColorCompare(FPalette[j],pivot)<>0 then
|
|
begin
|
|
Fpalette[l]:=Fpalette[j];
|
|
Fpalette[j]:=pivot;
|
|
end;
|
|
Quicksort(l,j-1);
|
|
Quicksort(i,r);
|
|
end;
|
|
end;
|
|
|
|
procedure TFPBaseDitherer.SortPalette;
|
|
begin
|
|
QuickSort(0,FPalette.Count-1);
|
|
FSorted:=true;
|
|
end;
|
|
|
|
type
|
|
PBestColorData = ^TBestColorData;
|
|
TBestColorData = record
|
|
palindex, dinst : integer;
|
|
end;
|
|
|
|
function TFPBaseDitherer.FindBestColor(OrigColor : TFPColor; var PalIndex : integer) : integer;
|
|
var i, curr, dinst, tmpdinst, top, bottom : integer;
|
|
hashval : PBestColorData;
|
|
begin
|
|
dinst:=$7FFFFFFF;
|
|
curr:=0;
|
|
|
|
if FUseHash then { use the hashmap to improve speed }
|
|
begin
|
|
hashval:=FHashMap.Get(OrigColor);
|
|
if hashval<>nil then
|
|
begin
|
|
PalIndex:=hashval^.palindex;
|
|
Result:=hashval^.dinst;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
{ with a sorted palette, proceed by binary search. this is more efficient with large images or large palettes }
|
|
if FSorted then
|
|
begin
|
|
top:=0;
|
|
bottom:=FPalette.Count-1;
|
|
while top<=bottom do
|
|
begin
|
|
i:=(bottom+top) div 2;
|
|
tmpdinst:=ColorCompare(OrigColor,Fpalette[i]);
|
|
if tmpdinst<0 then bottom:=i-1
|
|
else if tmpdinst>0 then top:=i+1
|
|
else break; { we found it }
|
|
end;
|
|
curr:=i;
|
|
dinst:=GetColorDinst(OrigColor,Fpalette[i]);
|
|
end
|
|
else
|
|
for i:=0 to FPalette.Count-1 do
|
|
begin
|
|
tmpdinst:=GetColorDinst(OrigColor,FPalette[i]);
|
|
if tmpdinst<dinst then
|
|
begin
|
|
dinst:=tmpdinst;
|
|
curr:=i;
|
|
end;
|
|
if tmpdinst=0 then break; { There can't be anything better, stop searching }
|
|
end;
|
|
|
|
if FUseHash then { if we are using a hashmap, remember this value}
|
|
begin
|
|
hashval:=GetMem(sizeof(TBestColorData));
|
|
if hashval=nil then
|
|
raise FPDithererException.Create('Out of memory');
|
|
hashval^.PalIndex:=curr;
|
|
hashval^.dinst:=dinst;
|
|
FHashMap.Insert(OrigColor,hashval);
|
|
end;
|
|
PalIndex:=curr;
|
|
Result:=dinst;
|
|
end;
|
|
|
|
procedure TFPBaseDitherer.InternalDither(const Source : TFPCustomImage; Dest : TFPCustomImage);
|
|
var i,j, palindex : integer;
|
|
percent : byte;
|
|
percentinterval : longword;
|
|
percentacc : longword;
|
|
FContinue : boolean;
|
|
begin
|
|
FImage:=Source;
|
|
percent:=0;
|
|
percentinterval:=(FImage.Width*FImage.Height*4) div 100;
|
|
if percentinterval=0 then percentinterval:=$FFFFFFFF;
|
|
percentacc:=0;
|
|
FContinue:=true;
|
|
Progress (self,psStarting,0,'',FContinue);
|
|
Dest.SetSize(0,0);
|
|
Dest.UsePalette:=true;
|
|
Dest.Palette.Clear;
|
|
Dest.Palette.Merge(FPalette);
|
|
Dest.SetSize(FImage.Width,FImage.Height);
|
|
for j:=0 to FImage.Height-1 do
|
|
for i:=0 to FImage.Width-1 do
|
|
begin
|
|
FindBestColor(FImage[i,j], palindex);
|
|
Dest.Pixels[i,j]:=palindex;
|
|
inc(percentacc,4);
|
|
if percentacc>=percentinterval then
|
|
begin
|
|
percent:=percent+(percentacc div percentinterval);
|
|
percentacc:=percentacc mod percentinterval;
|
|
Progress (self,psRunning,percent,'',FContinue);
|
|
if not fcontinue then exit;
|
|
end;
|
|
end;
|
|
Progress (self,psEnding,100,'',FContinue);
|
|
end;
|
|
|
|
{ TFPFloydSteinbergDitherer }
|
|
|
|
const FSNullPixel : TFPPixelReal = (a : 0.0; r : 0.0; g : 0.0; b : 0.0);
|
|
|
|
constructor TFPFloydSteinbergDitherer.Create(ThePalette : TFPPalette);
|
|
begin
|
|
inherited Create(ThePalette);
|
|
Lines:=nil;
|
|
end;
|
|
|
|
function TFPFloydSteinbergDitherer.GetError(const c1, c2 : TFPColor) : TFPPixelReal;
|
|
var temp : TFPPixelReal;
|
|
begin
|
|
if FUseAlpha then
|
|
temp.a:=((c1.Alpha and $FF00) shr 8) - ((c2.Alpha and $FF00) shr 8);
|
|
temp.r:=((c1.Red and $FF00) shr 8) - ((c2.Red and $FF00) shr 8);
|
|
temp.g:=((c1.Green and $FF00) shr 8) - ((c2.Green and $FF00) shr 8);
|
|
temp.b:=((c1.Blue and $FF00) shr 8) - ((c2.Blue and $FF00) shr 8);
|
|
Result:=temp;
|
|
end;
|
|
|
|
function TFPFloydSteinbergDitherer.Color2Real(const c : TFPColor) : TFPPixelReal;
|
|
var temp : TFPPixelReal;
|
|
begin
|
|
if FUseAlpha then
|
|
temp.a:=((c.Alpha and $FF00) shr 8);
|
|
temp.r:=((c.Red and $FF00) shr 8);
|
|
temp.g:=((c.Green and $FF00) shr 8);
|
|
temp.b:=((c.Blue and $FF00) shr 8);
|
|
Result:=temp;
|
|
end;
|
|
|
|
function TFPFloydSteinbergDitherer.Real2Color(r : TFPPixelReal) : TFPColor;
|
|
var temp : TFPColor;
|
|
begin
|
|
{ adjust overflows and underflows }
|
|
if r.r> 255 then r.r:=255; if r.r<0 then r.r:=0;
|
|
if r.g> 255 then r.g:=255; if r.g<0 then r.g:=0;
|
|
if r.b> 255 then r.b:=255; if r.b<0 then r.b:=0;
|
|
if FUseAlpha then
|
|
begin
|
|
if r.a> 255 then r.a:=255; if r.a<0 then r.a:=0;
|
|
end;
|
|
|
|
temp.Red:=round(r.r);
|
|
temp.Red:=(temp.Red shl 8) + temp.Red;
|
|
temp.Green:=round(r.g);
|
|
temp.Green:=(temp.Green shl 8) + temp.Green;
|
|
temp.Blue:=round(r.b);
|
|
temp.Blue:=(temp.Blue shl 8) + temp.Blue;
|
|
if FUseAlpha then
|
|
begin
|
|
temp.Alpha:=round(r.a);
|
|
temp.Alpha:=(temp.Alpha shl 8) + temp.Alpha;
|
|
end
|
|
else
|
|
temp.Alpha:=AlphaOpaque;
|
|
Result:=temp;
|
|
end;
|
|
|
|
procedure TFPFloydSteinbergDitherer.CreatePixelLine(var line : PFSPixelLine; const row : integer);
|
|
var i : integer;
|
|
begin
|
|
line:=GetMem(sizeof(TFSPixelLine));
|
|
if line=nil then
|
|
raise FPDithererException.Create('Out of memory');
|
|
line^.next:=nil;
|
|
{ two extra pixels so we don't have to check if the pixel is on start or end of line }
|
|
getmem(line^.pixels,sizeof(TFPPixelReal)*(FImage.Width+2));
|
|
if line^.pixels=nil then
|
|
raise FPDithererException.Create('Out of memory');
|
|
if row<FImage.Height-1 then
|
|
begin
|
|
line^.pixels[0]:=FSNullPixel;
|
|
line^.pixels[FImage.Width+1]:=FSNullPixel;
|
|
for i:=0 to FImage.Width-1 do
|
|
line^.pixels[i+1]:=Color2Real(FImage[i,row]);
|
|
end
|
|
else
|
|
for i:=0 to FImage.Width+1 do
|
|
line^.pixels[i]:=FSNullPixel;
|
|
end;
|
|
|
|
const e716 = 0.4375;
|
|
e516 = 0.3125;
|
|
e316 = 0.1875;
|
|
e116 = 0.0625;
|
|
|
|
procedure TFPFloydSteinbergDitherer.DistributeErrors(var line : PFSPixelLine; const row : integer; Img : TFPCustomImage);
|
|
var i, width : integer;
|
|
palindex : integer;
|
|
OldColor : TFPColor;
|
|
dir : shortint;
|
|
nextline : PFSPixelLine;
|
|
begin
|
|
width:=FImage.Width;
|
|
if (row mod 2)=0 then
|
|
begin
|
|
dir:=1;
|
|
i:=1;
|
|
end
|
|
else
|
|
begin
|
|
dir:=-1;
|
|
i:=width;
|
|
end;
|
|
if width<1 then exit;
|
|
|
|
repeat
|
|
OldColor:=Real2Color(line^.pixels[i]);
|
|
FindBestColor(OldColor, palindex);
|
|
Img.Pixels[i-1,row]:=palindex; { we use this color for this pixel... }
|
|
line^.pixels[i]:=GetError(OldColor,Palette[palindex]);
|
|
{ now distribute this error to the other pixels, in this way: }
|
|
{ note: for odd lines this is mirrored and we start from right}
|
|
{ 0 0 0 }
|
|
{ 0 X 7/16 }
|
|
{ 3/16 5/16 1/16 }
|
|
line^.pixels[i+dir].r:=line^.pixels[i+dir].r+(line^.pixels[i].r*e716);
|
|
line^.pixels[i+dir].g:=line^.pixels[i+dir].g+(line^.pixels[i].g*e716);
|
|
line^.pixels[i+dir].b:=line^.pixels[i+dir].b+(line^.pixels[i].b*e716);
|
|
if FUseAlpha then
|
|
line^.pixels[i+dir].a:=line^.pixels[i+dir].a+(line^.pixels[i].a*e716);
|
|
nextline:=line^.next;
|
|
|
|
nextline^.pixels[i].r:=nextline^.pixels[i].r+(line^.pixels[i].r*e516);
|
|
nextline^.pixels[i].g:=nextline^.pixels[i].g+(line^.pixels[i].g*e516);
|
|
nextline^.pixels[i].b:=nextline^.pixels[i].b+(line^.pixels[i].b*e516);
|
|
if FUseAlpha then
|
|
nextline^.pixels[i].a:=nextline^.pixels[i].a+(line^.pixels[i].a*e516);
|
|
|
|
nextline^.pixels[i+dir].r:=nextline^.pixels[i+dir].r+(line^.pixels[i].r*e116);
|
|
nextline^.pixels[i+dir].g:=nextline^.pixels[i+dir].g+(line^.pixels[i].g*e116);
|
|
nextline^.pixels[i+dir].b:=nextline^.pixels[i+dir].b+(line^.pixels[i].b*e116);
|
|
if FUseAlpha then
|
|
nextline^.pixels[i+dir].a:=nextline^.pixels[i+dir].a+(line^.pixels[i].a*e116);
|
|
|
|
nextline^.pixels[i-dir].r:=nextline^.pixels[i-dir].r+(line^.pixels[i].r*e316);
|
|
nextline^.pixels[i-dir].g:=nextline^.pixels[i-dir].g+(line^.pixels[i].g*e316);
|
|
nextline^.pixels[i-dir].b:=nextline^.pixels[i-dir].b+(line^.pixels[i].b*e316);
|
|
if FUseAlpha then
|
|
nextline^.pixels[i-dir].a:=nextline^.pixels[i-dir].a+(line^.pixels[i].a*e316);
|
|
|
|
i:=i+dir;
|
|
until ((i<1) or (i>width));
|
|
end;
|
|
|
|
procedure TFPFloydSteinbergDitherer.DeleteAllPixelLines(var line : PFSPixelLine);
|
|
var tmp : PFSPixelLine;
|
|
begin
|
|
while line<>nil do
|
|
begin
|
|
tmp:=line^.next;
|
|
FreeMem(line^.pixels);
|
|
FreeMem(line);
|
|
line:=tmp;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPFloydSteinbergDitherer.InternalDither(const Source : TFPCustomImage; Dest : TFPCustomImage);
|
|
var i : integer;
|
|
tmpline : PFSPixelLine;
|
|
percent : byte;
|
|
percentinterval : longword;
|
|
percentacc : longword;
|
|
FContinue : boolean;
|
|
begin
|
|
FImage:=Source;
|
|
if FImage.Height=0 then exit;
|
|
Dest.SetSize(0,0);
|
|
try
|
|
Dest.UsePalette:=true;
|
|
Dest.Palette.Clear;
|
|
Dest.Palette.Merge(FPalette);
|
|
Dest.SetSize(FImage.Width,FImage.Height);
|
|
percent:=0;
|
|
percentinterval:=(FImage.Height*4) div 100;
|
|
if percentinterval=0 then percentinterval:=$FFFFFFFF;
|
|
percentacc:=0;
|
|
FContinue:=true;
|
|
Progress (self,psStarting,0,'',FContinue);
|
|
if not FContinue then exit;
|
|
CreatePixelLine(Lines,0);
|
|
CreatePixelLine(Lines^.next,1);
|
|
|
|
for i:=0 to FImage.Height-1 do
|
|
begin
|
|
DistributeErrors(Lines, i, Dest);
|
|
tmpline:=Lines;
|
|
Lines:=Lines^.next;
|
|
FreeMem(tmpline^.pixels);
|
|
FreeMem(tmpline);
|
|
CreatePixelLine(Lines^.next,i+2);
|
|
inc(percentacc,4);
|
|
if percentacc>=percentinterval then
|
|
begin
|
|
percent:=percent+(percentacc div percentinterval);
|
|
percentacc:=percentacc mod percentinterval;
|
|
Progress (self,psRunning,percent,'',FContinue);
|
|
if not FContinue then exit;
|
|
end;
|
|
end;
|
|
Progress (self,psEnding,100,'',FContinue);
|
|
finally
|
|
DeleteAllPixelLines(lines);
|
|
end;
|
|
end;
|
|
|
|
|
|
end. |