const 
  maxi = 20; // maximale Durchläufe pro Zeichen 
 
var 
  worte: string = 'Programmieren mit Delphi'; 
  s: string; 
  lg: integer; 
  arr: array of integer; 
 
procedure zeichen(x: integer); 
begin 
  if worte[x] in ['a'..'z'] then s[x] := chr(random(26) + 97) else 
    if worte[x] in ['A'..'Z'] then s[x] := chr(random(26) + 65) else 
      if worte[x] in ['0'..'9'] then s[x] := chr(random(10) + 48) else 
        s[x] := worte[x]; 
end; 
 
function zufall: string; 
var 
  x: integer; 
begin 
  randomize; 
  for x := 1 to lg do begin 
    zeichen(x); 
    arr[x - 1] := 0; 
  end; 
  result := s; 
end; 
 
function festlegen: string; 
begin 
  s := zufall; 
  result := s; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Timer1.interval := 0; 
  lg := length(worte); 
  Label1.Font.Name := 'Courier New'; // feste Breite 
  Label1.Font.Size := 14; // z.B. 
  Label1.Font.style := [fsBold]; 
  setlength(s, lg); 
  setlength(arr, lg); 
  Label1.caption := festlegen; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if Timer1.interval = 0 then begin 
// --- zum Testen ---------------------------- 
    if s = worte then Label1.caption := festlegen; 
// ------------------------------------------- 
    Timer1.interval := 100; 
  end; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
var 
  x: integer; 
begin 
  if s = worte then Timer1.interval := 0 
  else begin 
    for x := 1 to lg do 
      if worte[x] <> s[x] then begin 
        inc(arr[x - 1]); 
        if arr[x - 1] = maxi then s[x] := worte[x] 
        else zeichen(x); 
      end; 
    Label1.caption := s; 
  end; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  arr := nil; 
end;