// Variante 1

type Staerke = 1..5; 
 
procedure antialias(b: TBitmap; s: Staerke); 
var w, x, y, z: integer; 
  p0, p1, p2: PBytearray; 
  st: byte; 
  procedure rand1; 
  begin 
    p1[x] := round((p0[x] * 2 + p2[x] * 2 + p1[x]) / 5); 
  end; 
  procedure rand2; 
  var i: integer; 
  begin 
    z := x * 3; 
    for i := 0 to 2 do 
      p0[z + i] := round((p0[z + i] + p1[z + i] * 4) / 5); 
  end; 
begin 
  b.pixelformat := pf24bit; 
  st := 10 - s * 2; 
  for y := 1 to b.height - 2 do begin 
    p0 := b.ScanLine[y - 1]; 
    p1 := b.scanline[y]; 
    p2 := b.ScanLine[y + 1]; 
    for x := 1 to b.width - 2 do begin 
      z := x * 3; 
      for w := 0 to 2 do 
        p1[z + w] := round((p0[z + w] + p2[z + w] + p1[(x - 1) * 3 + w] + 
          p1[(x + 1) * 3 + w] + p1[z + w] * st) / (4 + st)); 
    end; 
    for x := 0 to 2 do rand1; 
    for x := b.width * 3 - 4 to b.width * 3 - 1 do rand1; 
  end; 
  p0 := b.scanline[0]; 
  p1 := b.scanline[1]; 
  for x := 1 to b.width - 2 do rand2; 
  p0 := b.scanline[b.height - 1]; 
  p1 := b.scanline[b.height - 2]; 
  for x := 1 to b.width - 2 do rand2; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  antialias(image1.picture.bitmap, 3); 
  image1.refresh; 
end;

type 
  stufe = 1..10; 
 
procedure Antialising(bm: TBitmap; st: Stufe); 
var 
  y, x, b3: Integer; 
  R, G, B, R1, R2, G1, G2, B1, B2, pz, fz, d: Byte; 
  p, po, pu: PBytearray; 
  function ungleich: boolean; 
  begin 
    result := (R1 <> R2) or (G1 <> G2) or (B1 <> B2); 
  end; 
  procedure rech; 
  begin 
    R := R1 + (R2 - R1) * fz div d; 
    G := G1 + (G2 - G1) * fz div d; 
    B := B1 + (B2 - B1) * fz div d; 
  end; 
  procedure linksrechts(i: integer); 
  begin 
    R2 := p[x + i]; 
    G2 := p[x + i - 1]; 
    B2 := p[x + i - 2]; 
    if ungleich then begin 
      rech; 
      p[x + i] := R; 
      p[x + i - 1] := G; 
      p[x + i - 2] := B; 
    end; 
  end; 
  procedure obenunten(p2: PBytearray); 
  begin 
    R2 := p2[x + 2]; 
    G2 := p2[x + 1]; 
    B2 := p2[x]; 
    if ungleich then begin 
      rech; 
      p2[x + 2] := R; 
      p2[x + 1] := G; 
      p2[x] := B; 
    end; 
  end; 
begin 
  if (bm.width < 2) or (bm.height < 2) then exit; 
  bm.pixelformat := pf24bit;
  b3 := bm.width * 3; 
  pz := st * 10; 
  fz := 50; 
  d := (pz + fz); 
  for y := 0 to bm.height - 1 do begin 
    x := 0; 
    p := bm.scanline[y]; 
    if y = 0 then po := bm.scanline[y + 1] 
    else po := bm.scanline[y - 1]; 
    if y = bm.height - 1 then pu := bm.scanline[y - 1] 
    else pu := bm.scanline[y + 1]; 
    while x < b3 do begin 
      R1 := p[x + 2]; 
      G1 := p[x + 1]; 
      B1 := p[x]; 
      if x > 0 then linksrechts(-1) else linksrechts(5); 
      obenunten(po); 
      if x < b3 - 3 then linksrechts(5) else linksrechts(-1); 
      obenunten(pu); 
      inc(x, 3); 
    end; 
  end; 
end; 
 

//--------------------------------------------------------------

// Variante 3 (empfohlen)

type 
  Staerke = 0..10; 
 
procedure antialias(b: TBitmap; s: staerke); 
var 
  w, x, y, z, k, m, i: integer; 
  p0, p1, p2: PBytearray; 
  st, wd: byte; 
  procedure rand1; 
  begin 
    p1[x] := round((p0[x] * 2 + p2[x] * 2 + p1[x]) / 5); 
  end; 
  procedure rand2; 
  var 
    i: integer; 
  begin 
    z := x * 3; 
    for i := 0 to 2 do 
      p0[z + i] := round((p0[z + i] + p1[z + i] * 4) / 5); 
  end; begin 
  if s = 0 then exit; 
  b.Pixelformat := pf24bit; 
  if s > 7 then begin 
    st := 7; 
    wd := s - 7; 
  end else begin 
    st := 7 - s; 
    wd := 0; 
  end; 
  for i := 0 to wd do begin 
    for y := 1 to b.height - 2 do begin 
      p0 := b.ScanLine[y - 1]; 
      p1 := b.scanline[y]; 
      p2 := b.ScanLine[y + 1]; 
      for x := 1 to b.width - 2 do begin 
        z := x * 3; 
        k := (x - 1) * 3; 
        m := (x + 1) * 3; 
        for w := 0 to 2 do begin 
          p1[z + w] := trunc(( 
            p0[z + w] + p0[k + w] + p0[m + w] + 
            p2[z + w] + p2[k + w] + p2[m + w] + 
            p1[k + w] + p1[m + w] + p1[z + w] * st) / (st + 8)); 
        end; 
      end; 
    end; 
    p0 := b.scanline[0]; 
    p1 := b.scanline[1]; 
    for x := 1 to b.width - 2 do rand2; 
    p0 := b.scanline[b.height - 1]; 
    p1 := b.scanline[b.height - 2]; 
    for x := 1 to b.width - 2 do rand2; 
  end; 
end;