// Der folgende Code stellt sechs Filter zur Verfremdung von Farbfotos zu
// Verfügung. Auf Graustufen oder große Flächen in gleicher Farbe haben die
// Filter kaum eine Wirkung. Man setzt ein TLabel, ein TImage, ein TButton
// und eine TScrollbar auf die Form. Der Button schaltet zum nächsten Filter
// um, die Scrollbar regelt die Intensität der Filter. In das TImage können
// Windows-Bitmaps und JPegs geladen werden.

// Getestet mit D4 unter WinME und NT4

uses JPeg;

type 
  rcd = record 
    Bezeichnung: string; 
    Value: integer; 
  end; 
 
var 
  buffer: array[0..255] of byte; 
  wert: array[0..5] of rcd; 
  bitmap: TBitmap; 
 
const 
  was: byte = 0; 
 
procedure MakeBitmap(bm, buff: TBitmap); 
var 
  P1, P2: PBytearray; 
  x, y, z: integer; 
begin 
  z := bm.width * 3 - 1; 
  for y := 0 to bm.height - 1 do begin 
    p1 := bm.scanline[y]; 
    p2 := buff.scanline[y]; 
    for x := 0 to z do begin 
      p1[x] := buffer[p2[x]]; 
    end; 
  end; 
end; 
 
procedure TForm1.Scrollbar1Change(Sender: TObject); 
var x, y: integer; 
begin 
  for x := 0 to 255 do begin 
    y := x + trunc(sin(x / wert[was].value) * Scrollbar1.Position); 
    if y > 255 then y := 255 else 
      if y < 0 then y := 0; 
    buffer[x] := y; 
  end; 
  MakeBitmap(Image1.Picture.Bitmap, Bitmap); 
  Image1.Refresh; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  inc(was); 
  if was > 5 then was := 0; 
  Label1.caption := wert[was].bezeichnung; 
  Scrollbar1Change(Sender); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bitmap.free; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var hlp: TBitmap; 
begin 
  hlp := TBitmap.create; 
  Image1.Picture.Loadfromfile('d:\bilder\strand.bmp'); 
  hlp.assign(Image1.Picture.graphic); 
  Image1.Picture.Bitmap.assign(hlp); // für Jpegs
  hlp.free; 
  Image1.Picture.Bitmap.Pixelformat := pf24bit; 
  wert[0].bezeichnung := 'Farbflecke'; 
  wert[0].value := 1; 
  wert[1].bezeichnung := 'Farbschlieren'; 
  wert[1].value := 9; 
  wert[2].bezeichnung := 'Gold 1'; 
  wert[2].value := 23; 
  wert[3].bezeichnung := 'Gold 2'; 
  wert[3].value := 26; 
  wert[4].bezeichnung := 'Solarisation'; 
  wert[4].value := 50; 
  wert[5].bezeichnung := 'Überbelichtung'; 
  wert[5].value := 80; 
  Label1.caption := wert[was].bezeichnung; 
  bitmap := TBitmap.create; 
  bitmap.width := Image1.Picture.Bitmap.width; 
  bitmap.height := Image1.Picture.Bitmap.height; 
  bitmap.Pixelformat := pf24bit; 
  bitmap.canvas.draw(0, 0, Image1.Picture.Bitmap); 
  Scrollbar1.min := 0; 
  Scrollbar1.max := 200; 
end; 


Zugriffe seit 6.9.2001 auf Delphi-Ecke