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. |