type 
  stufe = -200..200; 
 
const 
  gesamt = 256; 
  teil = 8; 
 
var 
  bm: TBitmap; 
  f256: array[0..gesamt - 1] of TColor; 
 
  aOrange: array[0..teil - 1] of TColor = ( 
    $7FFF, $A0FF, $C1FF, $55, 
    clRed, clGreen, $80, clNavy); 
 
  aGruen: array[0..teil - 1] of TColor = ( 
    $00FF7F, $00FFA0, $00FFC1, $005500, 
    $004000, $002000, $2020FF, clGreen); 
 
  aBlau: array[0..teil - 1] of TColor = ( 
    $FF7F00, $FFA000, $FFC100, $550000, 
    $80F0, clNavy, $80, clBlue); 
 
function SetByte(i: integer): byte; 
asm 
  CMP  EAX, 255 
  JG   @MAX 
  CMP  EAX, 0 
  JGE  @OK 
  MOV  EAX, 0 
  JMP  @OK 
@MAX: 
  MOV  EAX,255 
@OK: 
end; 
 
procedure neu(Source, Dest: TBitmap; schwelle: stufe; a: array of TColor); 
var 
  lPal: PLogpalette; 
  i: integer; 
  hlp: TBitmap; 
  x, y, b3: Integer; 
  p: PBytearray; 
begin 
  hlp := TBitmap.create; 
  hlp.pixelformat := pf24bit; 
  zeromemory(@f256, sizeof(f256)); 
  for i := 0 to teil - 1 do f256[i] := a[i]; 
  Dest.width := Source.width; 
  Dest.height := Source.height; 
  hlp.width := Source.width; 
  hlp.height := Source.height; 
  hlp.canvas.draw(0, 0, source); 
  b3 := hlp.width * 3; 
  for y := 0 to hlp.height - 1 do begin 
    p := hlp.scanline[y]; 
    x := 0; 
    while x < b3 do begin 
      p[x] := setbyte(p[x] + schwelle); 
      p[x + 1] := setbyte(p[x + 1] + schwelle); 
      p[x + 2] := setbyte(p[x + 2] + schwelle); 
      inc(x, 3); 
    end; 
  end; 
  Dest.pixelformat := pf8bit; 
  lpal := AllocMem(sizeof(TLogPalette) + sizeof(TPaletteEntry) * gesamt); 
  lpal.palVersion := $300; 
  lpal.palNumEntries := gesamt; 
  for i := 0 to gesamt - 1 do 
    lpal.palPalEntry[i] := TPaletteentry(f256[i]); 
  Dest.palette := CreatePalette(lpal^); 
  Dest.canvas.draw(0, 0, hlp); 
  FreeMem(lpal); 
  hlp.free; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bm := TBitmap.create; 
  Trackbar1.min := low(stufe); 
  Trackbar1.max := high(stufe); 
  Trackbar1.position := 0; 
  Trackbar2.min := low(stufe); 
  Trackbar2.max := high(stufe); 
  Trackbar2.position := 0; 
  Trackbar3.min := low(stufe); 
  Trackbar3.max := high(stufe); 
  Trackbar3.position := 0; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bm.free; 
end; 
 
procedure TForm1.TrackBar1Change(Sender: TObject); 
begin 
  neu(Image1.picture.bitmap, bm, Trackbar1.position, aOrange); 
  canvas.draw(20, 200, bm); 
end; 
 
procedure TForm1.TrackBar2Change(Sender: TObject); 
begin 
  neu(Image1.picture.bitmap, bm, Trackbar2.position, aGruen); 
  canvas.draw(20, 200, bm); 
end; 
 
procedure TForm1.TrackBar3Change(Sender: TObject); 
begin 
  neu(Image1.picture.bitmap, bm, Trackbar3.position, aBlau); 
  canvas.draw(20, 200, bm); 
end;