type 
  TForm1 = class(TForm) 
    Image1: TImage; 
    TrackBar1: TTrackBar; // Häufigkeit 
    TrackBar2: TTrackBar; // Stärke 
    TrackBar3: TTrackBar; // Intensität 
    RadioButton1: TRadioButton; // dünn 
    RadioButton2: TRadioButton; // mittel 
    RadioButton3: TRadioButton; // dick 
    SpeedButton1: TSpeedButton; // Zufall 
    //--- durch Doppelklick im Objektinspektor erstellen --- 
    procedure FormCreate(Sender: TObject); 
    procedure RadioButton1Click(Sender: TObject); 
    procedure SpeedButton1Click(Sender: TObject); 
    procedure TrackBar1Change(Sender: TObject); 
    //------------------------------------------------------- 
  private 
    { Private-Deklarationen } 
  public 
    procedure go; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
var 
  dicke: integer = 1; 
  rs: integer = 1234567890; 
  datei: string = 'C:\Test.bmp'; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
//--- kann im Objektinspektor eingestellt werden --- 
  Image1.autosize := true; 
  Radiobutton1.tag := 1; 
  Radiobutton2.tag := 2; 
  Radiobutton3.tag := 3; 
  Radiobutton2.OnClick := RadioButton1Click; 
  Radiobutton3.OnClick := RadioButton1Click; 
  Radiobutton1.checked := true; 
  Trackbar1.max := 50; 
  Trackbar2.max := 50; 
  Trackbar3.max := 200; 
  Trackbar1.position := 10; 
  Trackbar2.position := 10; 
  Trackbar1.Frequency := 5; 
  Trackbar2.Frequency := 5; 
  Trackbar3.Frequency := 20; 
  Trackbar2.OnChange := TrackBar1Change; 
  Trackbar3.OnChange := TrackBar1Change; 
//-------------------------------------------------- 
end; 
 
procedure TForm1.RadioButton1Click(Sender: TObject); 
begin 
  dicke := TRadioButton(sender).tag; 
  go; 
end; 
 
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: 
  MOV  @RESULT, AL 
end; 
 
procedure nass(bm: TBitmap; st, lg, wn: integer); 
var hlp: TBitmap; 
  x, y, b3, w, h, l, l2, z, k, c, i, a: integer; 
  p1, p2: PBytearray; 
begin 
  randseed := rs; 
  bm.pixelformat := pf24bit; 
  hlp := TBitmap.create; 
  hlp.pixelformat := pf24bit; 
  hlp.width := bm.width; 
  hlp.height := bm.height; 
  hlp.canvas.draw(0, 0, bm); 
  b3 := bm.width * 3; 
  for w := 0 to trunc(sqrt(bm.width * bm.height * st * st div 7)) do begin 
    h := random(bm.height); 
    x := random(bm.width - dicke) * 3; 
    l := random(lg) + 5; 
    l2 := h + (l * 2) div 3; 
    p1 := hlp.scanline[h]; 
    for y := h to h + l do 
      if y < hlp.height then begin 
        p2 := bm.scanline[y]; 
        a := y - h; 
        k := setbyte(a * (wn div (a + 3))); 
        i := 255 - k; 
        for z := 0 to dicke - ord(y > l2) do begin 
          c := x + z * 3; 
          if (c >= 0) and (c < b3) then begin 
            p2[c] := (p1[c] * i + p2[c] * k) shr 8; 
            p2[c + 1] := (p1[c + 1] * i + p2[c + 1] * k) shr 8; 
            p2[c + 2] := (p1[c + 2] * i + p2[c + 2] * k) shr 8; 
          end; 
        end; 
      end; 
  end; 
  hlp.free; 
end; 
 
procedure TForm1.go; 
var bm: TBitmap; 
begin 
  screen.cursor := crhourglass; 
  bm := TBitmap.create; 
  bm.loadfromfile(datei); 
  nass(bm, Trackbar1.position + 1, Trackbar2.position + 1, Trackbar3.position + 50); 
  image1.picture.assign(bm); 
  bm.free; 
  screen.cursor := crdefault; 
end; 
 
procedure TForm1.SpeedButton1Click(Sender: TObject); 
begin 
  randomize; 
  rs := random(maxint); 
  go; 
end; 
 
procedure TForm1.TrackBar1Change(Sender: TObject); 
begin 
  go; 
end;