1:
2:

for L:=1 to Length(ErgebnisWort) do
 if pos(ErgebnisWort[L],Symbole)=0 then Symbole:=Symbole+ErgebnisWort[L];					

1:
2:
3:
4:
5:
6:
7:
8:

SetLength(ZahlWortListe,ZWN+1);
for K:=0 to ZWN-1 do
 begin
  Zahlwort:=ZWListe[K];LZW:=Length(Zahlwort);
  ZahlWortListe[K].L:=LZW;
  for L:=1 to LZW do
   ZahlWortListe[K].Ziffern[L]:=pos(Zahlwort[L],Symbole);
  end;					

1:
2:
3:

for L:=1 to LZW do
 Zahl:=DEZ*Zahl+Perm[ZahlWortListe[K].Ziffern[L]];
Zahlen[K]:=Zahl;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:

type
  TPermDat = byte;
  tpPermDat = ^TPermDat;
  TPerm = array[1..DEZ] of TPermDat;

  TZiffern = record
    L: integer;
    Ziffern: array[1..NMax] of tpPermDat
  end;
...
procedure TAlphametic.AlphaLoesenClick(Sender: TObject);
const
  Leer = '                ';
var
  LZW, LEW, ZWN, K, I, idx, AN: NativeInt;
  ZWListe, Loesung: array of string;
  ZahlWortListe: array of TZiffern;
  Zahlen: array of int64;
  Zahl32 : LongInt;
  Zahl, Summe, Ergebnis: int64;
  ErgebnisWort, Zahlwort, Zeile, Symbole: string;
  Perm: TPerm;
  OK, Vorhanden, Alle: boolean;
begin
  Ausgabe.Clear;
  Ausgabe.SetFocus;
  ZWN := 0;
  AN := 0;
  SetLength(Loesung, AN + 1);
  Loesung[0] := '###';
  for K := 0 to SummandenEingabe.Lines.Count - 1 do
    if SummandenEingabe.Lines[K] <> '' then
    begin
      Inc(ZWN);
      SetLength(ZWListe, ZWN);
      ZWListe[ZWN - 1] := SummandenEingabe.Lines[K];
    end;
  if ZWN = 0 then
  begin
    MessageDlg('Es gibt KEINE Summanden!', mtError, [mbRetry], 0);
    exit;
  end;
  Symbole := '';
  for K := 0 to ZWN - 1 do
  begin
    Zahlwort := ZWListe[K];
    LZW := Length(Zahlwort);
    for idx := 1 to LZW do
      if pos(Zahlwort[idx], Symbole) = 0 then
        Symbole := Symbole + Zahlwort[idx];
  end;
  ErgebnisWort := EditS.Lines[0];
  if ErgebnisWort = '' then
  begin
    MessageDlg('Michael Ende läßt grüßen, die unendliche Geschichte(das NICHTS)!',
      mtError, [mbRetry], 0);
    exit;
  end;
  for idx := 1 to Length(ErgebnisWort) do
    if pos(ErgebnisWort[idx], Symbole) = 0 then
      Symbole := Symbole + ErgebnisWort[idx];
  if Length(Symbole) > DEZ then
  begin
    MessageDlg('Zuviele Symbole!', mtError, [mbRetry], 0);
    exit;
  end;
  SummandenEingabe.Alignment := taRightJustify;
  EditS.Alignment := taRightJustify;
  SetLength(Zahlen, ZWN);
  // Berechnungsliste wird erstellt
  SetLength(ZahlWortListe, ZWN + 1);
  for K := 0 to ZWN - 1 do
  begin
    Zahlwort := ZWListe[K];
    LZW := Length(Zahlwort);
    with ZahlWortListe[K] do
    begin
      L := LZW;
      for idx := 1 to LZW do
        Ziffern[idx] := @Perm[pos(Zahlwort[idx], Symbole)];
    end;
  end;
  LEW := Length(ErgebnisWort);
  with ZahlWortListe[ZWN] do
  begin
    L := LEW;
    for idx := 1 to LEW do
      Ziffern[idx] := @Perm[pos(ErgebnisWort[idx], Symbole)];
  end;
  if LoesungErste.Checked then
    Alle := False
  else
    Alle := True;
  Screen.Cursor := crHourGlass;
  TrackBar.Max := NFak;
  // Zahlwort in Zahl wandeln
  for I := 1 to NFak do
  begin
    Summe := 0;
    Perm := PermListe[I];
    OK := True;
    for K := 0 to ZWN - 1 do
    begin
      Zahl32 := 0;
      with ZahlWortListe[K] do
      begin
        LZW := L;
        IF L > 9 then
        Begin
          for idx := 1 to 9 do
            Zahl32 := DEZ * Zahl32 + Ziffern[idx]^;
          Zahl := Zahl32;
          for idx := 10 to L do
            Zahl := DEZ * Zahl + Ziffern[idx]^;
        end
        else
        Begin
          for idx := 1 to L do
            Zahl32 := DEZ * Zahl32 + Ziffern[idx]^;
          Zahl := Zahl32;
        end;
      end;

      inc(summe,Zahl);
      Zahlen[K] := Zahl;
      if Length(IntToStr(Zahl)) <> LZW then
      begin
        OK := False;
        Break;
      end; // falsche Länge wegen der Null
    end;
    if OK then
    begin
      Ergebnis := 0;
      with ZahlWortListe[ZWN] do
      begin
        for idx := 1 to LEW do
          Ergebnis := DEZ * Ergebnis + Ziffern[idx]^;
      end;
      OK := OK and (LEW = Length(IntToStr(Ergebnis))); // falsche Länge wegen der Null
      if OK AND (Summe = Ergebnis) then
      begin
        Vorhanden := False;
        Zeile := '';
        for idx := 1 to Length(Symbole) do
          Zeile := Zeile + IntToStr(Perm[idx]);
        for idx := 0 to AN do
          if Loesung[idx] = Zeile then
            Vorhanden := True;
        if not Vorhanden then
        begin
          Inc(AN);
          SetLength(Loesung, AN + 1);
          Loesung[AN] := Zeile;
          idx := Length(IntToStr(Ergebnis));
          for K := 0 to ZWN - 1 do
          begin
            LZW := Length(IntToStr(Zahlen[K]));
            Ausgabe.Lines.Add(copy(Leer, 1, idx - LZW) + IntToStr(Zahlen[K]));
          end;
          Ausgabe.Lines.Add('_______________');
          Ausgabe.Lines.Add(IntToStr(Ergebnis));
          Ausgabe.Lines.Add(#13 + #10 + Symbole + #13 + #10 + Zeile);
          Ausgabe.Lines.Add(IntToStr(AN) + '-te Lösung');
          Ausgabe.Lines.Add('');
          Application.ProcessMessages;
          if not Alle then
            break;
        end;
      end;
    end;
    if I mod 16384 = 0 then
    begin
      Trackbar.Position := I;
      Application.ProcessMessages;
      //       if GetAsyncKeyState(VK_Escape)<0 then if MessageDlg('Suche abbrechen?',mtConfirmation,[mbYes,mbNo],0)=mrYes then break
    end;
  end;
  Screen.Cursor := crDefault;
  if AN = 1 then
    ShowMessage('Fertig mit der Arbeit!' + #13 + 'Es gibt genau eine Lösung.')
  else if AN = 0 then
    ShowMessage('Fertig mit der Suche!' + #13 + 'Es gibt KEINE Lösung.')
  else
    ShowMessage('Fertig mit der Arbeit!' + #13 + 'Es gibt ' +
      IntToStr(AN) + ' Lösungen.');
end;