1:

Ergebnis.Lines := ErgList{die Stringliste};                    

1:
2:

      if N < StreckenZahl-1 then
      //if not Fertig then                    

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:

unit Nikolaus;
{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
{$IFnDEF FPC}
  Windows,
{$ELSE}
  LCLIntf, LCLType, LMessages,
{$ENDIF}
  Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

const
  PunkteZahl = 8;
  StreckenZahl = 16;//2*PunkteZahl ?

type
  TPunkt = record
    Anzahl: integer;
    Nachbar: array[1..5] of integer
  end;

  TOrt = array[1..PunkteZahl] of TPunkt;

  TNiko = class(TForm)
    Aufgabe: TImage;
    Ergebnis: TMemo;
    SucheWeg: TButton;
    procedure SucheWegClick(Sender: TObject);
  private
    { Private-Deklarationen }
    Ort: TOrt;
    Loesung: array[1..StreckenZahl] of integer;
    AnzahlLoesung: integer;
    ErgList : TStringList;
    procedure Init;
    procedure Ausgabe;
    function Fertig: boolean;
    procedure Verbinde(K, N: integer);

  public
    { Public-Deklarationen }
  end;

var
  Niko: TNiko;

implementation

{$R *.dfm}
//{$R+,Q+}
const
  cOrt: TOrt =
   ((Anzahl: 2; Nachbar: (2, 3, 0, 0, 0)), //A
    (Anzahl: 4; Nachbar: (1, 3, 4, 5, 0)), //B
    (Anzahl: 4; Nachbar: (1, 2, 4, 5, 0)), //C
    (Anzahl: 5; Nachbar: (2, 3, 5, 6, 7)), //D
    (Anzahl: 5; Nachbar: (2, 3, 4, 6, 7)), //E
    (Anzahl: 4; Nachbar: (4, 5, 7, 8, 0)), //F
    (Anzahl: 4; Nachbar: (4, 5, 6, 8, 0)), //G
    (Anzahl: 2; Nachbar: (6, 7, 0, 0, 0)));//H

procedure TNiko.Init;
begin
  Ort := cOrt;
  ErgList := TStringList.Create;
  Ergebnis.Clear;
end;

procedure TNiko.Ausgabe;
var
  K: integer;
  Zeile: string;
begin
  Inc(AnzahlLoesung);
  Zeile := IntToStr(AnzahlLoesung) + '-te Loesung: ';
  for K := 1 to StreckenZahl do
    Zeile := Zeile + char(Loesung[K] + 64);
  IF AnzahlLoesung >= ErgList.count then
    ErgList.capacity := AnzahlLoesung*8 div 5+10;
  ErgList.Add(Zeile);
end;

function TNiko.Fertig: boolean;
var
  K, L: integer;
begin
  Fertig := True;
  for K := 1 to PunkteZahl do
    for L := 1 to Ort[K].Anzahl do
      if Ort[K].Nachbar[L] > 0 then
      begin
        Fertig := False;
        exit;
      end;
end;

procedure TNiko.Verbinde(K, N: integer);
var
  L, M, Inhalt, NR: integer;
begin
  for L := 1 to Ort[K].Anzahl do
  begin
    Inhalt := Ort[K].Nachbar[L];
    if Inhalt > 0 then
    begin
      Ort[K].Nachbar[L] := 0;
      Loesung[N] := K;
      for M := 1 to Ort[Inhalt].Anzahl do
        if Ort[Inhalt].Nachbar[M] = K then
        begin
          NR := M;
          Ort[Inhalt].Nachbar[M] := 0;
        end;
      if N < StreckenZahl-1 then
      //if not Fertig then
        Verbinde(Inhalt, N + 1)
      else
      begin
        Loesung[N + 1] := Inhalt;
        Ausgabe;
      end;
      Ort[K].Nachbar[L] := Inhalt;
      Ort[Inhalt].Nachbar[NR] := K;
    end;
  end;
end;

procedure TNiko.SucheWegClick(Sender: TObject);
var
  K, G: integer;
begin
  Init;
  G := 0;
  Screen.Cursor := crHourGlass;
  for K := 1 to PunkteZahl do
  begin
    AnzahlLoesung := 0;
    FillChar(Loesung, SizeOf(Loesung), 0);
    Verbinde(K, 1);
    if Loesung[StreckenZahl] = 0 then
      ErgList.Add('keine Loesung fuer Punkt ' + char(K + 64))
    else
    begin
      Inc(G, AnzahlLoesung);
      ErgList.Add(IntToStr(AnzahlLoesung) + ' Loesungen von Punkt ' +
        char(K + 64) + ' aus.');
      ErgList.Add('');
    end;
  end;
  ErgList.Add('Es gibt insgesamt ' + IntToStr(G) + ' Loesungen.');
  Screen.Cursor := crDefault;
  Ergebnis.Lines.BeginUpdate;
  Ergebnis.Lines.Capacity := ErgList.count;
  Ergebnis.Lines := ErgList;
  Ergebnis.Lines.EndUpdate;
  ErgList.Free;
end;

end.                    

1:
2:
3:
4:
5:

procedure TNiko.Ausgabe;
var
....
 //  ErgList.Add(Zeile);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

keine Loesung fuer Punkt A
keine Loesung fuer Punkt B
keine Loesung fuer Punkt C
6880 Loesungen von Punkt D aus.

6880 Loesungen von Punkt E aus.

keine Loesung fuer Punkt F
keine Loesung fuer Punkt G
keine Loesung fuer Punkt H
Es gibt insgesamt 13760 Loesungen.