procedure Strichliste(zahl, maxzahl: word; b: TBitmap; waagerecht, hoehe, 
  blockabstand: byte; stift, papier: TColor; fuzzy, transpa: boolean); 
var 
  blockzahl, gblockzahl, senkrecht, gsenkrecht, abstand, abzug, 
    i, j, k, f1, f2: integer; 
  procedure f1f2; 
  begin with b.canvas do begin 
      f1 := random(2) * pen.width * ord(fuzzy); 
      f2 := random(2) * pen.width * ord(fuzzy); 
    end; 
  end; 
  procedure block(x, y, z: integer); 
  var 
    w: integer; 
  begin 
    with b.canvas do begin 
      for w := 0 to z - 1 - ord(z = 5) do begin 
        f1f2; 
        moveto(x + w * abstand + abstand + f2, y + abstand + f1); 
        lineto(x + w * abstand + abstand + f1, y + hoehe + abstand + f2); 
      end; 
      if z = 5 then begin 
        f1f2; 
        moveto(x - pen.width * 2 + abstand, y + hoehe - 1 + f1 * 2); 
        lineto(x + 4 * abstand + pen.width * 2, 
          y + hoehe - abstand * 2 - 1 + f2 * 2); 
      end; 
    end; 
  end; 
begin 
  if hoehe < 8 + ord(fuzzy) * 4 then hoehe := 8 + ord(fuzzy) * 4; 
  if blockabstand < 2 then blockabstand := 2; 
  inc(maxzahl, ord(maxzahl = 0)); 
  if maxzahl < zahl then maxzahl := zahl; 
  blockzahl := (zahl div 5) + ord(zahl mod 5 > 0); 
  gblockzahl := (maxzahl div 5) + ord(maxzahl mod 5 > 0); 
  if gblockzahl < waagerecht then waagerecht := gblockzahl; 
  inc(waagerecht, ord(waagerecht = 0)); 
  senkrecht := (blockzahl div waagerecht) + ord(blockzahl mod waagerecht > 0); 
  gsenkrecht := (gblockzahl div waagerecht) 
    + ord(gblockzahl mod waagerecht > 0); 
  abstand := (hoehe div 4) + ord(hoehe div 4 = 0); 
  abzug := 5 - (zahl mod 5); 
  if abzug = 5 then abzug := 0; 
  with b do begin 
    height := (hoehe + abstand div 2) * gsenkrecht + abstand * 2 
      + (gsenkrecht - 1) * blockabstand - abstand div 2; 
    with canvas do begin 
      pen.width := hoehe div 10 + ord(hoehe div 10 = 0); 
      brush.color := papier; 
      pen.color := stift; 
      width := hoehe * waagerecht + abstand + pen.width * 2 
        + (waagerecht - 1) * blockabstand; 
      fillrect(cliprect); 
      if zahl > 0 then begin 
        for j := 0 to senkrecht - 1 do 
          for i := 0 to waagerecht - 1 do begin 
            k := j * waagerecht + i; 
            if k < blockzahl then 
              block(i * hoehe + i * blockabstand + abstand div 2, 
                j * hoehe + j * (blockabstand + abstand div 2), 
                5 - abzug * ord(k = blockzahl - 1)); 
          end; 
      end; 
    end; 
    transparent := transpa; 
  end; 
end; 
 
 
// --- Beispielaufrufe --- 
 
// Sofort-Anzeige mit geraden Strichen 
procedure TForm1.Button9Click(Sender: TObject); 
var 
  bm: TBitmap; 
begin 
  bm := TBitmap.create; 
  Strichliste(83, 83, bm, 5, 20, 12, clyellow, clblack, false, false); 
  canvas.draw(5, 5, bm); 
  bm.free; 
end; 
 
// Langsamer Aufbau mit gekritzelten Strichen 
procedure TForm1.Button10Click(Sender: TObject); 
var 
  bm: TBitmap; 
  maxzahl: word; 
  x: integer; 
begin 
  maxzahl := 83; 
  bm := TBitmap.create; 
  for x := 1 to maxzahl do begin 
    randseed := maxzahl; 
    Strichliste(x, maxzahl, bm, 5, 20, 12, clyellow, clblack, true, false); 
    canvas.draw(5, 5, bm); 
    sleep(100); 
    if x mod 5 = 0 then sleep(50); 
  end; 
  bm.free; 
end;