![]() |
Re: Labyrinth darstellen
Ein gutes Zufallslabyrinth zu erstellen st sehr schwer, das wirst du nicht so einfach hinbekommen ;)
Siehe mein Thread: ![]() |
Re: Labyrinth darstellen
Du machst einem ja viel Mut :evil: :zwinker:
Aber wie schon gesagt, mein Info-Lehrer meint es hätte noch keiner seiner Schüler geschafft. Grund genug sich da hinter zu klemmen. Außerdem wäre es ja nicht interessant wenn es nicht kompliziert/schwierig wäre. |
Re: Labyrinth darstellen
Hi GetCool
ich habe mal aus langeweile ein zufallslabyrinth programmiert, vieleicht hilfst dir weiter, die lösung kann dabei auch angezeigt werden. Du brauchst nur ein Image1, ein Button1 und eine Checkbox1 auf dem formular
Delphi-Quellcode:
Unit Unit1;
Interface Uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; Type TCellType = Set Of (cStart, cFinal, cSolution, cFree); TForm1 = Class(TForm) Button1: TButton; Image1: TImage; CheckBox1: TCheckBox; Procedure Button1Click(Sender: TObject); procedure CheckBox1Click(Sender: TObject); Private Cells: Array[0..49, 0..49] Of Record S, O: Boolean; CellType: TCellType End; Procedure GenerateMaze(StartX, StartY: Integer); Procedure DrawMaze(ShowSolution: Boolean); End; Var Form1: TForm1; Implementation {$R *.DFM} Procedure TForm1.Button1Click(Sender: TObject); Begin Randomize; //RandSeed:=0; Caption:=IntToStr(RandSeed); // Labyrinth erstellen mit der Startposition x=25 y=25 GenerateMaze(25,25); // Labyrinth anzeigen DrawMaze(CheckBox1.Checked); End; procedure TForm1.DrawMaze(ShowSolution: Boolean); Var x, y: Integer; begin Image1.Picture.Bitmap:=Nil; Image1.Width:=501; Image1.Height:=501; With Image1.Canvas Do Begin Brush.Color:=clBlack; FrameRect(ClipRect); Pen.Width:=1; Pen.Color:=clBlack; For x:=0 to 49 Do For y:=0 to 49 Do Begin If Cells[x,y].O Then Begin MoveTo((x+1)*10, y*10); LineTo((x+1)*10, (y+1)*10+1) End; If Cells[x,y].S Then Begin MoveTo(x*10, (y+1)*10); LineTo((x+1)*10+1, (y+1)* 10) End; If cStart In Cells[x,y].CellType Then Ellipse(x*10+2, y*10+2, x*10+8, y*10+8); If cFinal In Cells[x,y].CellType Then Ellipse(x*10+2, y*10+2, x*10+8, y*10+8); If ShowSolution And (cSolution In Cells[x,y].CellType) Then Ellipse(x*10+4, y*10+4, x*10+6, y*10+6); End; End; end; Procedure TForm1.GenerateMaze(StartX, StartY: Integer); CONST N=0; S=1; W=2; O=3; Function ValidCell(x, y: Integer): Boolean; Begin Result:=(x>=0) And (y>=0) And (x<=49) And (y<=49); End; Function ValidWay(x, y: Integer): Boolean; Begin If ValidCell(x,y) Then Result:=cFree In Cells[x,y].CellType Else Result:=False; End; Function NewWay(x, y, r: Integer): Boolean; Var WegNr: Array[0..3] Of Boolean; Solution: Boolean; Nr: Byte; Begin // die aktuelle Zelle als belegt markieren Cells[x,y].CellType:=Cells[x,y].CellType-[cFree]; // die Wand entfernen, aus der Richtung der wir gekommen sind Case r Of S: If ValidCell(x,y-1) Then Cells[x,y-1].S:=False; N: Cells[x,y].S:=False; O: If ValidCell(x-1,y) Then Cells[x-1,y].O:=False; W: Cells[x,y].O:=False; End; // Zufällige Reihenfolge der Richtungen berechnen For Nr:=0 To 3 Do WegNr[Nr]:=False; Solution:=False; Repeat Nr:=Random(4); Case Nr Of N: If ValidWay(x,y-1) Then Solution:=NewWay(x,y-1,N); S: If ValidWay(x,y+1) Then Solution:=NewWay(x,y+1,S); W: If ValidWay(x-1,y) Then Solution:=NewWay(x-1,y,W); O: If ValidWay(x+1,y) Then Solution:=NewWay(x+1,y,O); End; WegNr[Nr]:=True; If Solution Then With Cells[x,y] Do CellType:=CellType+[cSolution]; Until WegNr[0] And WegNr[1] And WegNr[2] And WegNr[3]; Result:=(cSolution In Cells[x,y].CellType) Or (cStart In Cells[x,y].CellType); End; Var x, y: Integer; Begin For y:=0 To 49 Do For x:=0 To 49 Do Begin Cells[x,y].S:=True; Cells[x,y].O:=True; Cells[x,y].CellType:=[cFree]; End; With Cells[StartX,StartY] Do CellType:=CellType+[cStart]; // ein zufälliges Ziel x:=Random(50); y:=Random(50); // das Ziel an den Rand verschieben Case Random(4) of N: y:=0; S: y:=49; W: x:=0; O: x:=49; End; With Cells[x,y] Do CellType:=CellType+[cFinal]; // Anfangszelle setzten NewWay(x,y,-1); End; procedure TForm1.CheckBox1Click(Sender: TObject); begin DrawMaze(CheckBox1.Checked); end; End. |
Re: Labyrinth darstellen
Frag mal Phanntom1, der hat dieses geile Laser-Labyrinth geschrieben, villeicht kann er dir nen paar Tips geben..
![]() |
Re: Labyrinth darstellen
Ich erinnere mich an eine applicaktion für den Atari ST. Diese hat ein labyrint gemalt indem es recursiv immer wieder nach einer Zuflasszahl mit eine einem abzweig angefangen. Wenn es an eine grenze gestossen ist an der es nicht vorbei kamm recursion beenden und beim Aufrufer weiter machen.
Ich kann micht nicht mehr genau an den code erinnern - dies also nur als denk anstoss. Julian Ziersch |
Re: Labyrinth darstellen
@jziersch: ich kenne zwar das programm nicht was du beschrieben hast, aber bei dem code den ich oben gepostet habe, habe ich auch rekursive aufrufe verwendet :wink: das ist warscheinlich das einfachste
|
Re: Labyrinth darstellen
Hey Phantom!
Werds mir mal angucken. Vielen Dank schonmal! |
Re: Labyrinth darstellen
HI ,
Routfinding und ki mann überflüssig machen, Wenn man festlegt das ein sogenanntes "Griechische Labyrinth" generiert werden soll. D.h. es gibt keine Inseln von Wänden, alle Wände sind mit der das Labyrinth umlaufenden Wand verbunden. Dann muss die Maus: 1.Einfach laufen bis sie auf eine Wand trifft 2.der Wand solange Folgen bis sie den Ausgang erreicht hat. :cheers: p.s. Für solche Aufgaben eignen sich Programme wie Niki(der Roboter). :chat: |
Re: Labyrinth darstellen
Hmm...nö, das wäre zu einfach. Fänd das käme fast schummeln gleich, da die Maus ja wirklich gar nichts machen muss. Man legt das ja von anfang an schon fest wie sie nach draußen kommt. Da mach ich lieber eine kleine KI... :-D
|
Re: Labyrinth darstellen
@GetCool: jetzt muss ich nochmal fragen, soll die maus direkt zum ausgang laufen? oder erst das ganze Labyrinth systematisch ablaufen bis sie dann den ausgang erreicht?
Falls sie direkt zum ausgang laufen soll, bräuchtest du nix mehr machen, da ich bei meinem code den Lösungsweg schon berechnet und ins Array geschrieben habe :) |
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:41 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz