// Der "Median-Filter" ist ein spezieller Weichzeichner, der im 
// Gegensatz zu Box-Filtern die Werte einer bestimmten Fläche sortiert 
// und nicht einfach den Mittelwert nimmt. Dadurch wird das Ganze aber 
// sehr rechenzeitintensiv. 
 
// Getestet mit D4 unter XP

const 
  value1 = 145; 
  value2 = 24; 
 
type 
  ar = array[0..value2] of byte; 
  wert = 0..value1; 
  was = 0..value2; 
 
var 
  arr, arg, arb: ar; 
 
procedure Sort(var A: array of byte); 
  procedure QSort(LoIndex, HiIndex: Integer); 
  var 
    Lo, Hi: Integer; 
    Pivot: Integer; 
    Swap: byte; 
  begin 
    Pivot := A[(LoIndex + HiIndex) div 2]; 
    Lo := LoIndex; 
    Hi := HiIndex; 
    repeat 
      while A[Lo] < Pivot do Inc(Lo); 
      while A[Hi] > Pivot do Dec(Hi); 
      if Lo <= Hi then 
      begin 
        Swap := A[Lo]; 
        A[Lo] := A[Hi]; 
        A[Hi] := Swap; 
        Inc(Lo); 
        Dec(Hi); 
      end; 
    until Lo > Hi; 
    if LoIndex < Hi then QSort(LoIndex, Hi); 
    if Lo < HiIndex then QSort(Lo, HiIndex); 
  end; 
begin 
  QSort(0, value2); 
end; 
 
procedure median(bm: TBitmap; wieviel: wert; welches: was); 
var hlp: TBitmap; 
  a, x, y, z, b3: Integer; 
  pgo, po, pm, pu, pgu: PBytearray; 
  diff: byte; 
begin 
  screen.cursor := crHourGlass; 
  inc(wieviel, 99); 
  diff := 255 - wieviel; 
  hlp := TBitmap.create; 
  hlp.width := bm.width + 4; 
  hlp.height := bm.height + 4; 
  for x := 0 to 1 do 
    for y := 0 to 1 do 
      hlp.canvas.draw(x * 4, y * 4, bm); 
  hlp.canvas.draw(2, 2, bm); 
  if wieviel >= 100 then begin 
    hlp.pixelformat := pf24bit; 
    b3 := hlp.width * 3 - 6; 
    for y := 2 to hlp.height - 3 do begin 
      pgo := hlp.scanline[y - 2]; 
      po := hlp.scanline[y - 1]; 
      pm := hlp.scanline[y]; 
      pu := hlp.scanline[y + 1]; 
      pgu := hlp.scanline[y + 2]; 
      x := 6; 
      while x < b3 do begin 
        for z := 0 to 4 do begin 
          a := x + z * 3 - 6; 
          arb[z] := pgo[a]; 
          arb[z + 5] := po[a]; 
          arb[z + 10] := pm[a]; 
          arb[z + 15] := pu[a]; 
          arb[z + 20] := pgu[a]; 
          inc(a); 
          arg[z] := pgo[a]; 
          arg[z + 5] := po[a]; 
          arg[z + 10] := pm[a]; 
          arg[z + 15] := pu[a]; 
          arg[z + 20] := pgu[a]; 
          inc(a); 
          arr[z] := pgo[a]; 
          arr[z + 5] := po[a]; 
          arr[z + 10] := pm[a]; 
          arr[z + 15] := pu[a]; 
          arr[z + 20] := pgu[a]; 
        end; 
        sort(arb); 
        sort(arg); 
        sort(arr); 
        pm[x] := (arb[welches] * wieviel + pm[x] * diff) shr 8; 
        pm[x + 1] := (arg[welches] * wieviel + pm[x + 1] * diff) shr 8; 
        pm[x + 2] := (arr[welches] * wieviel + pm[x + 2] * diff) shr 8; 
        inc(x, 3); 
      end; 
    end; 
  end; 
  bm.canvas.draw(-2, -2, hlp); 
  hlp.free; 
  screen.cursor := crDefault; 
end;

 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  bmp: TBitmap; 
  fn: string; 
begin 
  fn := 'c:\frau.bmp'; 
  bmp := TBitmap.create; 
 
  bmp.loadfromfile(fn); 
  canvas.draw(10, 10, bmp); 
  median(bmp, 64, 15); 
  canvas.draw(20 + bmp.width, 10, bmp); 
 
  bmp.loadfromfile(fn); 
  median(bmp, 98, 16); 
  canvas.draw(10, 50 + bmp.height, bmp); 
 
  bmp.loadfromfile(fn); 
  median(bmp, 57, 8); 
  canvas.draw(20 + bmp.width, 50 + bmp.height, bmp); 
 
  bmp.free; 
end;