Az alábbi letöltési lehetőségek közül választhatsz: (
segítség)
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: utf-8
Méret: 2 KB
Imports System
Module Labirintus
Private Enum Mezo
Ures
Fal
Bejart
End Enum
Const N As Integer = 7
Const M As Integer = 10
Const Sorok As Integer = 2 * N + 1
Const Oszlopok As Integer = 2 * M + 1
Private tomb(Sorok + 1, Oszlopok + 1) As Mezo
Private temp(Sorok + 1, Oszlopok + 1) As Mezo
Private falSzam As Integer = N * M
Private uresMezok As Integer = 0
Private jartMezok As Integer
Private Sub Ertekadas()
For i As Integer = 0 To Sorok + 1
For j As Integer = 0 To Oszlopok + 1
If i = 0 Or j = 0 Or i = Sorok + 1 Or j = Oszlopok + 1 Or (i Mod 2 = 0 And j Mod 2 = 0) Then
tomb(i, j) = Mezo.Fal
Else
tomb(i, j) = Mezo.Ures
uresMezok += 1
End If
Next
Next
tomb(Sorok - 1, Oszlopok) = Mezo.Fal
falSzam -= 1
uresMezok -= 1
End Sub
Private Sub Bejar(ByVal i As Integer, ByVal j As Integer)
If temp(i, j) = Mezo.Ures Then
temp(i, j) = Mezo.Bejart
jartMezok += 1
Bejar(i - 1, j)
Bejar(i + 1, j)
Bejar(i, j - 1)
Bejar(i, j + 1)
End If
End Sub
Private Function LehetRakni(ByVal i As Integer, ByVal j As Integer) As Boolean
If tomb(i, j) = Mezo.Ures And (i <> 1 Or j <> 1) And (i <> Sorok Or j <> Oszlopok) And (i Mod 2 = 0 Or j Mod 2 = 0) Then
temp = CType(tomb.Clone(), Mezo(,))
temp(i, j) = Mezo.Fal
jartMezok = 0
Bejar(1, 1)
Return jartMezok = uresMezok - 1
Else
Return False
End If
End Function
Private Function FalatRak() As Boolean
Dim i, j As Integer
Dim rand As New Random()
Do
i = rand.Next(Sorok) + 1
j = rand.Next(Oszlopok) + 1
If LehetRakni(i, j) Then
tomb(i, j) = Mezo.Fal
falSzam -= 1
uresMezok -= 1
End If
Loop Until falSzam = 0
End Function
Private Sub Kirajzol()
For i As Integer = 0 To Sorok + 1
For j As Integer = 0 To Oszlopok + 1
If tomb(i, j) = Mezo.Fal Then
Console.Write("#")
Else
Console.Write(" ")
End If
Next
Console.WriteLine()
Next
Console.ReadLine()
End Sub
Public Sub Main()
Ertekadas()
FalatRak()
Kirajzol()
End Sub
End Module
