Thema Datum  Von Nutzer Rating
Antwort
Rot selbstaufbauendes labyrinth
 06.12.2012 20:41:49 santos
Solved
07.12.2012 10:43:06 Lutz
*****
Solved
07.12.2012 14:09:24 santos
Solved

Ansicht des Beitrags:
Von:
santos		 Datum:
06.12.2012 20:41:49		 Views:
1860		 Rating:
     
Antwort:
 Nein
Thema:
selbstaufbauendes labyrinth

Hallo bin frisch in der VBA programmierung und muss für die Fachhochschule paar Sachen ausarbeiten, darunter ein Labyrinth, welches sich von selbst aufbaut.

Startpunkt sollte irgendwo links oben am Spielfeldrand liegen und das Labyrinth sich zum unteren rechten Rand hin aufbauen (Endpunkt muss nicht in der Spielfeldecke liegen). Ich glaube ich programmiere das ganze viel zu kompliziert...und noch dazu baut sich das Spielfeld über den eigentlichen Rahmen hinaus weiterhin auf...

Die Grundidee ist, dass per Zufall entschieden wird, ob der Weg horizontal oder vertikal gebaut wird. Im nächsten Schritt wird entschieden wie viele "Bausteien" gesetzt werden sollen. Da das Spielfeld am rechten Rand enden soll habe ich im Fall "horizontaler Weg" noch die Bedingung hinzugefügt, dass wenn die x koordinate 10 erreicht ist (diese stellt den Spielfeldrand dar), die Schleife verlassen werden soll und zum Sub "Ende" übergegangen werden soll. Leider wird oft der Spielaufbau  nach der Meldung "Ende" weiterhin fortgesetzt...Ich bitte dringend um Hilfe!!!

hier die programmierung:

?
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
Dim i As Integer
Dim j As Integer
Dim X As Integer, Y As Integer, r As Integer
Dim k As Integer, rechtslinks As Integer, hochrunter As Integer
Dim richtung As Integer, t As Integer, abbruch As Integer
 
 
 
Private Sub cmdstart_Click()
 
For i = 1 To 10                 'roter Spielfeldrahmen
    Worksheets("Tabelle2").Cells(i, 1).Interior.ColorIndex = 3
    Worksheets("Tabelle2").Cells(1, i).Interior.ColorIndex = 3
    Worksheets("Tabelle2").Cells(10, i).Interior.ColorIndex = 3
    Worksheets("Tabelle2").Cells(i, 10).Interior.ColorIndex = 3
Next i
k = 2           'Startwerk x-Achse
X = 2           'Startwert y-Achse
abbruch = 0     'abbruch rücksetzen bei mehrmaliger ausführung des programmes
Call Weg
End Sub
 
 
 
 
Sub Weg()              'vertikal oder horizontal
Randomize
    richtung = Int(Rnd * 2 + 1)  '50/50 Chance
    If richtung = 1 Then
        Call horizontal
    Else
        Call vertikal
    End If
End Sub
 
 
 
 
Sub vertikal()
Randomize
    t = Int(Rnd * 2 + 1)            'Schrittweite max 2 Felder
    For hochrunter = X To X + t     'x=aktuelle y-Koordinate;t=zufällige Schrittweite
        If Not Worksheets("Tabelle2").Cells(hochrunter, k).Interior.ColorIndex = 3 Then 'Wenn Spielrand nicht erreicht ist(rot ist)
        Worksheets("Tabelle2").Cells(hochrunter, k).Interior.ColorIndex = 4             'färbe aktuelles Feld grün
        Else
        Call horizontal
        End If
    Next hochrunter
    X = X + t                       'neue y-koordinate speichern
    Call Weg
End Sub
 
 
 
 
Sub horizontal()
Randomize
    r = Int(Rnd * 2 + 1)             'Schrittweite max 2 Felder
    For rechtslinks = k To k + r     'k=aktuelle x-Koordinate; r=zufällige Schrittweite
        If rechtslinks = 10 Then     'wenn rechter Spielrand (x=10) erreicht ist,setze abbruch=1
        abbruch = 1
        Exit For                     'Schleife verlassen
        Else
        Worksheets("Tabelle2").Cells(X, rechtslinks).Interior.ColorIndex = 4
        End If
    Next rechtslinks
    k = k + r                          'neue x-Koordinate speichern
    If abbruch = 1 Then
         Call Ende
         Else
         Call Weg
    End If
 
' keine lösung...
' r = Int(Rnd * 2 + 1)
'    For rechtslinks = k To k + r
'    Debug.Print rechtslinks & "reli"
'        If Not Worksheets("Tabelle2").Cells(x, rechtslinks).Interior.ColorIndex = 3 Then
'        Worksheets("Tabelle2").Cells(x, rechtslinks).Interior.ColorIndex = 4
'        Else
'        abbruch = 1
'            Exit For
'        End If
'    Next rechtslinks
'        k = k + r
'    If abbruch = 1 Then
'    Call Ende
'    Else
'
'        Call Weg
'    End If
 
End Sub
 
 
 
Sub Ende()
MsgBox "Ende"           'Wird dieses Sub aufgerufen sollte ende sein...
End Sub

Schon mal danke im voraus!!!

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot selbstaufbauendes labyrinth
 06.12.2012 20:41:49 santos
Solved
07.12.2012 10:43:06 Lutz
*****
Solved
07.12.2012 14:09:24 santos
Solved