Tetris

Einleitung

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.

Inhaltsverzeichnis

Kurzanleitung

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.

Spielfeld

Tetris VB.net Quellcode

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

Sie haben den Bereich eigene Programme aufgerufen. Hier finden Sie ein paar selbst programmierte Programme. Einige Programme tauschen Daten über das Internet mit einer Datenbank bzw. anderen Rechner aus. Dies ist für den Multiplayer-Modus erforderlich. Aus diesem Grund kann es vorkommen, dass eure Firewall beim Ausführen der Anwendung eine Warnung auf dem Display anzeigt.