Floyd-Steinberg Dithering

[Amateurprofi]

@shmia,
vielen herzlichen Dank!
Hab mich aufgerufen gefühlt.
Ist etwas schneller als das Original.
Zeitbedarf für ein Bild mit 4608 x 3456 Pixeln:
Original ca. 180 s
Fälschung ca. 1 s

Delphi-Quellcode:

PROCEDURE FloydSteinberg(Bmp:TBitmap);
resourcestring
   sNo24Bit='Bmp ist keine pf24bit-Bitmap';
   sSize='%S der Bitmap ist = 0';
type
   TBGR=packed record Blue,Green,Red:Byte; end;
   TxBGR=packed record xBlue,xGreen,xRed:Byte; end;
   TPBGR=^TBGR;
   TPxBGR=^TxBGR;
   TDelta=packed record B,G,R:Integer; end;
var
   LO:NativeInt; // Offset zur jeweils nächsten Zeile in Bmp
   Delta:TDelta; // Differenzen alte Farbanteile - neue Farbanteile
   P:TPBGR;      // Zeiger auf aktuelles Pixel
//------------------------------------------------------------------------------
PROCEDURE SetNearestColor;
const
   NC:Array[Boolean] of TBGR=
      ((Blue:255; Green:255; Red:255),(Blue:0; Green:0; Red:0));
var OldPixel:TBGR;
begin
   OldPixel:=P^;
   with OldPixel, TPxBGR(P)^, Delta do begin
       P^:=NC[Blue*21+Green*174+Red*61<32768];
       B:=Blue-xBlue;
       G:=Green-xGreen;
       R:=Red-xRed;
   end;
end;
//------------------------------------------------------------------------------
PROCEDURE SetPixel(XOffset,YOffset,Factor:Integer);
var AP:TPBGR;
begin
   // XOffset=Horizontaler Offset in Pixel
   // YOffset=Vertikaler Offset in Bytes
   AP:=P;
   Inc(AP,XOffset);
   Inc(NativeInt(AP),YOffset);
   with AP^, Delta do begin
      Blue:=EnsureRange(Blue+B*Factor div 16,0,255);
      Green:=EnsureRange(Green+G*Factor div 16,0,255);
      Red:=EnsureRange(Red+R*Factor div 16,0,255);
   end;
end;
//------------------------------------------------------------------------------
var W,H,X,Y:Integer; PP:TPBGR;
begin
   if Bmp.PixelFormat<>pf24Bit then raise Exception.Create(sNo24Bit);
   W:=Bmp.Width-1;  // Letztes Pixel einer Zeile
   H:=Bmp.Height-1; // Letzte Zeile
   if W<0 then raise Exception.CreateFmt(sSize,['Breite']);
   if H<0 then raise Exception.CreateFmt(sSize,['Höhe']);
   PP:=Bmp.ScanLine[0];
   if H>0 then LO:=NativeInt(Bmp.ScanLine[1])-NativeInt(PP) else LO:=0;
   for Y:=H downto 0 do begin
      P:=PP;
      for X:=W downto 0 do begin
         SetNearestColor;
         if X<>0 then SetPixel(1,0,7);
         if Y<>0 then  begin
            if X<>W then SetPixel(-1,LO,3);
            SetPixel(0,LO,5);
            if X<>0 then SetPixel(1,LO,1);
         end;
         Inc(P);
      end;
      Inc(NativeInt(PP),LO)
   end;
end;