
1. Schritt
Nach dem Ausführen der Start-Datei kann die oben angezeigte Meldung erscheinen. Hier im Text auf 'Weitere Informationen klicken'
Das Spielt wurde von uns selbst in der Programmiersprache vb.net erstellt und könnt Ihr direkt von unserer Cloud downloaden. Bei Interesse erhaltet Ihr auch auf Anfrage über unserer Kontaktformular den Quelltext zum Spiel.
Spiele Tetris als Single- oder Multi-Player Game über das Internet.
Über „Open Online-Game“ können Sie ein neues Spiel eröffnen. Ihr Mitspieler kann diesem Spiel dann beitreten. Sobald 2 Spieler im Spiel sind, startet dieses Automatisch.
Baut ein Spieler mehr wie 2 Reihen mit einem Zug ab, werden diese beim Gegner um eins reduziert hinzugefügt.
Über die Funktion „Finde Online Game“ können Sie einem bereits geöffnetem Spiel beitreten.
Die einzelnen Spielsteine lassen sich über die Buchstaben „A, S, D, W“ oder die Zahlen „8, 4, 6, 5“ auf Ihrer Tastatur steuern und drehen.
(Microsoft .NET Framework 4.7 erforderlich)
Beim Download oder der Installation weist Microsoft unter Umständen darauf hin, dass das Programm von einem Unbekannten-Herausgeber ist. Das Programm lässt sich jedoch trotzdem Installieren.
Unter „Weiteren Informationen“ können Sie „Trotzdem ausführen“ auswählen. Um das Problem beim Download zu umgehen, können Sie auch einfach nur die *.zip herunterladen und entpacken.
Der Quellcode musste etwas angepasst werden, dass er auf der Homepage richtig angezeigt und eingebunden werden kann.
Er kann somit nicht 1 zu 1 in Visual Studio übernommen werden (Zusätzliche Zeilenumbrüche).
Gerne kann ich euch das Original zukommen lassen. Schreibt mir hierzu einfach über das Kontaktformular.
Option Explicit On
Public Class Form1
'***Globale Variablen
'* Arrays Tetris-Steine
Private arrTStone1 = New String() {"0110", "0110", "0000", "0000", "0110", "0110", ¶
"0000", "0000", "0110", "0110", "0000", "0000", "0110", "0110", "0000", "0000"}
Private arrTStone2 = New String() {"1100", "0110", "0000", "0000", "0010", "0110", ¶
"0100", "0000", "1100", "0110", "0000", "0000", "0010", "0110", "0100", "0000"}
Private arrTStone3 = New String() {"0110", "1100", "0000", "0000", "0100", "0110", ¶
"0010", "0000", "0110", "1100", "0000", "0000", "0100", "0110", "0010", "0000"}
Private arrTStone4 = New String() {"1000", "1110", "0000", "0000", "0110", "0100", ¶
"0100", "0000", "0000", "1110", "0010", "0000", "0100", "0100", "1100", "0000"}
Private arrTStone5 = New String() {"0010", "1110", "0000", "0000", "0100", "0100", ¶
"0110", "0000", "0000", "1110", "1000", "0000", "1100", "0100", "0100", "0000"}
Private arrTStone6 = New String() {"0100", "1110", "0000", "0000", "0100", "0110", ¶
"0100", "0000", "0000", "1110", "0100", "0000", "0100", "1100", "0100", "0000"}
Private arrTStone7 = New String() {"0000", "1111", "0000", "0000", "0100", "0100", ¶
"0100", "0100", "0000", "1111", "0000", "0000", "0100", "0100", "0100", "0100"}
Private lstArrTStone As Array = {arrTStone1, arrTStone2, arrTStone3, arrTStone4, ¶
arrTStone5, arrTStone6, arrTStone7}
'* Array Neuer Stein
Private arrNextTStone() As String = {"", "", "", "", "NA", "0", "3", "3", "0"} ¶
'* Aktueller TStone {Stone1/Stone2/Stone3/Stone4/TStone_Type/Start_Rotation/ ¶
Ende_Roation/X-Offset-Hor/Y-Offset-Ver}
'* Array Tetris-Steine Farben
Private arrTStoneColor = New Color() {Color.Red, Color.Blue, Color.Green, ¶
Color.Black, Color.Indigo, Color.Orange, Color.Purple}
'* Array Vertikale Zahl in Buchstaben
Private arrVerABC = New String() {"A", "B", "C", "D", "E", "F", "G", "H", ¶
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R"}
'***Form Laden
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
cmdSteuerung.Select() '* Start Taster Select
Call newTStone() '* Neuen Stein im Vorschaufenster anzeigen
Call CheckID(1) '*Singelplayer ID`s anpassen
End Sub
'***Funktionen
'**Neuen Stein erzeugen
Sub newTStone()
'*Zufallsgenerator
Dim rndNewTStone As New Random
arrNextTStone(4) = rndNewTStone.Next(0, 7)
'*Variablen
Dim intArrZähler As Integer = 0
For intArrZähler = 0 To 3
If arrNextTStone(intArrZähler) <> "" Then
groupPreview.Controls("BlockPrev" & arrNextTStone(intArrZähler)). ¶
BackColor = Color.White
DirectCast(groupPreview.Controls("BlockPrev" & arrNextTStone(intArrZähler)), ¶
Panel).BorderStyle = BorderStyle.None
End If
Next
intArrZähler = 0
'*Adressen von neuen Stein auslesen
For intStoneBuild = 0 To 3 '*Erste 4 Felder nach Index des New-Stein-Arrays ¶
nacheinander ansprechen
For intGetBlockOK = 1 To 4 '*Von Index Einzelstellen auflösen
If Mid$(lstArrTStone(arrNextTStone(4))(intStoneBuild), intGetBlockOK, 1) = 1 Then ¶
'*Überprüfen ob Bit = 1
arrNextTStone(intArrZähler) = intGetBlockOK + 2 & arrVerABC(intStoneBuild)
groupPreview.Controls("BlockPrev" & intGetBlockOK + 2 & ¶
arrVerABC(intStoneBuild)).BackColor = arrTStoneColor(arrNextTStone(4))
DirectCast(groupPreview.Controls("BlockPrev" & intGetBlockOK + 2 & ¶
arrVerABC(intStoneBuild)), Panel).BorderStyle = BorderStyle.Fixed3D
intArrZähler = intArrZähler + 1
End If
Next
Next
End Sub
'**Spielfeld anpassen
Function GameField(intFunction As Integer, intAktHeight As Integer)
'*Variablen deklarieren
Dim intHor As Integer = 0 '*Horizontale Achse ansprechen
Dim intVer As Integer = 0 '*Vertikale Achse ansprechen
Dim intCountBlock As Integer = 0 '*Anzahl farbiger Blöcke pro Reihe
Dim intCountRow As Integer = -1 '*Anzahl Reihen zum abbauen
Dim intTarget As Integer = 0 '*Target festlegen +1 pro volle Zeile
Dim intExitFor As Integer = 0 '*Schnelles beenden der Schleife
Dim arrLineDel() As Integer = {-1, -1, -1, -1} '*Linien zum löschen
Dim valColor As Color = Color.White '*Farbe festlegen
Dim valBorder As BorderStyle = BorderStyle.None '*Border None
If intFunction = 1 Or intFunction > 2 Then
valColor = Color.SlateGray
valBorder = BorderStyle.Fixed3D
End If
Static intSumRowUp As Integer = 0 '*Anzahl der aufgebauten Reihen speichern
Static intRNDFreeBlock As Integer = 0 '*Zufallszahl wo freie Stelle sein soll
'*Spielfeld Reset oder Clear
If intFunction <= 1 Then
For intHor = 0 To 9
For intVer = 0 To 17
Me.Controls("Block" & intHor & arrVerABC(intVer)).BackColor = valColor
DirectCast(Me.Controls("Block" & intHor & arrVerABC(intVer)), ¶
Panel).BorderStyle = valBorder
Next
Next
intSumRowUp = 0
intRNDFreeBlock = 0
End If
'**Ganze Linien abbauen
If intFunction = 2 Then
'*Speichern der Linien die abgebaut werden sollen
For intVer = 17 To 0 Step -1
If intCountRow = 3 Or intExitFor = 4 Then
Exit For
End If
For intHor = 0 To 9
If Me.Controls("Block" & intHor & arrVerABC(intVer)).BackColor = ¶
valColor Then '*Prüfen ob weißer Stein enthalten
intCountBlock = 0
Exit For
Else '*Weißer Stein enthalten
intCountBlock = intCountBlock + 1
If intCountBlock = 10 Then
intCountBlock = 0
intCountRow = intCountRow + 1
arrLineDel(intCountRow) = intVer
End If
End If
Next
If intCountRow >= 0 Then
intExitFor = intExitFor + 1
End If
Next
'*Abbauen der Linien
intHor = 0
intVer = 0
For intVer = 17 To 0 Step -1
For intHor = 0 To 9
If Not arrLineDel.Contains(intVer) Then
Me.Controls("Block" & intHor & arrVerABC(intVer + intTarget)). ¶
BackColor = Me.Controls("Block" & intHor & arrVerABC(intVer)).BackColor
DirectCast(Me.Controls("Block" & intHor & arrVerABC(intVer + intTarget)), ¶
Panel).BorderStyle = DirectCast(Me.Controls("Block" & intHor & arrVerABC(intVer)), ¶
Panel).BorderStyle
Else
intTarget = intTarget + 1
Exit For
End If
Next
Next
'*Löschen der letzten Blöcke
If intCountRow > -1 Then
intHor = 0
intVer = 0
For intVer = 0 To intCountRow
For intHor = 0 To 9
Me.Controls("Block" & intHor & arrVerABC(intVer)).BackColor = valColor
DirectCast(Me.Controls("Block" & intHor & arrVerABC(intVer + intTarget)), ¶
Panel).BorderStyle = valBorder
Next
Next
End If
Return intCountRow + 1
End If
'*Linien vom Gegner unten aufbauen
If intFunction > 2 Then
intCountRow = intCountRow + 1 + intFunction - 3 ¶
'*Anzahl der Reihen die aufgebaut werden sollen (Mit Funktion wird auch Anzahl übergeben)
'*Steine nach oben kopieren
For intVer = 16 - intAktHeight To 17 - intCountRow
For intHor = 0 To 9
Me.Controls("Block" & intHor & arrVerABC(intVer)).BackColor = ¶
Me.Controls("Block" & intHor & arrVerABC(intVer + intCountRow)).BackColor
DirectCast(Me.Controls("Block" & intHor & arrVerABC(intVer)), Panel).BorderStyle = ¶
DirectCast(Me.Controls("Block" & intHor & ¶
arrVerABC(intVer + intCountRow)), Panel).BorderStyle
Next
Next
'*Zufallsgenerator für freie Stelle
If intSumRowUp = 0 Or intSumRowUp >= 6 Then
Dim rndNewTStone As New Random
intRNDFreeBlock = rndNewTStone.Next(1, 9)
intSumRowUp = intCountRow
Else
intSumRowUp = intSumRowUp + intCountRow
End If
'*Felder grau einfärben
intHor = 0
intVer = 0
For intVer = 18 - intCountRow To 17
For intHor = 0 To 9
If intHor <> intRNDFreeBlock Then
Me.Controls("Block" & intHor & arrVerABC(intVer)).BackColor = valColor
DirectCast(Me.Controls("Block" & intHor & arrVerABC(intVer)),¶
Panel).BorderStyle = valBorder
Else
Me.Controls("Block" & intHor & arrVerABC(intVer)).BackColor = Color.White
DirectCast(Me.Controls("Block" & intHor & arrVerABC(intVer)),¶
Panel).BorderStyle = BorderStyle.None
End If
Next
Next
End If
End Function
'**SQL Statement ausführen
Function SQLConnect(intFunktion As Integer, strUrl As String)
Dim client As New Net.WebClient
Dim strResult As String = ""
Try
If intFunktion = 1 Then
client.OpenRead("https://xx.xx/xx/xx/xx.php?" & strUrl)¶
'*SQL Neuer Eintrag oder Update von Werten
Else
strResult = client.DownloadString("https://xx.xx/xx/xx/xx.php?" & ¶
strUrl) '*SQL SELECT von Werten
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
client.CancelAsync()
client.Dispose()
strResult = Replace(strResult, vbLf, "")
Return strResult
End Function
'**Version prüfen
Sub CheckVersion()
'*Version Prüfen
Dim strVersion As String = Me.Text
strVersion = strVersion.Substring(strVersion.LastIndexOf(" V") + 1) ¶
'Version aus Titel lesen
If Not SQLConnect(2, "st=1") = strVersion Then
If MsgBox("Die Version " & strVersion & " ist veraltet und funktioniert ¶
in Verbindung mit neueren Versionen evtl. nicht ordnungsgemäß." & vbNewLine & ¶
"Bitte laden Sie die neueste Version von https:\\www.ploesch.de bevor Sie fortfahren." & ¶
vbNewLine & vbNewLine & "Web-Seite jetzt öffnen?", vbYesNo) = vbYes Then
Process.Start("https:\\ploesch.de\index.php?side=g-tetris")
End If
cmdSteuerung.Enabled = False
Else
cmdSteuerung.Enabled = True
End If
End Sub
'*SpielerPunkte anpassen
Sub GamePoints(intFunction As Integer)
If intFunction = 0 Then '*Score zurücksetzen
txtSteine.Text = 0
txtReihen.Text = 0
txtLevel.Text = 0
txtScore.Text = 0
ElseIf intFunction = 1 Then '*Score berechnen
txtScore.Text = txtSteine.Text * txtReihen.Text * txtLevel.Text
End If
End Sub
'**Spielernamen anpassen
Sub GamerName()
txtPlayer1Name.Text = ""
txtPlayer2Name.Text = ""
End Sub
'**ID`S anpassen
Sub CheckID(intFunction As Integer)
If intFunction <> 4 Then
cboGameID.Enabled = False
cboGameID.Items.Clear()
cboGameID.Text = ""
txtPlayerID.Text = ""
optSingle.Enabled = True
optFindGame.Enabled = True
optOpenGame.Enabled = True
Else '*Menü komplett Sperren
optSingle.Enabled = False
optFindGame.Enabled = False
optOpenGame.Enabled = False
cboGameID.Enabled = False
End If
If intFunction = 1 Then '*SingelPlayer
cboGameID.Items.Add("0")
cboGameID.SelectedIndex = 0
txtPlayerID.Text = "0"
ElseIf intFunction = 2 Then '*Open MultiplayerGame
txtPlayerID.Text = "1"
ElseIf intFunction = 3 Then '*Find MultiplayerGame
txtPlayerID.Text = "2"
cboGameID.Enabled = True
End If
End Sub
'**Gameplay
Sub GamePlay(strKey As String)
'*Variablen
Static intBetart As Integer = 0 '*Betriebsart speichern
Dim intSchlTetris As Integer = 0 '*Variable für Schleife
Dim intIndex As Integer = 0 '*Variable für Zwischenindex Info
Dim strIndex As String = "" '*Variable für Zwischenstring Info
Dim bolExitFor As Boolean = False '*ExitFor auf eine Ebene bringen
Dim intTempHeight As Integer = 0 '*Speichern der temporäen Höhe
Dim bolExitGame As Boolean = False '*Bei true Game Over
Dim strWinner As String = "1" '*Speichern des Gewinners bei Multiplayer-Game
Static intAktHeight As Integer = 0 '*Speichern der aktuellen höhe der Steine im Spielfeld
Static intSaveGetRow As Integer = 0 '*Speichern der Linien die abgebaut ¶
wurden vom Gegner bzw übergeben wurden
'*Variablen für Spielablauf
Static arrAktDataTStone() As String = {"NA", "NA", "NA", "NA", "NA", "0", "3", "3", "0"} ¶
'* Aktueller TStone {Stone1/Stone2/Stone3/Stone4/TStone_Type/ ¶
Start_Rotation/Ende_Roation/X-Offset/Y-Offset}
Static arrNextDataTStone() As String = {"NA", "NA", "NA", "NA", "NA", "0", "3", "3", "0"} ¶
'* Next Pos TStone {Stone1/Stone2/Stone3/Stone4/TStone_Type/Start_Rotation/ ¶
Ende_Roation/X-Offset/Y-Offset}
'*Spiel starten und beenden
If intBetart = 0 And strKey = "0" Then '*Spiel starten
intBetart = 1
ElseIf intBetart > 0 And strKey = "0" Then '*Spiel beenden
'*Static Variablen zurücksetzten
intAktHeight = 0
intBetart = 0
intSaveGetRow = 0
Call GameField(0, Nothing)
PictureBoxInfo.Visible = True
End If
'* Pürfen ob alle Spieler im Spiel
If optOpenGame.Checked = True And intBetart = 1 Then
TimerGame.Enabled = True
If txtPlayer2Name.Text = "Searching..." Then
txtPlayer2Name.Text = ""
ElseIf txtPlayer2Name.Text = "" Then
txtPlayer2Name.Text = "Searching..."
End If
'*Namen Spieler aus der Datenbank laden
Dim strGamerName2 As String = SQLConnect(2, "st=2&v1=" & cboGameID.SelectedItem & "&v2=2")
If strGamerName2 <> "" Then
TimerGame.Enabled = False
txtPlayer2Name.Text = strGamerName2
intBetart = 2
End If
ElseIf (optSingle.Checked = True Or optFindGame.Checked = True) And intBetart = 1 Then
intBetart = 2
End If
'***Alle Spieler im Spiel!
If intBetart = 2 Then '*Startverzögerung
TimerGame.Enabled = True
ProgressBarTop.Value = ProgressBarTop.Value + 3
If ProgressBarTop.Value = 18 Then
ProgressBarTop.Value = 0
intBetart = 3
PictureBoxInfo.Visible = False
txtLevel.Text = txtLevel.Text + 1
End If
End If
'*Erster/Nächsten Stein setzten
If intBetart = 3 Then
'*Daten von Gegner laden
If optSingle.Checked = False Then
strIndex = SQLConnect(2, "st=3&v1=" & cboGameID.SelectedItem & "&v2=" & txtPlayerID.Text)
If strIndex <> "1#0#0" Then
Dim strGetValue() As String = strIndex.Split("#") ¶
'*Speichern der einzelnen Werte der Antwort im Array
strWinner = strGetValue(0)
If strGetValue(0) = "1" And intAktHeight + strGetValue(1) - intSaveGetRow <= 18 Then
ProgressBarTop.Value = strGetValue(2) '*Progressbar anpassen
'*Höhe anpassen
If strGetValue(1) - intSaveGetRow > 0 Then
Call GameField(3 + strGetValue(1) - intSaveGetRow, intAktHeight) ¶
'*Steine von unten hoch schieben
intAktHeight = intAktHeight + strGetValue(1) - intSaveGetRow
intSaveGetRow = strGetValue(1)
End If
Else '*Spiel vorbei bei nächstem Stein laden
bolExitGame = True
End If
End If
End If
'*Textfelder anpassen
txtSteine.Text = txtSteine.Text + 1
txtScore.Text = txtSteine.Text * txtReihen.Text * txtLevel.Text
'*Level anpassen
If Int(txtReihen.Text / 5) > 0 Then
txtLevel.Text = Int(txtReihen.Text / 5)
End If
'*Anpassen der Interval-Zeit
If 1100 - Int(txtReihen.Text / 5) * 50 > 100 Then
TimerGame.Interval = 1100 - Int(txtReihen.Text / 5) * 50
End If
'*Steine setzen
Array.Copy(arrNextTStone, arrAktDataTStone, 9) '*Aktuellen Stein aus Vorschau speichern
Call newTStone() '*Neuen Stein in Vorschau laden
For intSchlTetris = 0 To 3
If Me.Controls("Block" & arrAktDataTStone(intSchlTetris)).BackColor = ¶
Color.White And bolExitGame = False Then
Me.Controls("Block" & arrAktDataTStone(intSchlTetris)).BackColor = ¶
arrTStoneColor(arrAktDataTStone(4))
DirectCast(Me.Controls("Block" & arrAktDataTStone(intSchlTetris)),¶
Panel).BorderStyle = BorderStyle.Fixed3D
Else '*Game Over
TimerGame.Enabled = False
'*GAME OVER ausgeben
If optSingle.Checked = False Then '*Bei Multiplayer
Call SQLConnect(1, "st=13&v1=" & cboGameID.SelectedItem & "&v2=" & ¶
txtPlayerID.Text) '*Spiel beenden
'*Punkte an DB Übergeben
Dim intPlID As Integer = txtPlayerID.Text
Call SQLConnect(1, "st=14&v1=" & intPlID & "&v2=" & ¶
groupPlayer.Controls("txtPlayer" & intPlID & "Name").Text & ¶
"&v3=" & txtSteine.Text & "&v4=" & txtReihen.Text & "&v5=" & ¶
txtLevel.Text & "&v6=" & txtScore.Text & "&v7=" & cboGameID.SelectedItem) ¶
'*Spiel beenden
If strWinner = "0" Then
MsgBox("Sie haben gewonnen :-)")
Else
MsgBox("Sie haben leider verloren :-(")
End If
Else '*Bei Singleplayer
Select Case MessageBox.Show("Game Over :-(" & vbNewLine & ¶
vbNewLine & "Score im Leaderboard speichern?", ¶
"Memory-Single Game", MessageBoxButtons.YesNo)
Case Windows.Forms.DialogResult.Yes
Call SQLConnect(1, "st=7&v1=" & txtPlayer1Name.Text & "&v2=" & ¶
txtSteine.Text & "&v3=" & txtReihen.Text & "&v4=" & txtLevel.Text & ¶
"&v5=" & txtScore.Text) '*Punkte eintragen wenn gewollt
End Select
End If
cmdSteuerung.Text = "GAME OVER / RESET"
Call GameField(1, Nothing)
ProgressBarTop.Value = 0
Exit Sub
End If
Next
intBetart = 4
Array.Copy(arrAktDataTStone, 5, arrNextDataTStone, 5, 4) '*Aktuelle Pos Daten kopieren
Exit Sub
End If
'*MOVE TStone
If intBetart = 4 And strKey <> "0" Then
If strKey = "s" Or strKey = "1" Then '*Bewegung nach unten
For intSchlTetris = 0 To 3
intIndex = Array.IndexOf(arrVerABC, Mid$(arrAktDataTStone(intSchlTetris), 2)) + ¶
1 '*Neue Zeile ermitteln
'*Höhe temporär speichern
If intSchlTetris = 0 Then
intTempHeight = 19 - intIndex
End If
If intIndex < 18 Then
strIndex = arrAktDataTStone(intSchlTetris).Substring(0, 1) & ¶
arrVerABC(intIndex) '*Neuen Block von Stein
If Me.Controls("Block" & strIndex).BackColor = Color.White Or ¶
arrAktDataTStone.Contains(strIndex) Then '*Überprüfen ob neuer ¶
Platz eingefärbt oder alter Platz überdeckt wird.
arrNextDataTStone(intSchlTetris) = strIndex
Else '*Anderer Stein im Weg
bolExitFor = True
Exit For
End If
Else '*Stein ausserhalb Spielfeld
bolExitFor = True
Exit For
End If
Next
If bolExitFor = True Then '*Keine Bewegung nach unten mehr möglich
intBetart = 3
'*Tempöräre Höhe in fixe Variable speichern
If intTempHeight > intAktHeight Then
intAktHeight = intTempHeight
End If
intTempHeight = GameField(2, Nothing) '*Anzahl der Reihen die abgebaut wurden abrufen
txtReihen.Text = txtReihen.Text + intTempHeight '*Textfeld Reihen updaten
intAktHeight = intAktHeight - intTempHeight
'*Daten an Gegner übergeben
If intTempHeight = 0 Then
intTempHeight = 1
End If
If optSingle.Checked = False Then
Call SQLConnect(1, "st=12&v1=" & intTempHeight - 1 & "&v2=" & ¶
intAktHeight & "&v3=" & cboGameID.SelectedItem & "&v4=" & txtPlayerID.Text)
End If
Exit Sub
End If
'*Position anpassen
arrNextDataTStone(8) = arrNextDataTStone(8) + 1
ElseIf strKey = "a" Then '*Bewegung nach links
For intSchlTetris = 0 To 3
intIndex = arrAktDataTStone(intSchlTetris).Substring(0, 1) - 1
If intIndex >= 0 Then
strIndex = intIndex & arrAktDataTStone(intSchlTetris).Substring(1, 1)
If Me.Controls("Block" & strIndex).BackColor = Color.White Or ¶
arrAktDataTStone.Contains(strIndex) Then '*Überprüfen ob neuer ¶
Platz eingefärbt oder alter Platz überdeckt wird.
arrNextDataTStone(intSchlTetris) = strIndex
Else
Exit Sub
End If
Else
Exit Sub
End If
Next
'*Position nach links anpassen
arrNextDataTStone(7) = arrNextDataTStone(7) - 1
ElseIf strKey = "d" Then '*Bewegung nach rechts
For intSchlTetris = 0 To 3
intIndex = arrAktDataTStone(intSchlTetris).Substring(0, 1) + 1
If intIndex <= 9 Then
strIndex = intIndex & arrAktDataTStone(intSchlTetris).Substring(1, 1)
If Me.Controls("Block" & strIndex).BackColor = Color.White Or ¶
arrAktDataTStone.Contains(strIndex) Then ¶
'*Überprüfen ob neuer Platz eingefärbt oder alter Platz überdeckt wird.
arrNextDataTStone(intSchlTetris) = strIndex
Else
Exit Sub
End If
Else
Exit Sub
End If
Next
'*Position nach links anpassen
arrNextDataTStone(7) = arrNextDataTStone(7) + 1
ElseIf strKey = "w" Then '*Steine Drehen
Dim intArrZähler As Integer = 0
Dim intIndexHor As Integer = 0
'*Drehung anpassen
If arrNextDataTStone(5) < 12 Then
arrNextDataTStone(5) = arrNextDataTStone(5) + 4
arrNextDataTStone(6) = arrNextDataTStone(6) + 4
Else
arrNextDataTStone(5) = 0
arrNextDataTStone(6) = 3
End If
'*Neuen Stein in Array NextData laden.
For intSchlTetris = arrNextDataTStone(5) To arrNextDataTStone(6) ¶
'*Ansprechen der Position im Array für Rotation
For intSchlBit = 1 To 4 '*Auslesen der einzelnen Bits
If Mid$(lstArrTStone(arrAktDataTStone(4))(intSchlTetris), ¶
intSchlBit, 1) = 1 Then
intIndexHor = intSchlBit - 1 + arrNextDataTStone(7)
intIndex = intSchlTetris - arrNextDataTStone(5) + arrNextDataTStone(8)
If intIndexHor >= 0 And intIndexHor <= 9 And intIndex <= 17 Then ¶
'*Prüfen ob drehung im Hor und Vertikalen bereich liegt
strIndex = intIndexHor & arrVerABC(intIndex)
If Me.Controls("Block" & strIndex).BackColor = Color.White Or ¶
arrAktDataTStone.Contains(strIndex) Then '*Überprüfen ob neuer ¶
Platz eingefärbt oder alter Platz überdeckt wird.
arrNextDataTStone(intArrZähler) = strIndex
Else
Array.Copy(arrAktDataTStone, 5, arrNextDataTStone, 5, 2) ¶
'*Drehung wenn nicht möglich Rückgängig machen
Exit Sub
End If
Else
Array.Copy(arrAktDataTStone, 5, arrNextDataTStone, 5, 2) ¶
'*Drehung wenn nicht möglich Rückgängig machen
Exit Sub
End If
intArrZähler = intArrZähler + 1 '* Zähler zum ansprechen von Pos im Ziel Array
End If
Next
Next
End If
'***Steine Bewegen
Array.Copy(arrAktDataTStone, 4, arrNextDataTStone, 4, 1) '*Stein-Typ Kopieren
For intSchlTetris = 0 To 3 '*Alten Stein löschen
Me.Controls("Block" & arrAktDataTStone(intSchlTetris)).BackColor = Color.White
DirectCast(Me.Controls("Block" & arrAktDataTStone(intSchlTetris)), ¶
Panel).BorderStyle = BorderStyle.None
Next
For intSchlTetris = 0 To 3 '*Neuen Einfügen
Me.Controls("Block" & arrNextDataTStone(intSchlTetris)).BackColor = ¶
arrTStoneColor(arrNextDataTStone(4))
DirectCast(Me.Controls("Block" & arrNextDataTStone(intSchlTetris)), ¶
Panel).BorderStyle = BorderStyle.Fixed3D
Next
'*Stein Kopieren
Array.Copy(arrNextDataTStone, arrAktDataTStone, 9)
End If
End Sub
'***Steuerelemente
'***Tasten a,s,d,w betätigen
Private Sub Form1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Me.KeyPress
If e.KeyChar = "a" Or e.KeyChar = "4" Then '*Bewegung links
Call GamePlay("a")
End If
If e.KeyChar = "d" Or e.KeyChar = "6" Then '*Bewegung rechts
Call GamePlay("d")
End If
If e.KeyChar = "w" Or e.KeyChar = "8" Then '*Drehen
Call GamePlay("w")
End If
Do While e.KeyChar = "s" Or e.KeyChar = "5"
Call GamePlay("s")
e.KeyChar = ""
Loop
End Sub
'**Auswahl Spielart
Private Sub optSingle_Click(sender As Object, e As EventArgs) Handles optSingle.Click
Call GamerName() '*Spielernamen löschen
Call GamePoints(0) '*Punkte löschen
Call newTStone() '*Neuen Spielstein laden
Call CheckID(1) '*Singelplayer ID`s anpassen
cmdSteuerung.Enabled = True '*Taster freigeben
End Sub
Private Sub optOpenGame_Click(sender As Object, e As EventArgs) Handles optOpenGame.Click
Call GamerName() '*Spielernamen löschen
Call GamePoints(0) '*Punkte löschen
Call newTStone() '*Neuen Spielstein laden
Call CheckID(2) '*Open Multiplayer ID`s anpassen
Call CheckVersion() '*Version prüfen
End Sub
Private Sub optFindGame_Click(sender As Object, e As EventArgs) Handles optFindGame.Click
Call GamerName() '*Spielernamen löschen
Call GamePoints(0) '*Punkte löschen
Call newTStone() '*Neuen Spielstein laden
Call CheckID(3) '*Find Multiplayer ID`s anpassen
Call CheckVersion() '*Version prüfen
'*Verfügbare Spiele in Dropdown-Menü laden
Dim strGameID As String = 0
Do Until strGameID = ""
strGameID = SQLConnect(2, "st=4&v1=" & strGameID)
If strGameID <> "" Then
cboGameID.Items.Add(strGameID)
cboGameID.SelectedIndex = 0
End If
Loop
If cboGameID.SelectedItem = "" Then
MsgBox("Kein Online-Spiel verfügbar..")
cmdSteuerung.Enabled = False
Else
cboGameID_DropDownClosed(Nothing, Nothing)
End If
End Sub
'*Auswahl GameID
Private Sub cboGameID_DropDownClosed(sender As Object, e As EventArgs) Handles cboGameID.DropDownClosed
If cboGameID.SelectedItem <> "" Then
txtPlayer1Name.Text = SQLConnect(2, "st=2&v1=" & cboGameID.SelectedItem & "&v2=1")
End If
End Sub
'*Start Taster
Private Sub cmdSteuerung_Click(sender As Object, e As EventArgs) Handles cmdSteuerung.Click
If cmdSteuerung.Text.Contains("Start") Then '***Spiel starten
Dim strGamerName As String = InputBox("Bitte geben Sie Ihren Spielernamen ein.")
If strGamerName = txtPlayer1Name.Text Or strGamerName = txtPlayer2Name.Text Then
MsgBox("Spielername wird bereits verwendet, ist ungültig oder Sie haben keinen ¶
Namen eingegeben!" & vbNewLine & "Bitte versuchen Sie es mit einem anderen Namen erneut.")
Exit Sub
End If
If optSingle.Checked = True Or optOpenGame.Checked = True Then
txtPlayer1Name.Text = strGamerName
If optOpenGame.Checked = True Then '*OnlineSpiel anlegen
Dim strIdentValue As String = DateTime.Now.ToString("ddMMyyyyHHmmssfff")
Call SQLConnect(1, "st=8&v1=" & strIdentValue)
cboGameID.Items.Add(SQLConnect(2, "st=5&v1=" & strIdentValue))
cboGameID.SelectedIndex = 0
'*Spieler 1 anlegen
Call SQLConnect(1, "st=9&v1=" & cboGameID.SelectedItem & "&v2=" & ¶
txtPlayerID.Text & "&v3=" & txtPlayer1Name.Text)
'*Spiel in Game_Played anlegen
Call SQLConnect(1, "st=10&v1=" & cboGameID.SelectedItem)
End If
Else
'* Prüfen ob Spiel noch verfügbar und für weiteren Zugriff schließen
If SQLConnect(2, "st=6&v1=" & cboGameID.SelectedItem) = "open" Then
Call SQLConnect(1, "st=11&v1=run&v2=" & cboGameID.SelectedItem)
Else
MsgBox("Da war jemand schneller als Sie. Dieses Spiel ist leider nicht mehr verfügbar.")
optOpenGame.Select()
Exit Sub
End If
'*Spieler 2 anlegen
Call SQLConnect(1, "st=9&v1=" & cboGameID.SelectedItem & "&v2=" & ¶
txtPlayerID.Text & "&v3=" & strGamerName)
txtPlayer2Name.Text = strGamerName
End If
cmdSteuerung.Text = "Spiel Beenden"
Call CheckID(4) '*Optionsfelder sperren da Spiel eröffnet
Call GamePlay(0) '* Spielschleife starten
ElseIf cmdSteuerung.Text.Contains("Spiel Beenden") Or cmdSteuerung.Text.Contains ¶
("GAME OVER / RESET") Then '***Spiel beenden
'*Anderem Spieler das Beenden mitteilen
If cmdSteuerung.Text.Contains("Spiel Beenden") And optSingle.Checked = False Then
Call SQLConnect(1, "st=13&v1=" & cboGameID.SelectedItem & "&v2=" & ¶
txtPlayerID.Text) '*Spiel beenden
'*Wenn im Spiel nur 1 Spieler "Close Game"
If cboGameID.SelectedItem <> "" And txtPlayerID.Text = "1" Then
Call SQLConnect(1, "st=11&v1=abort&v2=" & cboGameID.SelectedItem)
End If
End If
TimerGame.Enabled = False
Call GamePlay(0) '*Spielschleife beenden
optSingle.Select()
cmdSteuerung.Text = "Start"
End If
End Sub
'*Leaderboard öffnen
Private Sub cmdLeaderBoard_Click(sender As Object, e As EventArgs) Handles cmdLeaderBoard.Click
Process.Start("https://ploesch.de/index.php?side=g-gamescore&gameid=1")
End Sub
'***Timer
Private Sub TimerGame_Tick(sender As Object, e As EventArgs) Handles TimerGame.Tick
Call GamePlay(1)
End Sub
'***Meldung bei Eingabeversuch in Textfelder
Private Sub txtPlayer1Name_MouseClick(sender As Object, e As MouseEventArgs) ¶
Handles txtPlayer1Name.MouseClick
If cmdSteuerung.Text.Contains("Start") Then
MsgBox("INFO" & vbNewLine & vbNewLine & "Eingabe es Spielernamen ist ¶
erst nach dem Betätigen des Start-Button möglich." & vbNewLine & ¶
vbNewLine & "Wenn Spielbereit bitte Start-Button betätigen...")
End If
End Sub
Private Sub txtPlayer2Name_MouseClick(sender As Object, e As MouseEventArgs) ¶
Handles txtPlayer2Name.MouseClick
If cmdSteuerung.Text.Contains("Start") Then
MsgBox("INFO" & vbNewLine & vbNewLine & "1. Eingabe es Spielernamen ist ¶
erst nach dem Betätigen des Start-Button möglich." & vbNewLine & "2. Spieler 2 ¶
nur bei Multiplayer-Game verfügbar." _
& vbNewLine & vbNewLine & "Wenn Spielbereit bitte Start-Button betätigen...")
End If
End Sub
End Class
Das Spielt wurde von uns selbst in der Programmiersprache vb.net erstellt und könnt Ihr direkt von unserer Cloud downloaden. Bei Interesse erhaltet Ihr auch auf Anfrage über unserer Kontaktformular den Quelltext zum Spiel.
Vor, während und nach dem Spielen, werden Daten mit unserem Server ausgetauscht. In unserer Datenschutzerklärung erhaltet Ihr hierzu weitere Informationen.