// Mit dem folgenden Code kann man den Kontrast eines Bitmap im Bereich
// von -100
(flau) bis +100 (kontrastreich) einstellen.

// Getestet mit D4 unter WinME

// Variante 1: Mit Tabelle

type bereich = -100..100; 
 
var 
  kontrast: bereich; 
  original, ergebnis: TBitmap; 
  tbl: array[0..255] of byte; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  original := TBitmap.create; 
  ergebnis := TBitmap.create; 
  ergebnis.pixelformat := pf24bit; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  ergebnis.free; 
  original.free; 
end; 
 
procedure rechnen; 
var 
  x, z: integer; 
  kontr: double; 
begin 
  kontr := exp((kontrast + 62) / 27) / 10; 
  for x := 0 to 255 do begin 
    z := round((x - 127) * kontr + 127); 
    if z > 255 then z := 255 else 
      if z < 0 then z := 0; 
    tbl[x] := z; 
  end; 
end; 
 
procedure KontrastEinstellen; 
var 
  x, y, b: integer; 
  p1, p2: PBytearray; 
begin 
  b := ergebnis.width * 3 - 1; 
  for y := 0 to ergebnis.height - 1 do begin 
    p1 := original.scanline[y]; 
    p2 := ergebnis.scanline[y]; 
    x := 0; 
    while x < b do begin 
      p2[x] := tbl[p1[x]]; 
      p2[x + 1] := tbl[p1[x + 1]]; 
      p2[x + 2] := tbl[p1[x + 2]]; 
      inc(x, 3); 
    end; 
  end; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  original.loadfromfile('d:\bilder\frau.bmp'); 
  original.pixelformat := pf24bit; 
  ergebnis.width := original.width; 
  ergebnis.height := original.height; 
  kontrast := 25; // z.B. 
  rechnen; 
  KontrastEinstellen; 
  canvas.draw(0, 0, ergebnis); 
// zur Kontrolle: 
  canvas.draw(original.width + 2, 0, original); 
end;

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


// Variante 2: Direktberechnung

var 
  original: TBitmap; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with Trackbar1 do begin 
    min := -100; 
    max := 100; 
    position := 0; 
    Frequency := 10; 
  end; 
  original := TBitmap.create; 
  original.loadfromfile('d:\bilder\haus.bmp'); 
  original.pixelformat := pf24bit; 
  with Image1, Picture.Bitmap do begin 
    autosize := true; 
    pixelformat := pf24bit; 
    width := original.width; 
    height := original.height; 
    canvas.draw(0, 0, original); 
  end; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  original.free; 
end; 
 
procedure kontrast(src, dst: TBitmap; d: double); 
var x, y: integer; 
  ps, pd: PBytearray; 
  function rechnen(b: byte): byte; 
  var h: integer; 
  begin 
    h := trunc(b + (b - 128) * d); 
    if h > 255 then result := 255 
    else if h < 0 then result := 0 
    else result := h; 
  end; 
begin 
  with src do begin 
    for y := 0 to height - 1 do begin 
      ps := scanline[y]; 
      pd := dst.scanline[y]; 
      for x := 0 to width * 3 - 1 do 
        pd[x] := rechnen(ps[x]); 
    end; 
  end; 
end; 
 
procedure TForm1.TrackBar1Change(Sender: TObject); 
begin 
  kontrast(original, image1.picture.bitmap, Trackbar1.position / 100); 
  image1.refresh; 
end;

 


Zugriffe seit 6.9.2001 auf Delphi-Ecke