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;

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

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;

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

// Variante 3: Mittels RGBTriple und dynamischer Tabelle

type 
  Range = -100 .. 500;

procedure Kontrast(const bmp: TBitmap; strength: Range); 
const 
  half = 128; 
var 
  x, y: Integer; 
  pix: PRGBTriple; 
  arr: array of Byte; 
  function boundary(i: Integer): Byte; 
  asm 
    CMP  EAX, $FF 
    JG   @MAX 
    CMP  EAX, 0 
    JGE  @OK 
    MOV  EAX, 0 
    JMP  @OK 
  @MAX: 
    MOV  EAX, $FF 
  @OK: 
  end; 
 begin 
    setlength(arr, 256); 
    for x := 0 to 255 do 
      arr[x] := boundary(Round((x - half) * (strength / 100 + 1)) + half); 
    for y := 0 to pred(bmp.height) do 
    begin 
      pix := bmp.Scanline[y]; 
      for x := 0 to pred(bmp.width) do 
      begin 
        pix.rgbtred := arr[pix.rgbtred]; 
        pix.rgbtblue := arr[pix.rgbtblue]; 
        pix.rgbtgreen := arr[pix.rgbtgreen]; 
        inc(pix); 
      end; 
    end; 
    arr := nil; 
 end;