[DRINGEND] Frage zu Delphi + Labyrinth

[Trasher52]

Hi,

ich habe in Delphi ein Labyrinth erstellt, allerdings ist das Labyrinth immer das gleiche Modell, sodass der Weg immer der gleiche ist. Gibt es eine Möglichkeit, dass das Labyrinth jedes mal etwas anders ist? Ich habe zum Starten der Wegfindung 2 Button eingebaut. Einmal "neu" - Erstellt das Lab. in der Form und dann noch "start" - beginnt mit der Wegfindung. Nun suche ich also den Quelltext, den ich einbauen muss, damit immer ein anderes Labyrinth erstellt wird, sobald ich auf "neu" klicke.

Ich hoffe, ihr könnt mir helfen, es ist dringend!

Wenn jmd. das Programm haben will, bitte per PM melden!

Danke!

leute, kommt schon..

 

[Jean Pernod]

Für mich klingt das so:
"Hi Leute, ich hab hier ein Auto und hab den Schlüssel ins Radio gesteckt, wie Wechsel ich einen Reifen?"

Wenn du willst das jemand Zeit in die Beantwortung deiner Frage investiert, musste ihm wenigstens entgegenkommen und die Frage ordentlich aufbereiten.

So wird dir keiner helfen können.
Poste die relevanten Codeteile, vor allem den, der dein jetziges Lab. erstellt.

 

[Kabelsalat]

Jean Pernod spricht mir aus der Seele Soll nicht böse gemeint sein...

PS: Pushs entfernt...

 

[Trasher52]

Da ich es für sinnvoll halte, poste ich den kompletten Code und entschuldige mich für mein Fehlverhalten.

2 Units, eine FORM.

Die Units:

unit m_lab;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, interakt, ExtCtrls;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    bt_create: TButton;
    bt_search: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Timer1: TTimer;
    BtStop: TButton;
    Btgoon: TButton;
    procedure bt_createClick(Sender: TObject);
    procedure bt_searchClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BtStopClick(Sender: TObject);
    procedure BtgoonClick(Sender: TObject);
  private
   feld: array[0..19,0..18] of char;
   zielerreicht: boolean;
   procedure labyrinth(sp,zl: integer);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.bt_createClick(Sender: TObject);
var x, i, j: integer;
begin
zielerreicht:= false;
for i:= 0 to 19 do begin
for j:= 0 to 18 do begin
feld[i,j]:=' ';
StringGrid1.Cells[i,j]:= feld[i,j];
end;
end;
x:=0;
while x < 19 do
begin
for i:= 0 to 19 do
begin
feld[i,x]:='M';
StringGrid1.Cells[i,x]:= feld[i,x];
end;
x:=x+2;
end;
for i:=0 to 18 do begin
feld[0,i]:='M';
StringGrid1.Cells[0,i]:= feld[0,i];
end;
for i:=0 to 18 do begin
feld[19,i]:='M';
StringGrid1.Cells[19,i]:= feld[19,i];
end;
feld[2,2]:=' ';
StringGrid1.Cells[2,2]:= feld[2,2];
feld[7,4]:=' ';
StringGrid1.Cells[7,4]:= feld[7,4];
feld[13,6]:=' ';
StringGrid1.Cells[13,6]:= feld[13,6];
feld[1,8]:=' ';
StringGrid1.Cells[1,8]:= feld[1,8];
feld[14,10]:=' ';
StringGrid1.Cells[14,10]:= feld[14,10];
feld[7,12]:=' ';
StringGrid1.Cells[7,12]:= feld[7,12];
feld[11,13]:='M';
StringGrid1.Cells[11,13]:= feld[11,13];
feld[1,14]:=' ';
StringGrid1.Cells[1,14]:= feld[1,14];
feld[16,16]:=' ';
StringGrid1.Cells[16,16]:= feld[16,16];
feld[1,17]:='Z';
StringGrid1.Cells[1,17]:= feld[1,17];
feld[1,1]:= 'S';
stringgrid1.cells[1,1] := feld[1,1];
end;


procedure TForm1.labyrinth(sp,zl: integer);
var
zlz, spz : integer;
begin
if not zielerreicht then
begin
if (feld[sp,zl]<>'M') and (feld[sp,zl]<>'.') then
begin
if feld[sp,zl]='Z' then
begin
zielerreicht:=true;
feld[sp,zl]:= 'E';
StringGrid1.Cells[sp,zl]:= feld[sp,zl];
StringGrid1.Cells[1,1]:= feld[1,1];
label1.visible := true;
warte;
end
else
feld[sp,zl]:='.';
StringGrid1.Cells[sp,zl]:= feld[sp,zl];
warte;

spz:=1;
zlz:=17;

if (sp < 19) and (sp > 0) and (zl< 18) and (zl > 0)   then
begin
if (sp>spz)then
begin
     if (zl>zlz) then
     begin
     if abs(sp-spz)>abs(zl-zlz)
     then
     begin
     labyrinth(sp-1,zl);
     labyrinth(sp,zl-1);
     end
     else
     begin
     labyrinth(sp,zl-1);
     labyrinth(sp-1,zl);
     end;
     labyrinth(sp+1,zl);
     labyrinth(sp,zl+1);
     if not zielerreicht then
     begin
     feld[sp,zl]:='X';
     StringGrid1.Cells[sp,zl]:= feld[sp,zl];

     end;
     end
     else
     begin
     labyrinth(sp-1,zl);
     labyrinth(sp,zl+1);
     labyrinth(sp+1,zl);
     labyrinth(sp,zl-1);
     if not zielerreicht then
     begin
     feld[sp,zl]:='X';
     StringGrid1.Cells[sp,zl]:= feld[sp,zl];

     end;
     end
end
else
if (zl>zlz)then
   begin
   labyrinth(sp+1,zl);
   labyrinth(sp,zl-1);
   labyrinth(sp-1,zl);
   labyrinth(sp,zl+1);
   if not zielerreicht then
   begin
   feld[sp,zl]:='X';
   StringGrid1.Cells[sp,zl]:= feld[sp,zl];

   end;
   end
   else
   begin
   labyrinth(sp+1,zl);
   labyrinth(sp,zl+1);
   labyrinth(sp-1,zl);
   labyrinth(sp,zl-1);
   if not zielerreicht then
   begin
   feld[sp,zl]:='X';
   StringGrid1.Cells[sp,zl]:= feld[sp,zl];

   end;
end;

end;
end;
end;
end;


procedure TForm1.bt_searchClick(Sender: TObject);
begin
labyrinth(1,1);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   mach_weiter;
end;

procedure TForm1.BtStopClick(Sender: TObject);
begin
 timer1.Enabled := false;
 BtStop.Visible := false;
 Btgoon.Visible := true;
end;

procedure TForm1.BtgoonClick(Sender: TObject);
begin
timer1.Enabled := true;
Btgoon.visible := false;
Btstop.Visible := true;
end;

end.

Und die zweite Unit:

unit interakt;

interface

  uses forms;

  procedure init_Interaktion;
  procedure warte;
  procedure mach_weiter;
  procedure hoer_auf;
  procedure fang_wieder_an;

implementation

  var interaktion_erfolgt_,                    
      schluss_gesetzt_: Boolean;

  procedure init_Interaktion;
  begin
    interaktion_erfolgt_ := False;
    schluss_gesetzt_     := False;
  end;

  procedure warte;
  begin
    repeat
      Application.ProcessMessages
    until interaktion_erfolgt_ or schluss_gesetzt_;
    interaktion_erfolgt_ := False
  end;

  procedure mach_weiter;
  begin
    interaktion_erfolgt_:= True
  end;

  procedure hoer_auf;
  begin
    schluss_gesetzt_:= True
  end;

  procedure fang_wieder_an;
  begin
    schluss_gesetzt_:= false;
  end;

Initialization
  init_Interaktion;
end.

-----

Das sind die Units und ich muss nun einen Code einfügen, der vorgibt, dass das Labyrinth variiert. Ich weise darauf hin, dass der Code veröffentlicht wird, da ich um Hilfe bitte. ich wünsche jedoch nicht, dass der von mir gepostet Code für evtl. eigene Projekte gebraucht wird.

Bitte helft mir!

 

[Jean Pernod]

Sehr schön, aber so ist es schwer durchzusteigen. Poste das bitte mal in den

Code-Klammern (#-Symbol), damit man den Code vernünftig eingerückt sieht.

 

[Kabelsalat]

So sieht es bei dir bisher aus, richtig?

... Zufall gibt's auch bald. Muss bloß mit den Delphi-Klassen noch ein wenig durchsteigen. C# ist mir eindeutig lieber

Siehe Beitrag #15

Von der Logik her müsst das ganze korrekt sein und immer einen zufälligen, aber möglichen Weg zurückliefern. Dadurch, dass ein überschneiden des Weges möglich ist, können auch Verästelungen entstehen.

Die Unit kompiliert auch tadellos, bloß testen konnte ich sie nicht, da ich entweder eine Benachrichtigung über ein Debugger-Probelm erhalte und wenn es mal klappt, hagelt es EAAccessViolations - warum auch immer. Evtl. steckt also noch ein Fehler im Code, aber ich kann mich nicht die ganze Zeit dahinterklemmen.

 

[Trasher52]

Also, entweder blicke ich das mit dem Code nicht, oder es geht nicht.. Kann mir das jmd. nochmals erklären, wie ich das für euch so einrücken kann?

Zu Kabelsalat: Ersteinmal danke für deinen Beitrag, aber wie mir scheint liegt ein Missverständnis vor! Bei mir findet er den Weg zum Ziel ja problemlos und damit bin ich auch zufrieden, jedoch hätte ich gerne, dass das Lab. variiert - Sprich: Es soll immer anders aussehen und trotzdem soll der Weg immer gefunden werden. Die Wegbreite darf auch immer nur ein "Kästchen"betragen. Das hast du ja alles berücksichtigt, aber ist der von dir genannte Code der, den ich brauche, damit das Lab. variiert? Wenn ich ihn einbaue, passiert entweder nichts, oder es hagelt Fehlermeldungen. Was ich brauche ist lediglich der Code für das variieren des Lab. und wo ich diesen einbauen muss.

Falls es euch hilft, kann ich euch mein programm ja zusenden!

Vielen Dank aber schonmal!

 

[Kabelsalat]

Der Code dient eigentlich schon der Gestaltung eines Labyrinths. Realisiert habe ich das ganze in einer eigenständigen Klasse. Schau ihn dir einfach mal an, vielleicht findest du ja einige Anregungen. Testen konnte ich ihn allerdings nicht... (EA-Fehler - Wahrscheinlich aufgrund meiner eigenartigen Delphi-Installation. Auch der Debuuger bringt die ganze Zeit Fehlermeldungen.).

 

[Trasher52]

Anregungen ja, jedoch variiert der Weg nicht. Evtl. ein Form-fehler?

 

[Kabelsalat]

Warum variert der Weg nicht? Die Function Move bestimmt - basierend auf einer Zufallszahl - den weiteren Verlauf des Weges...

 

[Trasher52]

Na wenn ich das wüsste.. kannst du mir den genauen Code nennen, den ich einzusetzen habe, damit das Lab. jedes mal bei klick auf "neu" anders aussieht? Und an welche Stelle muss dieser Code genau? Und beziehe dich bitte auf mein o.g. Programm.

Bitte habt Geduld mit mir, ich lerne mich erst seit knappen 3 Wochen in Delphi rein und so leicht finde ich das nicht Das soll keine Ausrede sein, aber ein Hinweis!

Meinst du mit weiterem Verlauf die Richtung, die das programm als nächstes ausprobiert?

Edit: Ausserdem: Bodensee? Sagt dir Überlingen was?

 

[Kabelsalat]

Nun habe ich auch dem Debugger leben einhauchen können und endlich habe ich eine Chance die EAccessViolation zu lokalisieren. Vielleicht kann ich dir bald eine fertige Lösung präsentieren - momentan kann es aber auch ein wenig länger gehen, da ich nicht sonderlich viel Zeit habe. Vielleicht schafft es aber auch jemand anders schneller zum Ziel zu kommen.

Edit: Ausserdem: Bodensee? Sagt dir Überlingen was?

Ja klar Wohne nicht weit von Überlingen entfernt

Also, entweder blicke ich das mit dem Code nicht, oder es geht nicht.. Kann mir das jmd. nochmals erklären, wie ich das für euch so einrücken kann?

Nicht böse sein, das habe ich mal schnell für dich gemacht

 

[Trasher52]

Ich bin kein Stück böse! freut mich sogar, denn ich hab's echt nicht hinbekommen. Dass du mir so hilfst, find ich supernett von dir und ich danke dir schonmal sehr dafür! ich hab da wirklich meine Mittage mit verbracht und hab's nie hinbekommen..

Danke nochmals!

Edit: Überlingen ist echt schön. Da wohnt jmd. ganz besonderes für mich ;P

 

[Kabelsalat]

Gerade eben habe ich mir das ganze nochmal angeschaut und jetzt scheint es zu funktionieren. War ein trivialer, aber ohne Debugger bloß sehr schwer zu findender Fehler. Den Code + Beispielanwendung zur Implementierung gibt es dann morgen, denn jetzt bin ich zu Müde um das ganze noch zu beschreiben. Dennoch kann ich dir ein paar generierte Labyrinthe zeigen:

 

[Kabelsalat]

Hier nun die zugehörige Klasse:

unit Unit2;

interface

uses
  Math, Types;

type
  TPointArray = array of TPoint;
type
  TCharArray = array of array of char;
type
  TLabyrinth = class
  private
    arrLabPath: TPointArray;
    intX, intY: integer;
    function Move(pLast: TPoint; intDirection: integer): TPoint;
  public
    constructor Create(x,y: integer; fFLength, fFCount: real);
    function ToCharArray(): TCharArray;
    property LabPath: TPointArray read arrLabPath;
end;

implementation

 constructor TLabyrinth.Create(x,y: integer; fFLength, fFCount: real);
  var
    i,j, t1,t2,t3, intDirection, intCount, intMaxCount: integer;
  begin
    inherited Create();

    randomize();
    intX := x;
    intY := y;

    //Zufällige Pfadlänge
    SetLength(arrLabPath, RandomRange(3, round(x*y * fFLength)));

    //Zufälliger Ausgangspunkt
    arrLabPath[0].X := RandomRange(0, x);
    arrLabPath[0].Y := RandomRange(0, y);

    //Zufälligen Pfad generieren
    i := 1;
    while i < Length(arrLabPath) do
    begin
      intDirection := -1;

      while intDirection < 0 do
      begin
        intDirection := RandomRange(0,4);

        case intDirection of
          0: intMaxCount := x - 1 - arrLabPath[i - 1].X; //nach rechts
          1: intMaxCount := arrLabPath[i - 1].Y; //nach oben
          2: intMaxCount := arrLabPath[i - 1].X; //nach links
          3: intMaxCount := y - 1 - arrLabPath[i - 1].Y; //nach unten
        end;

        if not (intMaxCount > 0) then intDirection := -1;
      end;

      for j := 0 to RandomRange(0, round(intMaxCount * fFCount) - 1) do
      begin
        if (i < Length(arrLabPath)) then arrLabPath[i] := Move(arrLabPath[i - 1], intDirection)
        else if (arrLabPath[i - 1].X = arrLabPath[0].X) and (arrLabPath[i - 1].Y = arrLabPath[0].Y) then i := i - 1
        else break;

        i := i + 1;
      end;
    end;
  end;

  function TLabyrinth.Move(pLast: TPoint; intDirection: integer): TPoint;
  var
    pTmp: TPoint;
  begin
    //Zufallsgenerator sollte bereits initialisiert sein
    case intDirection of
      0: //1 nach rechts
      begin
        pTmp.X := pLast.X + 1;
        pTmp.Y := pLast.Y;
      end;

      1: //1 nach oben
      begin
        pTmp.X := pLast.X;
        pTmp.Y := pLast.Y - 1;
      end;

      2: //1 nach links
      begin
        pTmp.X := pLast.X - 1;
        pTmp.Y := pLast.Y;
      end;

      3: //1 nach unten
      begin
        pTmp.X := pLast.X;
        pTmp.Y := pLast.Y  + 1;
      end;
    end;

    Move := pTmp;
  end;

  function TLabyrinth.ToCharArray(): TCharArray;
  var
    arrTmp: TCharArray;
    i, j,t1,t2: integer;
  begin
    SetLength(arrTmp, intX, intY);

    //Zunächst alles -> Mauer
    for i:= 0 to Length(arrTmp) - 1 do
    begin
      for j:= 0 to Length(arrTmp[i]) - 1 do
      begin
        arrTmp[i,j] := 'M';
      end;
    end;

    //Weg "freiräumen"
    for i:= 0 to Length(arrLabPath) - 1 do
    begin
      t1 := 0;
      t2 := 0;
      t1 := arrLabPath[i].X;
      t2 := arrLabPath[i].Y;
      arrTmp[arrLabPath[i].X, arrLabPath[i].Y] := ' ';
    end;

    //Start + Endpunkt markieren
    arrTmp[arrLabPath[0].X, arrLabPath[0].Y] := 'S';
    arrTmp[arrLabPath[Length(arrLabPath) - 1].X, arrLabPath[Length(arrLabPath) - 1].Y] := 'Z';

    ToCharArray := arrTmp;
  end;

end.

Damit du weißt, wie die Klasse einzubinden ist, hier noch eine kleine Beispielanwendung:

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, Unit2, StdCtrls, Spin;

type
  TForm3 = class(TForm)
    StringGrid1: TStringGrid;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    SpinEdit2: TSpinEdit;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.Button1Click(Sender: TObject);
var
  Lab: TLabyrinth;
  arrTmp: TCharArray;
  i,j: integer;
begin
  StringGrid1.RowCount := SpinEdit2.Value + 1;
  StringGrid1.ColCount := SpinEdit1.Value + 1;
  Lab := TLabyrinth.Create(SpinEdit1.Value,SpinEdit2.Value, StrToFloat(Edit1.Text), StrToFloat(Edit2.Text));
  arrTmp := Lab.ToCharArray();

  for i := 0 to SpinEdit1.Value - 1 do
  begin
    for j := 0 to SpinEdit2.Value - 1 do
    begin
      StringGrid1.Cells[i + 1 , j + 1 ] := arrTmp[i,j];
    end;
  end;

  for i := 0 to SpinEdit1.Value do StringGrid1.Cells[i,0] := IntToStr(i);
  for i := 0 to SpinEdit2.Value do StringGrid1.Cells[0,i] := IntToStr(i);
end;

end.

So sieht das ganze dann aus:

Bei den voreingestellten Werten, wirken größere Labyrinthe etwas besser, aber durch Anpassen von fFLength und fFCount kannst du den "Generator" nach deinen Wünschen steuern. Beachte bitte, dass keine Überprüfung der Werte stattfindet, das solltest du also noch implementieren bzw. dich strikt an die Hinweise halten - falls du die Bereichsüberprüfung nicht aktiviert haben solltest, hagelt es ansonsten Fehler an Stellen, die eigentlich 100% i.O. sind.

 

[Trasher52]

Oh mein Gott.. ich danke dir für deine unglaubliche Mühe und bin massivst beeindruckt.. Wenn ich das Programm nun noch zum laufen kriege, wär alles perfekt! Aber schonmal vielen Dank für deine Bemühungen und deine Zeit. Ich hätte nicht gedacht, dass mir jmd. so schnell und so ausführlich helfen kann. ich bin absolut begeistert und weiss garnicht, was ich sagen soll - Ausser eben einfach danke!

Update: Kabelsalat lässt mir sein Programm zukommen, da es unter Delphi 7 bei mir noch zu Problemen kommt. Ich werde euch berichten, wenn ich morgen in der Firma war, wie es nun aussieht und weitergeht!

Vielen Dank schonmal an die helfenden Hände aus diesem klasse Forum! Besonderer Dank an Kabelsalat und seine Bemühungen!

Updates folgen!

Edit1: So, ich hab es nochmal mit Delphi 7 probiert und erhalte beim Laden des projekts die Meldung:

Klasse TSpinEdit nicht gefunden. Fehler ignorieren und fortfahren?

Ich wende mich direkt an Kabelsalat: Weisst du da was drüber? Evtl. Rar-Datei beschädigt gewesen? Ich werds morgen mit einer neueren Delphi-Version probieren, aber hoffe, jmd. hat eine Idee bezüglich der Fehlermeldung.

Edit2: Nun geht's soweit, wenn man die erste fehlermeldung ignoriert, jedoch bekomme ich beim compilieren die Fehlermekdung: Feld Form3.SpinEdit2 besitzt keine entsprechende Komponente. Soll die Deklaration entfernt werden?

Wenn ich nun auf "nein"klicke, gibt's einen Fatalen Fehler: Datei nicht gefunden: 'spin.dcu'

Was kann ich noch tun?

Also der Fehler liegt in Unit3. Mit SpinEdit kann Delphi 7 scheinbar garnichts anfangen und weigert sich, die Unit3 zu compilieren. Hat jmd. eine Idee?

 

[Trasher52]

leider Gottes hat es in der Firma auch nicht funktioniert. Ich bin frustriert! kabelsalat, kann ich dir u.U. mein Programm zusenden und du wirfst da mal einen Blick drauf?

Hat noch jmd. Ideen/Lösungen für mich? Ich bin für jede Hilfe dankbar!

 

[Kabelsalat]

Unit 3 brauchst du nicht - Das sollte bloß eine Beispielimplementation darstellen. Du kannst auch dieses olle SpinEdit einfach durch ein Textfeld ersetzen - das obligatorische StrToInt() darfst du in diesem Fall allerdings nicht vergessen.

Im Gegensatz zu der Form sollte Unit2 (du kannst sie auch umbenennen) auch unter Delphi 7 ohne Probleme funktionieren.

/edit: Schick mir mal dein Progrämmchen. Evtl. lässt sich ja was machen... Mail-Addi hast du bereits.

/edit2: Die Boxen mit denen man die Breite und die Höhe festlegt, sind SpinEdits

 

[Trasher52]

ich schick dir mal eben das programm, muss dann aber schnell zu nem freund rüber, der evtl. auch n paar ideen hat! bis gleich.

 

[Kabelsalat]

Voilà:

Deinen "Sucher" musst du allerdings noch verbessern. Bei einigen Labyrinthen verrennt er sich (ab diesem Zeitpunkt geht's dann bloß noch im Kreis ). Davon lässt sich allerdings schlecht ein Screenshot machen... schau's dir einfach selber an

So sieht das (angepasste) Programm dann aus:

unit m_lab;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, interakt, ExtCtrls, RandLab;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    bt_create: TButton;
    bt_search: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Timer1: TTimer;
    BtStop: TButton;
    Btgoon: TButton;
    GroupBox1: TGroupBox;
    Label7: TLabel;
    Edit1: TEdit;
    Label8: TLabel;
    Edit2: TEdit;
    procedure bt_createClick(Sender: TObject);
    procedure bt_searchClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BtStopClick(Sender: TObject);
    procedure BtgoonClick(Sender: TObject);
  private
   pStart: TPoint;
   feld: TCharArray;
   zielerreicht: boolean;
   procedure labyrinth(sp,zl: integer);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.bt_createClick(Sender: TObject);
var
  i, j: integer;
  fFLength, fFCount: real;
  Lab: TLabyrinth;
begin
  zielerreicht:= false;

  fFLength := StrToFloat(Edit1.Text);
  fFCount := StrToFloat(Edit2.Text);

  //Korrekte Eingabe?
  if (fFLength <= 0) then
  begin
    ShowMessage('Für fFLength gilt folgende Bedingung: 0 < fFLenght');
    exit;
  end;
  if (fFCount <= 0) or (fFCount > 1) then
  begin
    ShowMessage('Für fFCount gilt folgende Bedingung: 0 < fFCount <= 1');
    exit;
  end;

  Lab := TLabyrinth.Create(StringGrid1.ColCount, StringGrid1.RowCount, fFLength, fFCount);
  feld := Lab.ToCharArray();

  pStart := Lab.LabPath[0];

  for i := 0 to StringGrid1.ColCount - 1 do
  begin
    for j := 0 to StringGrid1.RowCount - 1 do
    begin
      StringGrid1.Cells[i, j] := feld[i,j];
    end;
  end;
end;

procedure TForm1.labyrinth(sp,zl: integer);
var
zlz, spz : integer;
begin
if not zielerreicht then
begin
if (feld[sp,zl]<>'M') and (feld[sp,zl]<>'.') then
begin
if feld[sp,zl]='Z' then
begin
zielerreicht:=true;
feld[sp,zl]:= 'E';
StringGrid1.Cells[sp,zl]:= feld[sp,zl];
StringGrid1.Cells[1,1]:= feld[1,1];
label1.visible := true;
warte;
end
else
feld[sp,zl]:='.';
StringGrid1.Cells[sp,zl]:= feld[sp,zl];
warte;

spz:=1;
zlz:=17;

if (sp < 19) and (sp > 0) and (zl< 18) and (zl > 0)   then
begin
if (sp>spz)then
begin
     if (zl>zlz) then
     begin
     if abs(sp-spz)>abs(zl-zlz)
     then
     begin
     labyrinth(sp-1,zl);
     labyrinth(sp,zl-1);
     end
     else
     begin
     labyrinth(sp,zl-1);
     labyrinth(sp-1,zl);
     end;
     labyrinth(sp+1,zl);
     labyrinth(sp,zl+1);
     if not zielerreicht then
     begin
     feld[sp,zl]:='X';
     StringGrid1.Cells[sp,zl]:= feld[sp,zl];

     end;
     end
     else
     begin
     labyrinth(sp-1,zl);
     labyrinth(sp,zl+1);
     labyrinth(sp+1,zl);
     labyrinth(sp,zl-1);
     if not zielerreicht then
     begin
     feld[sp,zl]:='X';
     StringGrid1.Cells[sp,zl]:= feld[sp,zl];

     end;
     end
end
else
if (zl>zlz)then
   begin
   labyrinth(sp+1,zl);
   labyrinth(sp,zl-1);
   labyrinth(sp-1,zl);
   labyrinth(sp,zl+1);
   if not zielerreicht then
   begin
   feld[sp,zl]:='X';
   StringGrid1.Cells[sp,zl]:= feld[sp,zl];

   end;
   end
   else
   begin
   labyrinth(sp+1,zl);
   labyrinth(sp,zl+1);
   labyrinth(sp-1,zl);
   labyrinth(sp,zl-1);
   if not zielerreicht then
   begin
   feld[sp,zl]:='X';
   StringGrid1.Cells[sp,zl]:= feld[sp,zl];

   end;
end;

end;
end;
end;
end;


procedure TForm1.bt_searchClick(Sender: TObject);
begin
  labyrinth(pStart.X, pStart.y);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   mach_weiter;
end;

procedure TForm1.BtStopClick(Sender: TObject);
begin
 timer1.Enabled := false;
 BtStop.Visible := false;
 Btgoon.Visible := true;
end;

procedure TForm1.BtgoonClick(Sender: TObject);
begin
timer1.Enabled := true;
Btgoon.visible := false;
Btstop.Visible := true;
end;

end.

... bei meiner Unit hat sich eigentlich nichts außer dem Namen geändert: Unit2 -> RandLab...

 

[Trasher52]

Geil, es klappt sogar Bei mir hat er sich bis jetzt noch nicht verrant! Ziemlich cool von dir - Aber sei ehrlich, wie fandest mein Programm für einen Anfänger?

Ich danke dir vielmals für die grandiose Hilfe bis jetzt!

Edit: Bei 10 Labs hat er sich bei einem Lab. verrannt. Und ich glaube, den Fehler habe ich schon gefunden. Beim Compilieren gibt's allerdings z.Z. noch einige Fehlermeldungen. Lustig finde ich z.B., dass wenn ich einen Zahlenwert verändere, er plötzlich die Unit nichtmehr findet. Ich hasse Delphi(7).

Freund von mir hat Delphi 8 von seinem Vater bekommen, sagt er zumindest, und der will das Programm von kabelsalat nun austesten. (Dabei hat er doch noch weniger Ahnung als ich..)

Bei Updates meld ich mich hier!

 

[Kabelsalat]

Aber sei ehrlich, wie fandest mein Programm für einen Anfänger?

Du könntest demnächst die Codezeilen vernünftig einrücken^^ Das + einige zusätzliche Kommentare und man kommt wesentlich einfacher zurecht.

 

[Trasher52]

Okay, das werde ich in Zukunft berücksichtigen - als Anfänger achtet man da sehr wenig drauf, ich bin nur froh, dass das Programm überhaupt lief. BTW: You've got PM!

Herr kabelsalat hat etwas gut bei mir.. Definitiv! Ein großes Lob und vielen Dank an dich!

Kleines Update:

Ich bin nun dabei den Sucher des durch kabelsalat verbesserten Programms zu optimieren, da noch geringfügige Fehler bei der Wegsuche auftreten. Der Stand ist zur Zeit dieser: Der Sucher arbeitet manchmal etwas seltsam. Das Problem ist, dass manchmal der Weg sofort bei einem "schweren"Lab. gefunden wird, dann aber wieder beim Gleichen nicht. Ich denke, dass das etwas mit meiner "interakt"-Unit zutun hat. Mal sehen, was ich finden kann. Ich werde dann wieder hier posten!

 

[Trasher52]

Delphi muss bis Montag ruhen. Z.Z. anderes Problem. S. dazu meinen anderen Thread im Festplatten-Unterforum.

 

[Trasher52]

So, nach langer Zeit grabe ich meine Threadleiche aus und entshculdige mich für die enorme Verspätung. Ich habe nun vor, das Projekt fortzusetzen und würde gerne grafische Elemente einbinden

Folgendes soll realisiert werden:

-manuelle Steuerung der Zielsuche durch Pfeiltasten(geklaut vom Siemens-Lab. vom Handy) + Ob's 3d geht, weiss ich nicht, zu wenig Erfahrung noch.
-Zeitliste pro Lab.
-grafische Aufwertung der Formen.
-gleichzeitiges Absuchen zweier Labs parallel zueinander.

So, that's it ersteinmal.