Spiel tetris

Susi · 23. November 2011, 11:15

Bin gerade dabei ein Spiel " Tetris" zu Programmieren.

Den grundstein habe Ich aus einen Buch und jetzt möchte ich es für meine Bedürfnise änder.

Kann leider nur drei gleiche Panel(Steine) entfernen, möchte aber fünf gleiche entfernen können, als besondere Zusatz von Punkten.

Diese ist der Code, der die Steine entfernen soll, wenn es fünf gleiche sind:

(Meine Idee)

VB.NET-Quellcode

If F(Z, S) <> Leer And
F(Z, S + 1) <> Leer And
F(Z, S - 1) <> Leer And
F(Z, S - 2) <> Leer Then
If PL(F(Z, S)).BackColor = PL(F(Z, S + 1)).BackColor And
PL(F(Z, S)).Backcolor = PL(F(Z, S + 2)).BackColor And
PL(F(Z, S)).BackColor = PL(F(Z, S - 1)).BackColor And
PL(F(Z, S)).BackColor = PL(F(Z, S - 2)).BackColor Then
For SX = S To S + 2
Controls.Remove(PL(F(Z, SX)))
F(Z, SX) = Leer
ZX = Z - 1Do While F(ZX, SX) <> Leer
PL(F(ZX, SX)).Top = PL(F(ZX, SX)).Top + 20
F(ZX + 1, SX) = F(ZX, SX)
F(ZX, SX) = Leer
ZX = ZX - 1
Loop
Next
'##########
For SX = S To S - 2
Controls.Remove(PL(F(Z, SX)))
F(Z, SX) = Leer
ZX = Z + 1Do While F(ZX, SX) <> Leer
PL(F(ZX, SX)).Top = PL(F(ZX, SX)).Top - 20
F(ZX - 1, SX) = F(ZX, SX)
F(ZX, SX) = Leer
ZX = ZX + 1
Loop
Next
NebenPrfen = True
End If
End If

kann mir jemand sagen wo da mein fehler ist, als Meldung bekomme ich immer "Auserhalb des defnierten Bereich"

der orginal Code für drei Steine geht so:

VB.NET-Quellcode

If F(Z, S) <> Leer And
F(Z, S + 1) <> Leer Then
If PL(F(Z, S)).BackColor = PL(F(Z, S + 1)).BackColor And
PL(F(Z, S)).Backcolor = PL(F(Z, S + 2)).BackColor Then
For SX = S To S + 2
Controls.Remove(PL(F(Z, SX)))
F(Z, SX) = Leer
ZX = Z - 1Do While F(ZX, SX) <> Leer
PL(F(ZX, SX)).Top = PL(F(ZX, SX)).Top + 20
F(ZX + 1, SX) = F(ZX, SX)
F(ZX, SX) = Leer
ZX = ZX - 1
Loop
Next
'NebenPruefen = True
End If
End If

code dazu

VB.NET-Quellcode

' index des aktuellen Panel
Dim PX As Integer
' Spielfeld
Dim F(14, 9) As Integer
' Zeile
Dim PZ As Integer
' Spalte
Dim PS As Integer
'Level/Punkte/Steine
Dim Level As Integer
Dim punkte As Integer
Dim Steine As Integer
' Farbenliste
Dim FarbenFeld() As Color = {Color.Red, Color.Blue, Color.Yellow,
Color.Pink, Color.Green, Color.Magenta, Color.Brown, Color.Black}
' Konstanten fuer Feldpunkte
Const Rand = -2
Const Leer = -1
' leere liste von Spiel-Panels
Dim PL As New ArrayList

picoflop · 23. November 2011, 12:43

Ich würde erstmal anfangen, den Code sinnvoll aufzuhübschen, indem du klarer strukturierst zb durch eigene Funktionen. Ich verstehe auch nicht, warum du eine Liste brauchst und gleichzeitig direkt die Farben der Controls abfragst. Warum wird diese Info nicht gleich in der Liste gespeichert? Und warum eine ArrayList und kein simples Array? Das Spielfeld selbst ist doch komplett statisch ...

Im übrigen ist es hilfreich, wenn man nicht nur den Fehler kennt, sondern auch in welcher Zeile er auftritt und welche Werte die betroffenen Variablen zu diesem Zeitpunkt haben.

Susi · 25. November 2011, 07:38

Die farben werden bei der erstellung eines neues Panel per zufall ausgewählt

VB.NET-Quellcode

Private Sub NaechstesPanel()
Dim Farbe As IntegerDim p As New Panel
' Panel zur liste hinzufgen
PL.Add(p)
' Position und gr”áep.Location = New Point(220, 80)
p.Size = New Point(20, 20)
' Farbe per zufallesgenerator gewaehlt
Farbe = Math.Floor(Rnd() * 8)
p.BackColor = FarbenFeld(Farbe)
' Panel zeigen
Controls.Add(p)
' Nummer
PX = PL.Count - 1
'Aktuelle Zeile/Spalte
PZ = 1
PS = 4End Sub

Susi · 25. November 2011, 08:46

Bis jetzt habe ich es schon soweit hinbekommen, das entweder vier oder drei gleiche Steine gelöscht.
Hier mal der Kommplete Code:

Spoiler anzeigen

VB.NET-Quellcode

Public Class Form1
' index des aktuellen Panel
Dim PX As Integer
' Spielfeld
Dim F(14, 9) As Integer
' Zeile
Dim PZ As Integer
' Spalte
Dim PS As Integer
'Level/Punkte/Steine
Dim Level As Integer
Dim punkte As Integer
Dim Steine As Integer
' Farbenliste
Dim FarbenFeld() As Color = {Color.Red, Color.Blue,
Color.Yellow, Color.Pink,
Color.Green, Color.Magenta,
Color.Brown, Color.Black}
' Konstanten fuer Feldpunkte
Const Rand = -2
Const Leer = -1
' leere liste von Spiel-Panels
Dim PL As New ArrayList
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
timBewegung.Enabled = True
End Sub
Private Sub NaechstesPanel()
Dim Farbe As Integer
Dim p As New Panel
' Panel zur liste hinzufgen
PL.Add(p)
' Position und groesse
p.Location = New Point(160, 80)
p.Size = New Point(20, 20)
' Farbe
Farbe = Math.Floor(Rnd() * 8)
p.BackColor = FarbenFeld(Farbe)
' Panel zeigen
Controls.Add(p)
' Nummer
PX = PL.Count - 1
'Aktuelle Zeile/Spalte
PZ = 1
PS = 1
End Sub
Private Sub AllePruefen()
Dim Z, S As Integer
Dim Neben, šber As Boolean
Neben = False
šber = False
'Drei gleiche Panels nebeneinander?
For Z = 13 To 1 Step -1
For S = 1 To 6
Neben = NebenPruefen(Z, S)
If Neben Then
Exit For
Next S
If Neben Then
Exit For
Next
'Drei gleiche Panels uebereinander?
For Z = 13 To 3 Step -1
For S = 1 To 8
ueber = šberPruefen(Z, S)
If ueber Then
Exit For
Next S
If ueber Then
Exit For
Next
If Neben Or ueber Then
AllePruefen()
End If
End Sub
Private Function NebenPruefen(ByVal Z As Integer, ByVal S As Integer) As Boolean
Dim ZX, SX As Integer
NebenPruefen = False
'Vier gleiche
If S = 6 Then
If F(Z, S) <> Leer And
F(Z, S - 1) <> Leer And F(Z, S - 2) <> Leer And F(Z, S - 3) <> Leer Then
If PL(F(Z, S)).BackColor = PL(F(Z, S - 1)).BackColor And PL(F(Z, S)).BackColor = PL(F(Z, S - 2)).BackColor And PL(F(Z, S)).BackColor = PL(F(Z, S - 3)).BackColor ThenFor SX = S To S + 3
Controls.Remove(PL(F(Z, SX)))
F(Z, SX) = Leer
Steine = Steine + 1
If Steine = 50 * Level Then
Level = Level + 1
timT.Interval = 5000 / (Level + 9)
timT.Enabled = FalseMessageBox.Show("Sie sind im level " & Level, "Neues Level", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
ZX = Z - 1Do While F(ZX, SX) <> Leer
PL(F(ZX, SX)).Top = PL(F(ZX, SX)).Top + 20
F(ZX + 1, SX) = F(ZX, SX)
F(ZX, SX) = Leer
ZX = ZX - 1
Loop
Next
punkte = punkte + 50
NebenPrfen = True
End If
End If
Else
If F(Z, S) <> Leer And F(Z, S + 1) <> Leer And F(Z, S + 2) <> Leer And F(Z, S + 3) <> Leer Then
If PL(F(Z, S)).BackColor = PL(F(Z, S + 1)).BackColor And PL(F(Z, S)).BackColor = PL(F(Z, S + 2)).BackColor And PL(F(Z, S)).BackColor = PL(F(Z, S + 3)).BackColor ThenFor SX = S To S + 3
Controls.Remove(PL(F(Z, SX)))
F(Z, SX) = Leer
Steine = Steine + 1
If Steine = 50 * Level Then
Level = Level + 1
timT.Interval = 500 + (Level * 100)
timT.Enabled = FalseMessageBox.Show("Sie sind im level " & Level)
End If
ZX = Z - 1Do While F(ZX, SX) <> Leer
PL(F(ZX, SX)).Top = PL(F(ZX, SX)).Top + 20
F(ZX + 1, SX) = F(ZX, SX)
F(ZX, SX) = Leer
ZX = ZX - 1
Loop
Next
punkte = punkte + 50
NebenPrfen = True
End If
End If
End If
'Drei kleiche
If F(Z, S) <> Leer And F(Z, S + 1) <> Leer And F(Z, S + 2) <> Leer Then
If PL(F(Z, S)).BackColor = PL(F(Z, S + 1)).BackColor And PL(F(Z, S)).BackColor = PL(F(Z, S + 2)).BackColor ThenFor SX = S To S + 2
Controls.Remove(PL(F(Z, SX)))
F(Z, SX) = Leer
Steine = Steine + 1
If Steine = 50 * Level Then
Level = Level + 1
timT.Interval = 5000 / (Level + 9)
timT.Enabled = FalseMessageBox.Show("Sie sind im level " & Level)
End If
ZX = Z - 1Do While F(ZX, SX) <> Leer
PL(F(ZX, SX)).Top = PL(F(ZX, SX)).Top + 20
F(ZX + 1, SX) = F(ZX, SX)
F(ZX, SX) = Leer
ZX = ZX - 1
Loop
Next
punkte = punkte + 20
NebenPrfen = True
End If
End If
tbSteine.Text = Steine
tbPunkte.Text = punkte
tblevel.Text = Level
End Function
Private Function šberPrfen(ByVal Z As Integer, ByVal S As Integer) As Boolean
Dim ZX As Integer
šberPrfen = False
'Vier gleiche
If F(Z, S) <> Leer And F(Z - 1, S) <> Leer And F(Z - 2, S) <> Leer And F(Z - 3, S) <> Leer Then
If PL(F(Z, S)).BackColor = PL(F(Z - 1, S)).BackColor And PL(F(Z, S)).BackColor = PL(F(Z - 2, S)).BackColor And PL(F(Z, S)).BackColor = PL(F(Z - 3, S)).BackColor ThenFor ZX = Z To Z - 3 Step -1
Controls.Remove(PL(F(ZX, S)))
F(ZX, S) = Leer
Steine = Steine + 1
If Steine = 50 * Level Then
Level = Level + 1
timT.Interval = 500 / (Level + 9)
timT.Enabled = FalseMessageBox.Show("Sie sind im level " & Level)
End If
Next
punkte = punkte + 50
šberPrfen = True
End If
'Drei kleiche
ElseIf F(Z, S) <> Leer And F(Z - 1, S) <> Leer And F(Z - 2, S) <> Leer Then
If PL(F(Z, S)).BackColor = PL(F(Z - 1, S)).BackColor And PL(F(Z, S)).BackColor = PL(F(Z - 2, S)).BackColor ThenFor ZX = Z To Z - 2 Step -1
Controls.Remove(PL(F(ZX, S)))
F(ZX, S) = Leer
Steine = Steine + 1
If Steine = 50 * Level Then
Level = Level + 1
timT.Interval = 500 / (Level + 9)
timT.Enabled = FalseMessageBox.Show("Sie sind im level " & Level)
End If
Next
punkte = punkte + 20
šberPrfen = True
End If
End If
tbSteine.Text = Steine
tbPunkte.Text = punkte
tblevel.Text = Level
End FunctionPrivate Sub Links()
If F(PZ, PS - 1) = Leer Then
PL(PX).Left = PL(PX).Left - 20
PS = PS - 1
End If
End SubPrivate Sub Rechts()
If F(PZ, PS + 1) = Leer Then
PL(PX).Left = PL(PX).Left + 20
PS = PS + 1
End If
End SubPrivate Sub Unten()Do While F(PZ + 1, PS) = Leer
PL(PX).Top = PL(PX).Top + 20
PZ = PZ + 1
Loop
F(PZ, PS) = PX
AllePrfen()
N„chstesPanel()
End SubPrivate Sub timT_Tick_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timT.Tick
' Fals es nicht weiter geht
If F(PZ + 1, PS) <> Leer Then
'Oberste Zeile erreicht
If PZ = 1 Then
timT.Enabled = FalseMessageBox.Show("Spiel zu ende", "Hinweis", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Exit Sub
End If
F(PZ, PS) = PX
AllePrfen()
N„chstesPanel()
Else
PL(PX).Top = PL(PX).Top + 20
PZ = PZ + 1
End If
End Sub
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerPrivate Sub timBewegung_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timBewegung.Tick
Dim r As Boolean
Dim l As Boolean
Dim u As Boolean
Dim esc As Boolean
Dim F2 As Boolean
Dim F1 As Boolean
r = GetAsyncKeyState(Keys.Right)
l = GetAsyncKeyState(Keys.Left)
u = GetAsyncKeyState(Keys.Space)
esc = GetAsyncKeyState(Keys.Escape)
F2 = GetAsyncKeyState(Keys.F2)
F1 = GetAsyncKeyState(Keys.F1)
If r = True Then
Rechts()
ElseIf esc = True ThenMe.Close()
ElseIf l = True Then
Links()
ElseIf u = True Then
Unten()
ElseIf F2 = True Then
timT.Enabled = False
ElseIf F1 = True Then
timT.Enabled = True
End If
End SubPrivate Sub timSpielzeit_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timSpielzeit.Tick
Dim Start As Date = tbStartzeit.TextDim h As Integer = DateDiff(DateInterval.Hour, Start, TimeOfDay)
Dim m As Integer = DateDiff(DateInterval.Minute, Start, TimeOfDay)Dim s As Integer = DateDiff(DateInterval.Second, Start, TimeOfDay)
If s >= 60 Then
s = s - (m * 60)
ElseIf m >= 60 Then
s = s - (m * 60)
m = m - (h * 60)
End If
tbspielzeitS.Text = s
tbspielzeitM.Text = m
tbspielzeitH.Text = h
tbaktuelleZeit.Text = TimeOfDay
End SubPrivate Sub StartenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StartenToolStripMenuItem.Click
Dim Z, S As Integer
' Farbenwahl
Randomize()
' Feld besetzenFor Z = 1 To 13
F(Z, 0) = RandFor S = 1 To 8
F(Z, S) = LeerNext S
F(Z, 9) = RandNext ZFor S = 0 To 9
F(14, S) = Rand
Next
'Spielstarten
Level = 1
N„chstesPanel()
timT.Enabled = True
tbStartzeit.Text = TimeOfDay
timSpielzeit.Enabled = True
'########
tblevel.Text = Level
tbPunkte.Text = 0End Sub
End Class

Nun bis jetzt läuft es supper, aber hat jemand noch idee was man verbessern könnte

picoflop · 25. November 2011, 09:06

Susi schrieb:

aber hat jemand noch idee was man verbessern könnte

Du könntest auf (Beitrag) "bearbeiten" gehen, den VB Code löschen, dann den Editor auf "Quellcode" umschalten und dann den VB Code nochmal einfügen. Das würde die Lesbarkeit des Codes schon mal um rund 431% verbessern ... (andernfalls führt das Lesen des Codes leicht zu Bindehautentzündungen)

Gredsoft · 25. November 2011, 15:14

Was Du noch machen könntest:

Menü
Highscore
Multiplayerfunktion

GMT · 25. November 2011, 15:16

Und noch was ein :
-Chat(ein kleiner)
-Freundesliste
Und die sachen von Gredsoft natürlich

Gredsoft · 25. November 2011, 15:18

Hallo GMT,

Chat und Freundesliste.. Hm...

Vllt. eher für "größere Spiele" (PN :D), aber für ein kleines Tetris würde ein Onlinehighscore reichen...

Grüße,

Gredsoft

picoflop · 25. November 2011, 15:38

GMT schrieb:

Und noch was ein :

Da der Code aus dem Galileobuch übelster Schrott ist, würde ich den erstmal "schön" machen, bevor ich anfange "features" einzubauen.

Randomize() ? Würg!

VB.NET-Quellcode

' Feld besetzen
For Z = 1 To 13
F(Z, 0) = Rand
For S = 1 To 8
F(Z, S) = Leer
Next S
F(Z, 9) = Rand
Next Z

A B C die Katze lief im Schnee?

Wenn schon nur Buchstaben, dann aber bitte "x" für die "Spalte" und "y" für die "Zeile". Aber auch mit "Spalte" und "Zeile" bricht man sich nix ab.
F(,) ? -> Feld(,) !
Rand? Random.Next(Von_inkl, Bis_exkl) !

Ich muss dem Erfinder des Rades zustimmen: Das Buch ist K*cke

Gredsoft · 25. November 2011, 15:41

Hallo,

habe ich auch bemerkt.

Die machen alles umständlich.

z.B. die verwenden "Ü"s in den Subs. Das sollte man doch nicht machen, oder?

VB.NET-Quellcode

Sub Nächste_Vokabel()' Laber, Laber, [...]
End Sub

BDG · 26. November 2011, 20:27

Also ich würde ja ganz dringend die Variablen-Namen ändern ... Mit SX und A-was-weiß-ich kann doch kener was anfangen ...

Bernd93 · 23. April 2014, 10:55

Hallo,

zuerst möchte ich sagen, dass ich ein absoluter Anfänger bin und eigentlich nichts kann...
Ich hab mit einem Kumpel ein Tetris light Programm geschrieben jedoch kommen wir nicht drauf, wie wir die steine löschen.
Ziel ist es 3 gleiche steine übereinander zu löschen.
Bitte um HILFE !!!!

Hier unser Programm:

Public Class Form1
Public brickCount As Integer = 0
Public aHi As Integer = 0 'aktuelle Höhe
Public aBrick As Object 'aktueller stein
Public rowH(14) As Integer
Public bCheck As Boolean = False
Public labar() As Label
Dim ueber As Boolean

Public Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.Left Then
If aBrick.Left > 0 Then
aBrick.Left = aBrick.Left - 25
End If
ElseIf e.KeyCode = Keys.Right Then
If aBrick.Left < Me.Width - aBrick.Width Then
aBrick.Left = aBrick.Left + 25
End If
End If
End Sub

Function CheckLoose(ByVal i As Integer) As Boolean 'game over
If rowH(i) <= 0 Then
MsgBox("Verloren")
Return True
Else
Return False
End If
End Function

Function SetHeight(ByVal sender As Object, ByVal rowI As Integer, ByVal lohi As Boolean) 'Höhe setzen
If lohi = True Then
rowH(rowI) = rowH(rowI) - sender.Height
Else
If rowH(rowI) <> Me.Height Then
rowH(rowI) = rowH(rowI) + sender.Height
Else
rowH(rowI) = 0
End If
End If

End Function

Function GetRandom() As Integer 'zufall
Randomize()
Dim upperbound As Integer = 3
Dim lowerbound As Integer = 1
Return CInt(Math.Floor((upperbound - lowerbound + 1) * Rnd())) + lowerbound
End Function

Function DoAnimation(ByVal obj As Object) 'runter fallen
obj.Top = obj.Top + 5
If rowH(GetRow(aBrick)) = 0 Then
rowH(GetRow(aBrick)) = 550
End If
If obj.Top + obj.Height >= rowH(GetRow(aBrick)) Then
Timer1.Stop()
SetHeight(aBrick, GetRow(aBrick), True)
If CheckLoose(GetRow(aBrick)) = True Then
Timer1.Stop()
bCheck = True
Button1.Enabled = True
Button1.Visible = True
Else
aBrick = GetBrick(GetRandom())
Timer1.Start()
End If
End If
End Function

Function GetRow(ByVal obj As Object) As Integer 'reihen überprüfen
Dim row As Integer
Select Case obj.Left
Case 0 To 24
row = 1
Case 25 To 49
row = 2
Case 50 To 74
row = 3
Case 75 To 99
row = 4
Case 100 To 124
row = 5
Case 125 To 149
row = 6
Case 150 To 174
row = 7
Case 175 To 199
row = 8
Case 200 To 224
row = 9
Case 225 To 249
row = 10
Case 250 To 274
row = 11
Case 275 To 299
row = 12
Case 300 To 324
row = 13
Case 325 To 350
row = 14
End Select
Return row
End Function

Function GetBrick(ByVal i As Integer) As Object 'steine
Dim newLabel As New Label
If i = 1 Then
newLabel.Size = New Size(25, 25)
newLabel.BackColor = Color.Red
ElseIf i = 2 Then
newLabel.Size = New Size(25, 50)
newLabel.BackColor = Color.Blue
ElseIf i = 3 Then
newLabel.Size = New Size(25, 75)
newLabel.BackColor = Color.Green
End If
newLabel.Name = "brick" & brickCount
newLabel.Location = New Drawing.Point(Me.Width / 2 - newLabel.Width, 0) 'me bezieht sich auf form1
Array.Resize(labar, brickCount + 1)
labar(brickCount) = newLabel
brickCount = brickCount + 1 'das immer ein neuer kommt
newLabel.BringToFront() 'sichtbar
Me.Controls.Add(newLabel) 'zu form1 hinzufügen, spielfeld
Return (newLabel)
End Function

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If bCheck = True Then
sender.Text = "Spiel beenden"
Application.Exit()
Else
aBrick = GetBrick(GetRandom())
Timer1.Start()
sender.Hide()
sender.Enabled = False 'gleiche wie visible.false
End If
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
DoAnimation(aBrick)
End Sub

End Class

Trade · 23. April 2014, 11:02

Scheint mir sowieso der falsche Ansatz. Schnapp Dir GDI+ oder ne gescheite Engine (z. B. Sharpex2D oder GameUtils) und mach das dann.

sonne75 · 23. April 2014, 11:03

EDIT: Huch, der ist ja alt.

EDIT2: Mist, jetzt habe ich alles gelöscht

War doch aktuell.

Also nochmal: statt Select Case für row:

VB.NET-Quellcode

row=obj.Left\25 +1 '\ ist eine Ganzzahldivision

aBrick sollte ein Objekt der Klasse "Brick" sein, die du selbst schreibst, und die alle nötigen Methoden und Eigenschaften hat.

Und den Code in VB-Tags einfügen (auf VB.NET klicken, rechts oben)

Bernd93 · 23. April 2014, 11:24

okay

kann mir auch jemand eine Code geben für das Löschen oder geht das mit dem bisherigen Programm nicht ?

sonne75 · 23. April 2014, 11:26

sonne75 schrieb:

Und den Code in VB-Tags einfügen (auf VB.NET klicken, rechts oben)

So wie jetzt wird deinen Code niemand lesen.

Trade · 23. April 2014, 11:26

Nö, hier gibt es gar keinen Code, nur Tipps. Wenn Du Code willst musst Du zum Marktplatz.
Da der Thread 3 Jahre alt ist, #closerequest.

Bernd93 · 23. April 2014, 11:36

.....

sonne75 · 23. April 2014, 11:39

Du musst den Code neu vom Visual Studio kopieren, damit Einrückungen da sind. So ist er immer noch nicht wirklich lesbar.

Bernd93 · 23. April 2014, 11:53

VB.NET-Quellcode

Public Class Form1
Public brickCount As Integer = 0
Public aHi As Integer = 0 'aktuelle Höhe
Public aBrick As Object 'aktueller stein
Public rowH(14) As Integer
Public bCheck As Boolean = False
Public labar() As Label
Dim ueber As Boolean
Public Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.Left Then
If aBrick.Left > 0 Then
aBrick.Left = aBrick.Left - 25
End If
ElseIf e.KeyCode = Keys.Right Then
If aBrick.Left < Me.Width - aBrick.Width Then
aBrick.Left = aBrick.Left + 25
End If
End If
End Sub
Function CheckLoose(ByVal i As Integer) As Boolean 'game over
If rowH(i) <= 0 Then
MsgBox("Verloren")
Return True
Else
Return False
End If
End Function
Function SetHeight(ByVal sender As Object, ByVal rowI As Integer, ByVal lohi As Boolean) 'Höhe setzen
If lohi = True Then
rowH(rowI) = rowH(rowI) - sender.Height
Else
If rowH(rowI) <> Me.Height Then
rowH(rowI) = rowH(rowI) + sender.Height
Else
rowH(rowI) = 0
End If
End If
End Function
Function GetRandom() As Integer 'zufall
Randomize()
Dim upperbound As Integer = 3
Dim lowerbound As Integer = 1
Return CInt(Math.Floor((upperbound - lowerbound + 1) * Rnd())) + lowerbound
End Function
Function DoAnimation(ByVal obj As Object) 'runter fallen
obj.Top = obj.Top + 5
If rowH(GetRow(aBrick)) = 0 Then
rowH(GetRow(aBrick)) = 550
End If
If obj.Top + obj.Height >= rowH(GetRow(aBrick)) Then
Timer1.Stop()
SetHeight(aBrick, GetRow(aBrick), True)
If CheckLoose(GetRow(aBrick)) = True Then
Timer1.Stop()
bCheck = True
Button1.Enabled = True
Button1.Visible = True
Else
aBrick = GetBrick(GetRandom())
Timer1.Start()
End If
End If
End Function
Function GetRow(ByVal obj As Object) As Integer 'reihen überprüfen
Dim row As Integer
Select Case obj.Left
Case 0 To 24
row = 1
Case 25 To 49
row = 2
Case 50 To 74
row = 3
Case 75 To 99
row = 4
Case 100 To 124
row = 5
Case 125 To 149
row = 6
Case 150 To 174
row = 7
Case 175 To 199
row = 8
Case 200 To 224
row = 9
Case 225 To 249
row = 10
Case 250 To 274
row = 11
Case 275 To 299
row = 12
Case 300 To 324
row = 13
Case 325 To 350
row = 14
End Select
Return row
End Function
Function GetBrick(ByVal i As Integer) As Object 'steine
Dim newLabel As New Label
If i = 1 Then
newLabel.Size = New Size(25, 25)
newLabel.BackColor = Color.Red
ElseIf i = 2 Then
newLabel.Size = New Size(25, 50)
newLabel.BackColor = Color.Blue
ElseIf i = 3 Then
newLabel.Size = New Size(25, 75)
newLabel.BackColor = Color.Green
End If
newLabel.Name = "brick" & brickCount
newLabel.Location = New Drawing.Point(Me.Width / 2 - newLabel.Width, 0) 'me bezieht sich auf form1
Array.Resize(labar, brickCount + 1)
labar(brickCount) = newLabel
brickCount = brickCount + 1 'das immer ein neuer kommt
newLabel.BringToFront() 'sichtbar
Me.Controls.Add(newLabel) 'zu form1 hinzufügen, spielfeld
Return (newLabel)
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If bCheck = True Then
sender.Text = "Spiel beenden"
Application.Exit()
Else
aBrick = GetBrick(GetRandom())
Timer1.Start()
sender.Hide()
sender.Enabled = False 'gleiche wie visible.false
End If
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
DoAnimation(aBrick)
End Sub
Private Sub Deleted(ByVal aBrick As Object)
Throw New NotImplementedException
End Sub
End Class

Spiel tetris

Spiel tetris

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

Fareben

VB.NET-Quellcode

Hat jemand noch andere Idee

VB.NET-Quellcode

Susi schrieb:

GMT schrieb:

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

sonne75 schrieb:

VB.NET-Quellcode

Tags

Ähnliche Themen

3 Benutzer haben hier geschrieben