1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:

// Ist der Piexel eher Schwarz, oder eher weiss?
function GetClosestColor(b,g,r:integer):integer;
begin
    if ((b+g+r) DIV 3) > 128 then result := 255
    else result := 0;
end;

//Ändert die Farbwerte eines Pixels 
procedure AddError(var b,g,r:byte; bdif,gdif,rdif:double);
var btmp,rtmp,gtmp:integer;
begin
    btmp:=b;
    gtmp:=g;
    rtmp:=r;

    btmp:=round(b-bdif);
    if btmp<0 then b:=0
        else if btmp>255 then b:=255
            else b:=btmp;

    gtmp:=round(g-gdif);
    if gtmp<0 then g:=0
        else if gtmp>255 then g:=255
            else g:=gtmp;

    rtmp:=round(r-rdif);
    if rtmp<0 then r:=0
        else if rtmp>255 then r:=255
            else r:=rtmp;
end;

procedure Dithering(aBitmap:TBitmap);
var
    Zeile1,Zeile2 : PByteArray;
    x,y:integer;
    rdif,gdif,bdif:integer;
    closestcolor:integer;
begin
    for y:= 0 to aBitmap.Height -1 do
    begin
        // eine Bldzeile einlesen
        Zeile1 := aBitmap.Scanline[y];
        // wenn noch eine Weitere vorhanden, dann noch eine einlesen
        if y<aBitmap.Height-1 then
            zeile2:=aBitmap.Scanline[y+1];
        for x := 0 to aBitmap.Width -1 do
        begin
            // neue Farbe des aktuellen Pixels bestimmen
            closestcolor:=getClosestColor(Zeile1[3*x],Zeile1[3*x+1],Zeile1[3*x+2]);
            // Fehler berechnen
            bdif:=closestcolor-Zeile1[3*x];
            gdif:=closestcolor-Zeile1[3*x+1];
            rdif:=closestcolor-Zeile1[3*x+2];
            // Pixel ändern
            Zeile1[3*x]:=closestcolor;
            Zeile1[3*x+1]:=closestcolor;
            Zeile1[3*x+2]:=closestcolor;
            // Dithering, d.h. der fehler wird auf umgebende Pixel verteilt
            // dabei müssen die Grenzen des Bildes beachtet werden
            if x<aBitmap.Width-1 then
                AddError(
                    Zeile1[3*x+3],Zeile1[3*x+4],Zeile1[3*x+5],
                    bdif*7/16,gdif*7/16,rdif*7/16);
            if y<aBitmap.Height-1 then
            begin
                AddError(
                    Zeile2[3*x],Zeile2[3*x+1],Zeile2[3*x+2],
                    bdif*5/16,gdif*5/16,rdif*5/16);
                if x<aBitmap.Width-1 then
                    AddError(
                    Zeile2[3*x+3],Zeile2[3*x+4],Zeile2[3*x+5],
                    bdif*1/16,gdif*1/16,rdif*1/16);
                if x>0 then
                    AddError(
                    Zeile2[3*x-3],Zeile2[3*x-2],Zeile2[3*x-1],
                    bdif*3/16,gdif*3/16,rdif*3/16);
            end;
        end;
    end;
end;