| 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;
 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
 
 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
 
 end;
 
 var
 Niko: TNiko;
 
 implementation
 
 {$R *.dfm}
 const
 cOrt: TOrt =
 ((Anzahl: 2; Nachbar: (2, 3, 0, 0, 0)),     (Anzahl: 4; Nachbar: (1, 3, 4, 5, 0)),     (Anzahl: 4; Nachbar: (1, 2, 4, 5, 0)),     (Anzahl: 5; Nachbar: (2, 3, 5, 6, 7)),     (Anzahl: 5; Nachbar: (2, 3, 4, 6, 7)),     (Anzahl: 4; Nachbar: (4, 5, 7, 8, 0)),     (Anzahl: 4; Nachbar: (4, 5, 6, 8, 0)),     (Anzahl: 2; Nachbar: (6, 7, 0, 0, 0)));
 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
 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.
 |