Memory

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 Memory als Offline oder Online Multiplayer Game mit bis zu 4 Personen über das Internet. Über „Open Multiplayer-Games“ können Sie ein neues Spiel eröffnen. Ihre Mitspieler können diesem Spiel beitreten. Sobald die eingestellte Anzahl an Mitspieler dem Spiel beigetreten sind, startet das Spiel automatisch. Über die Funktion „Finde Multiplayer Game“ können Sie einem bereits geöffnetem Spiel beitreten. Die einzelnen Karten lassen sich mit der Maus anzeigen, sobald Sie an der Reihe sind.
Verwende den Hilfe-Button im Spiel wenn du Fragen hast, oder schreib uns einfach.

• Detaillierte Anleitung

Spielfeld

Memory 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 VS übernommen werden.
Gerne kann ich euch das Original zukommen lassen. Schreibt mir hierzu einfach über das Kontaktformular.

Imports System.ComponentModel

Public Class Form1
    '***Globale Variablen
    Dim bolBootOK As Boolean = False
    '***Laden der Userform
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
        Call GamerMenue(4, 1)
        Call GameOnline(1)
        Call PboxToPic(1, Nothing, Nothing)
        bolBootOK = True 'Booten abgeschlossen
    End Sub

    '***Funktionen
    '**Groupbox Gamer anpassen
    Function GamerMenue(intNumGamer As Integer, intFunktion As Integer)
        Dim lstGamer() As TextBox = {txtGamer1, txtGamer2, txtGamer3, txtGamer4} ¶
        '*Liste Gamer erstellen
        Dim lstpunkte() As TextBox = {txtPunkte1, txtPunkte2, txtPunkte3, txtPunkte4} ¶
        '*Liste Gamer Punkte erstellen
        Dim intSchl = 0
        If intFunktion = 0 Then '*Menü ohne Reset anpassen
            For intSchl = 0 To intNumGamer - 1 '*Schleife Aktivierung 
                lstGamer(intSchl).Enabled = True
                lstGamer(intSchl).ReadOnly = False
                lstGamer(intSchl).BackColor = Color.White
                lstpunkte(intSchl).Enabled = True
            Next
            intSchl = 0
            For intSchl = intNumGamer To 3 '*Schleife für Deaktivierung
                lstGamer(intSchl).Enabled = False
                lstGamer(intSchl).Text = ""
                lstGamer(intSchl).BackColor = Color.Gainsboro
                lstpunkte(intSchl).Enabled = False
                lstpunkte(intSchl).Text = "0"
            Next
        ElseIf intFunktion = 1 Then '*Reset komplettes Menü
            intSchl = 0
            For intSchl = 0 To 3 '*Schleife für Reset Textfeld komplett
                lstGamer(intSchl).Text = ""
                lstGamer(intSchl).BackColor = Color.White
                lstpunkte(intSchl).Text = "0"
            Next
        ElseIf intFunktion = 2 Then '* Überprüfen ob Spielernamen eingetragen wurden
            intSchl = 0
            Dim intSumPlayer As Integer = 0
            For intSchl = 0 To intNumGamer - 1
                If lstGamer(intSchl).Text <> "" Then
                    intSumPlayer = intSumPlayer + 1
                End If
            Next
            Return intSumPlayer
        ElseIf intFunktion = 3 Then '* Download Spielernamen aus SQL
            intSchl = 0
            Dim strGamerName As String = 0
            Do Until strGamerName = ""
                strGamerName = SQLConnect(2, "st=1&v1=" & cboGameID.SelectedItem & "&v2=" & intSchl + 1)
                If strGamerName <> "" Then
                    lstGamer(intSchl).Text = strGamerName
                End If
                intSchl = intSchl + 1
            Loop
        ElseIf intFunktion = 4 Then '* Setze Readonly
            intSchl = 0
            For intSchl = 0 To 3 '*Schleife für Readonly Textfeld
                If lstGamer(intSchl).Text <> "" Then
                    lstGamer(intSchl).ReadOnly = True
                    lstGamer(intSchl).Enabled = True
                Else
                    lstGamer(intSchl).BackColor = Color.Gainsboro
                End If
            Next
        ElseIf intFunktion = 5 Then '* Textfeld aktiver Player grün färben
            intSchl = 0
            For intSchl = 0 To udGamer.Value - 1 '*Schleife für einfärben Textfeld
                If intSchl + 1 = intNumGamer Then
                    lstGamer(intSchl).BackColor = Color.Green
                Else
                    If lstGamer(intSchl).BackColor <> Color.Red Then ¶
                    '*Nur wenn Spieler nicht Rot (siehe intFunktion=7)
                        lstGamer(intSchl).BackColor = Color.White
                    End If
                End If
            Next
        ElseIf intFunktion = 6 Then '*Punktestand anpassen
            lstpunkte(intNumGamer).Text = lstpunkte(intNumGamer).Text + 1
        ElseIf intFunktion = 7 Then '* Spieler rot einfärben wenn ausgetreten
            lstGamer(intNumGamer).BackColor = Color.Red
        End If
    End Function
    '**Groupbox Konfiguration anpassen
    Sub GameKonfig(intKonfig As Integer)
        '*Updown freigeben und sperren
        If intKonfig = 1 Then
            udCard.Enabled = True
            udGamer.Enabled = True
        ElseIf intKonfig = 2 Then
            udCard.Enabled = False
            udGamer.Enabled = False
        End If
        '*Min Max für Card und Spieler aus Datenbank laden
        If intKonfig = 3 Then
            udCard.Value = SQLConnect(2, "st=2&v1=" & cboGameID.SelectedItem)
            udGamer.Value = SQLConnect(2, "st=3&v1=" & cboGameID.SelectedItem)
        End If
        '*Anzahl Spieler min. begrenzen
        If rcmdOpen.Checked = True Then
            udGamer.Minimum = "2"
        Else
            udGamer.Minimum = "1"
        End If
    End Sub
    '**Groupbox Gameart
    Sub GameArt(bolFunktion As Boolean)
        If bolFunktion = True Then
            rcmdSingle.Enabled = True
            rcmdOpen.Enabled = True
            rcmdFind.Enabled = True
        Else
            rcmdSingle.Enabled = False
            rcmdOpen.Enabled = False
            rcmdFind.Enabled = False
        End If
    End Sub
    '**Groupbox Auswahl OnlineGame anpassen
    Sub GameOnline(intFunktion As Integer)
        If intFunktion = 1 Then
            cboGameID.Enabled = False
            cboGameID.Items.Clear()
            cboGameID.Text = ""
            cboGameID.Items.Add("0")
            cboGameID.SelectedIndex = 0
            txtPlayerID.Text = "0"
        ElseIf intFunktion = 2 Then
            cboGameID.Enabled = False
            cboGameID.Items.Clear()
            cboGameID.Text = ""
            txtPlayerID.Text = ""
        ElseIf intFunktion = 3 Then
            cboGameID.Enabled = True
            cboGameID.Items.Clear()
            cboGameID.Text = ""
            txtPlayerID.Text = ""
        ElseIf intFunktion = 4 Then
            cboGameID.Enabled = False
        End If
    End Sub
    '**Bild zufällig Picturebox zuweisen
    Function RNDPicToPicbox()
        Dim strPicToPicbox As String = "|" 'Speicher für bereits gezogene Zahlen und Speicherstring
        Dim intMaxPic As Integer = udCard.Value / 2 'Maximale Anzahl an Bilder
        Dim intMaxPicbox As Integer = udCard.Value + 1 'Maximale Anzahl an Picboxen
        '*Schleife für Zuweisung Bild zu Picturebox 
        For intSchlPic = 1 To intMaxPic 'Schleife für Zuordnung Bild
            Randomize()
            Dim oZahl As New System.Random 'Variable Erzeugung Zufallszahl
            Dim intPicbox As Integer 'Speichervariabel für zufällige PictureBox
            Dim bolExitZufall As Boolean = False 'Exit Bedingung für neues Bild
            Do
                intPicbox = oZahl.Next(1, intMaxPicbox) ' Zufallszahl im Bereich 1 bis x
                'Prüfen, ob Zufallszahl bereits gezogen
                If Not (strPicToPicbox.Contains("|B" & intPicbox & ":P")) Then
                    strPicToPicbox = strPicToPicbox & "B" & intPicbox & ":P" & intSchlPic & "|"
                    If bolExitZufall = True Then
                        Exit Do
                    End If
                    bolExitZufall = True
                End If
            Loop
        Next intSchlPic
        Return strPicToPicbox
    End Function
    '**PicBox Bilder laden
    Function PboxToPic(intBetart As Integer, intPbox As Integer, strPicboxToPic As String)
        '*Betart 1 = Felder beim Booten anpassen
        Dim intBootPbox As Integer = 0
        If intBetart = 1 Then
            For intBootPbox = 1 To udCard.Value
                DirectCast(Me.Controls("PBox" & intBootPbox.ToString), ¶
                PictureBox).Image = My.Resources._28
                DirectCast(Me.Controls("PBox" & intBootPbox.ToString), ¶
                PictureBox).Enabled = True
            Next
            intBootPbox = 0
            For intBootPbox = udCard.Value + 1 To 54
                DirectCast(Me.Controls("PBox" & intBootPbox.ToString), ¶
                PictureBox).Image = My.Resources._29
                DirectCast(Me.Controls("PBox" & intBootPbox.ToString), ¶
                PictureBox).Enabled = False
            Next
        End If
        '*Betart 2 = String Datenstring in Static Variable speichern.
        Static strPboxToPic As String = ""
        If intBetart = 2 Then
            strPboxToPic = strPicboxToPic
        End If
        '*Betart 3 = Einzelbilder anzeigen und rückmelden
        Dim strpic As String = ""
        If intBetart = 3 Then
            strpic = strPboxToPic.Substring(strPboxToPic.LastIndexOf("|B" & intPbox & ":") + 1) ¶
            'Alles Abschneiden bis Picbox
            strpic = strpic.Substring(0, strpic.IndexOf("|")) 'Alles abscheiden nach |
            strpic = strpic.Substring(strpic.LastIndexOf(":P") + 2)
            '*Bild zuweisen
            DirectCast(Me.Controls("PBox" & intPbox.ToString), PictureBox).Image = ¶
            CType(My.Resources.ResourceManager.GetObject(strpic), Image)
            Return strpic
        End If
        '*Betart 4 = Bilder zudecken bei falscher Auswahl
        If intBetart = 4 Then
            DirectCast(Me.Controls("PBox" & intPbox.ToString), PictureBox).Image = My.Resources._28
        End If
        '*Betart 5 = Bilder zudecken bei richtiger Auswahl
        If intBetart = 5 Then
            DirectCast(Me.Controls("PBox" & intPbox.ToString), PictureBox).Image = My.Resources._29
            DirectCast(Me.Controls("PBox" & intPbox.ToString), PictureBox).Enabled = False
        End If
        '*Betart 6 = Prüfen ob Spiel beendet
        If intBetart = 6 Then
            Dim intPicSchl = 0
            For intPicSchl = 1 To 54
                If DirectCast(Me.Controls("PBox" & intPicSchl.ToString), PictureBox).Enabled = True Then
                    Exit For
                End If
            Next
            Return intPicSchl
        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
                strResult = Replace(strResult, vbLf, "")
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        client.CancelAsync()
        client.Dispose()
        Return strResult
    End Function
    '** SinglePlay
    Sub SinglePlay(intKey As Integer)
        '*Variablen deklarieren
        Static intAktPlayer As Integer = 1
        Static intPBox1 As Integer = 0
        Static intPBox2 As Integer = 0
        Static intPic1 As Integer = 0
        Static intPic2 As Integer = 0
        '* Spielfreigabe
        Static bolGameRun As Boolean = False
        If intKey = 0 And bolGameRun = False Then
            bolGameRun = True
        ElseIf intKey = 0 And bolGameRun = True Then
            '*Spiel beenden und zurücksetzen
            bolGameRun = False
            intPBox1 = 0
            intPBox2 = 0
            intPic1 = 0
            intPic2 = 0
            intAktPlayer = 1
            TWenden.Enabled = False
        End If
        '*Bilder anzeigen
        If intKey > 0 And intKey < 55 And bolGameRun = True Then
            If intPBox1 = 0 And intPBox2 = 0 Then
                intPBox1 = intKey
                intPic1 = PboxToPic(3, intPBox1, Nothing)
            ElseIf intPBox1 <> 0 And intPBox1 <> intKey And intPBox2 = 0 Then
                intPBox2 = intKey
                intPic2 = PboxToPic(3, intPBox2, Nothing)
                '*Wendemodus festlegen
                If chkAutWenden.Checked = True Then
                    TWenden.Enabled = True
                Else
                    cmdWenden.Select()
                End If
            End If
        End If
        '*Ergebnis auswerten
        If intPBox1 <> 0 And intPBox2 <> 0 And intKey = 55 And bolGameRun = True Then
            If intPic1 = intPic2 Then
                Call PboxToPic(5, intPBox1, Nothing)
                Call PboxToPic(5, intPBox2, Nothing)
                Call GamerMenue(intAktPlayer - 1, 6)
            Else
                Call PboxToPic(4, intPBox1, Nothing)
                Call PboxToPic(4, intPBox2, Nothing)
                '*Spieler anpassen
                If intAktPlayer >= udGamer.Value Then
                    intAktPlayer = 1
                Else
                    intAktPlayer = intAktPlayer + 1
                End If
                Call GamerMenue(intAktPlayer, 5) '*Aktuellen Spieler einfärben
                txtStatus.Text = "Spieler " & intAktPlayer & " ist an der Reihe..."
                TWenden.Enabled = False '*Timer Wenden zusätzlich ausschalten
                If chkMsgGamer.Checked = True Then '*Message bei Spielerwechsel
                    MsgBox("Spieler " & intAktPlayer & " ist an der Reihe...",, "Spiel-Info...")
                End If
            End If
            intPBox1 = 0
            intPBox2 = 0
            intPic1 = 0
            intPic2 = 0
            TWenden.Enabled = False
        End If
        '*Game Over überprüfen
        If PboxToPic(6, Nothing, Nothing) > 54 Then
            Dim arrPoint As Integer() = New Integer() {txtPunkte1.Text, txtPunkte2.Text, ¶
            txtPunkte3.Text, txtPunkte4.Text}
            txtStatus.Text = "*** GAME OVER ***" & vbNewLine & ¶
            "Den Gewinner entnehmen Sie bitte der Spieler-Liste..."
            MsgBox("Gewinner ist " &
                   GroupBox2.Controls("txtGamer" & Array.IndexOf(arrPoint, arrPoint.Max) + 1).Text & ¶
                   " mit einer Punktzahl von: " & arrPoint.Max & vbNewLine & vbNewLine & vbNewLine &
                   "Bitte entnehmen Sie die Punkte der restlichen Spieler aus dem Spieler-Menü ¶
                   bevor Sie die Reset-Taste betätigen.",, "Game Over...")
            cmdSteuerung.Text = "#4 Game over, Reset Game..."
        End If
    End Sub
    '** MultiPlayer
    Function MultiPlay(intKey As Integer)
        '*Timer Multi ausschalten
        Static bolTMultiOn As Boolean = False
        TMultiPl.Enabled = False '*Timer aus
        '*Variablen deklarieren
        Static intAktPlayer As Integer = 1
        Static intPBox1 As Integer = 0
        Static intPBox2 As Integer = 0
        Static intPic1 As Integer = 0
        Static intPic2 As Integer = 0
        '*Spielfreigabe
        Static intGameRun As Integer = 0
        If intKey = 0 And intGameRun = 0 Then
            intGameRun = 1
            TMultiPl.Interval = udGamer.Value * 125
            bolTMultiOn = True
        ElseIf intKey = 0 And intGameRun > 0 Then
            '*Spiel beenden JA/Nein?
            If intAktPlayer <> txtPlayerID.Text Or cmdSteuerung.Text.Contains("#6") = True Or ¶
            SQLConnect(2, "st=6&v1=" & cboGameID.SelectedItem) = 1 Then
                Call SQLConnect(1, "st=15&v1=" & cboGameID.SelectedItem & "&v2=" & txtPlayerID.Text)
                intGameRun = 0
                intAktPlayer = 1
                intPBox1 = 0
                intPBox2 = 0
                intPic1 = 0
                intPic2 = 0
                TWenden.Enabled = False
                bolTMultiOn = False
                Return True
                Exit Function
            Else '*Spiel nicht verlassen
                MsgBox("Beenden nicht möglich! Beenden Sie Ihren Zug und versuchen Sie es dann erneut!")
                Return False
                Exit Function
            End If
        End If
        '*Prüfen ob alle erforderlichen Spieler im Game
        If intGameRun = 1 And intKey = 56 Then
            Dim intTempPlSum As Integer = SQLConnect(2, "st=4&v1=" & cboGameID.SelectedItem)
            If intTempPlSum = udGamer.Value Then
                If txtPlayerID.Text = "1" Then '*Spiel für weitere Spieler ausblenden
                    Call SQLConnect(1, "st=16&v1=run&v2=" & cboGameID.SelectedItem)
                End If
                Call GamerMenue(Nothing, 3) '*Spielernamen neu laden
                Call GamerMenue(Nothing, 4) '* Readonly aktivieren
                Call GamerMenue(1, 5) '*Spieler 1 einfärben
                intGameRun = 2 '*Nächster Schritt
                txtStatus.Text = "Online Spiel läuft..."
            Else
                txtStatus.Text = udGamer.Value - (udGamer.Value - intTempPlSum) & " von " & ¶
                udGamer.Value & " Spieler sind dem Spiel beigetreten." & vbNewLine & ¶
                "Spielernamen werden erst geladen wenn Anzahl vollständig ist." & vbNewLine & "Bitte warten..."
            End If
        End If
        '*Überprüfen ob alle Spieler bereit sind Karten anzeigen zu lassen
        If intGameRun = 2 And intKey = 56 Then
            '*Lade Anzahl der Spieler die noch nicht bereit sind
            Dim strPlViewCard As String = SQLConnect(2, "st=5&v1=" & cboGameID.SelectedItem)
            '*Status anpassen
            If strPlViewCard > "0" Then
                txtStatus.Text = strPlViewCard & " Spieler betrachten noch die zuletzt ¶
                aufgedeckten Karten. Bitte warten..."
            End If
            '*Spiel vorbereiten
            If intAktPlayer = txtPlayerID.Text Then
                If strPlViewCard = "0" Then '*Prüfen ob alle Karten gesehen haben
                    Call SQLConnect(1, "st=17&v1=1&v2=0&v3=" & cboGameID.SelectedItem) '*PBox zurücksetzen
                    Call SQLConnect(1, "st=17&v1=2&v2=0&v3=" & cboGameID.SelectedItem) '*PBox zurücksetzen
                    Call SQLConnect(1, "st=18&v1=" & cboGameID.SelectedItem) ¶
                    '*Alle Spieler auf Status 2 setzen die noch im Spiel sind
                    intGameRun = 3 '*Nächster Schritt für aktuellen Spieler
                    bolTMultiOn = False '*Timer für Spieler der Karten auswählen darf deaktivieren
                    txtStatus.Text = "Bitte warten bis Spieler " & intAktPlayer & " ¶
                    die neuen Karten aufgedeckt hat..."
                End If
            Else
                If SQLConnect(2, "st=6&v1=" & cboGameID.SelectedItem) = strPlViewCard Then ¶
                '*für restliche Spieler, prüfen ob alle Karten gesehen haben
                    intGameRun = 3
                    txtStatus.Text = "Bitte warten bis Spieler " & intAktPlayer & " ¶
                    die neuen Karten aufgedeckt hat..."
                End If
            End If
        End If
        '*Karten anzeigen
        If intGameRun = 3 Then
            If txtPlayerID.Text = intAktPlayer And intKey > 0 And intKey < 55 Then ¶
            'Wenn Spieler dieser Konsole an der Reihe ist.
                If intPBox1 = 0 And intPBox2 = 0 Then
                    intPBox1 = intKey
                    intPic1 = PboxToPic(3, intPBox1, Nothing)
                    Call SQLConnect(1, "st=17&v1=1&v2=" & intPBox1 & "&v3=" & cboGameID.SelectedItem)
                ElseIf intPBox1 <> 0 And intPBox1 <> intKey And intPBox2 = 0 Then
                    intPBox2 = intKey
                    intPic2 = PboxToPic(3, intPBox2, Nothing)
                    Call SQLConnect(1, "st=17&v1=2&v2=" & intPBox2 & "&v3=" & cboGameID.SelectedItem)
                    '*Wendemodus festlegen
                    If chkAutWenden.Checked = True Then
                        TWenden.Enabled = True
                    Else
                        cmdWenden.Select()
                    End If
                    intGameRun = 4
                End If
            Else 'Spieler anderer Konsole an der Reihe (View only)
                Dim strTempCard As String = 0
                If intPBox1 = 0 And intPBox2 = 0 Then
                    strTempCard = SQLConnect(2, "st=7&v1=1&v2=" & cboGameID.SelectedItem)
                    If strTempCard <> "" And strTempCard <> "0" Then
                        intPBox1 = strTempCard
                        intPic1 = PboxToPic(3, intPBox1, Nothing)
                    End If
                ElseIf intPBox1 <> 0 And intPBox2 = 0 Then
                    strTempCard = SQLConnect(2, "st=7&v1=2&v2=" & cboGameID.SelectedItem)
                    If strTempCard <> "" And strTempCard <> "0" And strTempCard <> intPBox1 Then
                        intPBox2 = strTempCard
                        intPic2 = PboxToPic(3, intPBox2, Nothing)
                        bolTMultiOn = False '*Timer für Spieler der Karten nur ansehen darf deaktivieren
                        intGameRun = 4
                        '*Wendemodus festlegen
                        If chkAutWenden.Checked = True Then
                            TWenden.Enabled = True
                        Else
                            cmdWenden.Select()
                        End If
                        '*Status anpassen
                        txtStatus.Text = "Spieler " & txtPlayerID.Text & ", ¶
                        bitte Karten nach dem betrachten wenden. Andere Spieler warten aus Sie..."
                    End If
                End If
            End If
        End If
        '*Karten prüfen
        If intGameRun = 4 And intKey = 55 Then
            '*Vergleichen
            If intPic1 = intPic2 Then
                Call PboxToPic(5, intPBox1, Nothing)
                Call PboxToPic(5, intPBox2, Nothing)
                Call GamerMenue(intAktPlayer - 1, 6) '*Punktestand anpassen
            Else
                Call PboxToPic(4, intPBox1, Nothing)
                Call PboxToPic(4, intPBox2, Nothing)
                '*Spieler gegen Datenbank prüfen ob noch aktiv und anpassen
                Dim bolPlayerOk As Boolean = False
                Do While bolPlayerOk = False
                    intAktPlayer = intAktPlayer + 1
                    If intAktPlayer > udGamer.Value Then
                        intAktPlayer = 1
                    End If
                    If SQLConnect(2, "st=8&v1=" & cboGameID.SelectedItem & "&v2=" & intAktPlayer) = 1 Then
                        Exit Do
                        bolPlayerOk = True
                    Else '*Spieler Rot markieren
                        Call GamerMenue(intAktPlayer - 1, 7)
                    End If
                Loop
                Call GamerMenue(intAktPlayer, 5) '*Aktuellen Spieler einfärben
                txtStatus.Text = "Spieler " & intAktPlayer & " ist an der Reihe..."
                TWenden.Enabled = False '*Timer Wenden zusätzlich ausschalten
                If chkMsgGamer.Checked = True Then '*Message bei Spielerwechsel
                    MsgBox("Spieler " & intAktPlayer & " ist an der Reihe...",, "Spiel-Info...")
                End If
            End If
            '*Variablen zurücksetzen
            intPBox1 = 0
            intPBox2 = 0
            intPic1 = 0
            intPic2 = 0
            '*Timer anpassen
            TWenden.Enabled = False
            bolTMultiOn = True
            intGameRun = 5
            '*In DB eintragen das Karten angesehen wurden
            Call SQLConnect(1, "st=19&v1=" & cboGameID.SelectedItem & "&v2=" & txtPlayerID.Text)
        End If
        '*Prüfen ob Spiel vorbei
        If intGameRun = 5 And intKey = 56 Then
            If PboxToPic(6, Nothing, Nothing) > 54 Then
                Dim arrPoint As Integer() = New Integer() {txtPunkte1.Text, txtPunkte2.Text, ¶
                txtPunkte3.Text, txtPunkte4.Text}
                bolTMultiOn = False
                txtStatus.Text = "*** GAME OVER ***" & vbNewLine & ¶
                "Den Gewinner entnehmen Sie bitte der Spieler-Liste..."
                MsgBox("Gewinner ist " &
                       GroupBox2.Controls("txtGamer" & Array.IndexOf(arrPoint, arrPoint.Max) + 1).Text & ¶
                       " mit einer Punktzahl von: " & arrPoint.Max & vbNewLine & vbNewLine & vbNewLine &
                       "Bitte entnehmen Sie die Punkte der restlichen Spieler aus dem Spieler-Menü bevor ¶
                       Sie die Reset-Taste betätigen.",, "Game Over...")
                cmdSteuerung.Text = "#6 Multiplayer Game OVER, Reset Game..."
            Else '*Spiel geht weiter
                intGameRun = 2
            End If
        End If
        '*Timer Multi freigeben
        If bolTMultiOn = True Then
            TMultiPl.Enabled = True
        Else
            TMultiPl.Enabled = False
        End If
    End Function
    '*** Funktion Version Prüfen
    Function 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=9") = 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-memory")
            End If
            Return False
        Else
            Return True
        End If
    End Function

    '***Betätigungsfelder
    '** Auswahl Anzahl Spieler
    Private Sub udGamer_ValueChanged(sender As Object, e As EventArgs) Handles udGamer.ValueChanged
        If rcmdSingle.Checked = True Then '*Nur bei Betriebsart Single-Game Felder anpassen
            Call GamerMenue(udGamer.Value, 0)
        End If
    End Sub
    '** Auswahl Anzahl Spielkarten
    Private Sub udCard_ValueChanged(sender As Object, e As EventArgs) Handles udCard.ValueChanged
        If bolBootOK = True Then
            Call PboxToPic(1, Nothing, Nothing)
        End If
    End Sub
    '** Auswahlfelder Spielart
    Private Sub rcmdSingle_Click(sender As Object, e As EventArgs) Handles rcmdSingle.Click
        Call GameKonfig(1)
        Call GamerMenue(udGamer.Value, 0)
        Call GameOnline(1)
        cmdSteuerung.Enabled = True
        cmdSteuerung.Text = "#1 Spiel starten"
        txtStatus.Text = "Offline-Spiel anlegen. Diese Spielart kann auch ohne Internet gespielt werden."
    End Sub
    Private Sub rcmdOpen_Click(sender As Object, e As EventArgs) Handles rcmdOpen.Click
        If CheckVersion() = True Then '*Auf aktuelle Version prüfen
            Call GameKonfig(1)
            Call GamerMenue(1, 0)
            Call GameOnline(2)
            cmdSteuerung.Enabled = True
            cmdSteuerung.Text = "#2 Multiplayer Game eröffnen"
            txtStatus.Text = "Ein Online Spiel eröffnen und mit anderen Spielern rund um den Globus spielen."
        Else
            rcmdSingle.Select()
        End If
    End Sub
    Private Sub rcmdFind_Click(sender As Object, e As EventArgs) Handles rcmdFind.Click
        If CheckVersion() = True Then '*Auf aktuelle Version prüfen
            txtStatus.Text = "Ein bereits eröffnetes Spiel im Web suchen und dem Spiel beitreten."
            Call GameKonfig(2)
            Call GamerMenue(0, 0)
            Call GameOnline(3)
            cmdSteuerung.Enabled = True
            '*Verfügbare Spiele in Dropdown-Menü laden
            Dim strGameID As String = 0
            Do Until strGameID = ""
                strGameID = SQLConnect(2, "st=10&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
                Exit Sub
            End If
            cmdSteuerung.Text = "#3 Multiplayer Game beitreten"
        Else
            rcmdSingle.Select()
        End If
    End Sub
    '** Auswahl Online Spiel
    Private Sub cboGameID_SelectedIndexChanged(sender As Object, e As EventArgs) ¶
    Handles cboGameID.SelectedIndexChanged
        If bolBootOK = True And rcmdFind.Checked = True Then
            Call GamerMenue(4, 1) '* Spielernamen löschen
            Call GamerMenue(Nothing, 3) '*Spielernamen laden
            Call GameKonfig(3) '*Max Player und Card laden
        End If
    End Sub
    '** Button Steuerung
    Private Sub cmdSteuerung_Click(sender As Object, e As EventArgs) Handles cmdSteuerung.Click
        '*Namensfelder prüfen ob vollständig ausgefüllt
        Dim intSumPlayer As Integer = 0

        If cmdSteuerung.Text.Contains("#1") Then '* Singelplayer
            intSumPlayer = GamerMenue(udGamer.Value, 2)
            If intSumPlayer = udGamer.Value Then
                Call GameKonfig(2) '*Anzahl Spieler und Karten sperren
                Call PboxToPic(2, Nothing, RNDPicToPicbox) '*Zufallskarten übergeben
                Call GamerMenue(Nothing, 4) '* Readonly aktivieren
                cmdSteuerung.Text = "#4 Spiel beenden/abbrechen"
                Call GameArt(False) '*Auswahl Spielart sperren
                Call SinglePlay(0) '*Spiel Singleplayer freigeben
                Call GamerMenue(1, 5) '*Spieler 1 einfärben
            Else
                MsgBox("Bitte Spielername(n) in Spielerliste eintragen...",, "Spieler Menü")
                Exit Sub
            End If

        ElseIf cmdSteuerung.Text.Contains("#2") Then '* Open Game
            intSumPlayer = GamerMenue(1, 2)
            '**Spiel erstellen
            If intSumPlayer = 1 Then
                Dim strPboxPic As String = RNDPicToPicbox()
                Call SQLConnect(1, "st=20&v1=" & strPboxPic & "&v2=" & udGamer.Value & "&v3=" & udCard.Value)
                cboGameID.Items.Add(SQLConnect(2, "st=11&v1=" & strPboxPic))
                cboGameID.SelectedIndex = 0
                '*Player eintragen
                txtPlayerID.Text = "1"
                Call SQLConnect(1, "st=21&v1=" & cboGameID.SelectedItem & "&v2=" & ¶
                txtPlayerID.Text & "&v3=" & txtGamer1.Text)
                Call GamerMenue(Nothing, 4) '* Readonly aktivieren
                Call GameKonfig(2)
                Call PboxToPic(2, Nothing, strPboxPic) '*Zufallskarten übergeben
                cmdSteuerung.Text = "#5 Multiplayer Game beenden/abbrechen"
                Call GameArt(False) '*Auswahl Spielart sperren
                Call MultiPlay(0) '* Funktion Multiplayer aufrufen und starten
            Else
                MsgBox("Bitte Spielername in Spielerliste eintragen...",, "Spieler Menü")
                Exit Sub
            End If

        ElseIf cmdSteuerung.Text.Contains("#3") Then '* Spiel beitreten
            '*Spielername ermitteln
            Dim strAktPlName As String = InputBox("Bitte geben sie Ihren Spielernamen ein.")
            If strAktPlName = "" Then
                MsgBox("Spielername darf nicht leer sein!")
                Exit Sub
            End If
            intSumPlayer = SQLConnect(2, "st=12&v1=" & cboGameID.SelectedItem)
            If udGamer.Value <= intSumPlayer Then
                MsgBox("Maximale Anzahl an Spielern bereits im Spiel. Bitte anderes Spiel wählen")
                Exit Sub
            End If
            If SQLConnect(2, "st=13&v1=" & cboGameID.SelectedItem & "&v2=" & strAktPlName) <> "" Then
                MsgBox("Name bereits im Spiel vorhanden, anderen Namen wählen.")
                Call GamerMenue(4, 1) '* Spielernamen löschen
                Call GamerMenue(Nothing, 3) '*Spielernamen neu laden
                Exit Sub
            Else 'Spielernamen eintragen
                intSumPlayer = intSumPlayer + 1
                Call SQLConnect(1, "st=21&v1=" & cboGameID.SelectedItem & "&v2=" & ¶
                intSumPlayer & "&v3=" & strAktPlName)
                txtPlayerID.Text = intSumPlayer
                Call GamerMenue(4, 1) '* Spielernamen löschen
                Call GamerMenue(Nothing, 3) '*Spielernamen neu laden
                Call GamerMenue(Nothing, 4) '* Readonly aktivieren
                Call GameOnline(4) '*Game_ID sperren
                Call PboxToPic(2, Nothing, SQLConnect(2, "st=14&v1=" & cboGameID.SelectedItem)) ¶
                '*Zufallskarten übergeben
                cmdSteuerung.Text = "#5 Multiplayer Game beenden/abbrechen"
                Call GameArt(False) '*Auswahl Spielart sperren
                Call MultiPlay(0) '* Funktion Multiplayer aufrufen und starten
            End If

        ElseIf cmdSteuerung.Text.Contains("#4") Then '* Spiel Single Player beenden/abbrechen
            Call GameArt(True) '*Spielartwahl freigeben
            Call PboxToPic(1, Nothing, Nothing) '* Bilder zurücksetzen
            Call SinglePlay(0) '*Spiel Singleplayer sperren
            Call GamerMenue(Nothing, 1) '*Gamer leeren
            Call GamerMenue(udGamer.Value, 0) '*Gamer freigeben
            Call GameKonfig(1) '*Anzahl Spieler und Karten freigeben
            cmdSteuerung.Text = "#1 Spiel starten"

        ElseIf cmdSteuerung.Text.Contains("#5") Or cmdSteuerung.Text.Contains("#6") Then ¶
        '* Multiplayer Game beenden/abbrechen
            If MultiPlay(0) = False Then
                Exit Sub
            End If '* Funktion Multiplayer beenden und zurücksetzen
            '*Überprüfen ob letzte Spieler im Spiel
            If SQLConnect(2, "st=6&v1=" & cboGameID.SelectedItem) = 0 Then
                Call SQLConnect(1, "st=16&v1=closed&v2=" & cboGameID.SelectedItem)
                Call SQLConnect(1, "st=22&v1=" & txtGamer1.Text & "&v2=" & txtPunkte1.Text & ¶
                "&v3=" & txtGamer2.Text & "&v4=" & txtPunkte2.Text & "&v5=" & txtGamer3.Text & ¶
                "&v6=" & txtPunkte3.Text & "&v7=" & txtGamer4.Text & "&v8=" & txtPunkte4.Text)
            End If
            Call GameArt(True) '*Spielartwahl freigeben
            Call PboxToPic(1, Nothing, Nothing) '* Bilder zurücksetzen
            Call GamerMenue(Nothing, 1) '*Gamer leeren
            Call GamerMenue(udGamer.Value, 0) '*Gamer freigeben
            Call GameKonfig(1) '*Anzahl Spieler und Karten freigeben
            rcmdSingle.Select()
        End If
    End Sub
    '** Picturebox Klick
    Sub Picturebox_Click(sender As Object, e As EventArgs) Handles PBox1.Click, PBox2.Click, ¶
    PBox3.Click, PBox4.Click, PBox5.Click, PBox6.Click, PBox7.Click, PBox8.Click, PBox9.Click, ¶
    PBox10.Click, PBox11.Click, PBox12.Click, PBox13.Click, PBox14.Click, PBox15.Click, ¶
    PBox16.Click, PBox17.Click, PBox18.Click, PBox19.Click, PBox20.Click, PBox21.Click, ¶
    PBox22.Click, PBox23.Click, PBox24.Click, PBox25.Click, PBox26.Click, PBox27.Click, ¶
    PBox28.Click, PBox29.Click, PBox30.Click, PBox31.Click, PBox32.Click, PBox33.Click, ¶
    PBox34.Click, PBox35.Click, PBox36.Click, PBox37.Click, PBox38.Click, PBox39.Click, ¶
    PBox40.Click, PBox41.Click, PBox42.Click, PBox43.Click, PBox44.Click, PBox45.Click, ¶
    PBox46.Click, PBox47.Click, PBox48.Click, PBox49.Click, PBox50.Click, PBox51.Click, ¶
    PBox52.Click, PBox53.Click, PBox54.Click
        Dim intNumPbox As String = sender.Name.Replace("PBox", "")
        If rcmdSingle.Checked = True Then
            Call SinglePlay(intNumPbox)
        Else
            Call MultiPlay(intNumPbox)
        End If
    End Sub
    '** HelpButton Klick
    Private Sub cmdHelp_Click(sender As Object, e As EventArgs) Handles cmdHelp.Click
        If HelpBrowser.Visible = True Then
            HelpBrowser.Visible = False
        Else
            HelpBrowser.Visible = True
            HelpBrowser.Navigate(Application.StartupPath & "\help.pdf")
        End If
    End Sub

    '*** Karten wenden
    '** Checkbox Karten wenden
    Private Sub chkAutWenden_CheckedChanged(sender As Object, e As EventArgs) ¶
    Handles chkAutWenden.CheckedChanged
        If chkAutWenden.Checked = True Then
            cmdWenden.Visible = False
            udWenden.Enabled = True
        Else
            cmdWenden.Visible = True
            udWenden.Enabled = False
        End If
    End Sub
    '** Vorgabe Timer Wenden
    Private Sub udWenden_ValueChanged(sender As Object, e As EventArgs) Handles udWenden.ValueChanged
        TWenden.Interval = udWenden.Value * 1000
    End Sub
    '**Taster Manuel wenden
    Private Sub cmdWenden_Click(sender As Object, e As EventArgs) Handles cmdWenden.Click
        If rcmdSingle.Checked = True Then
            Call SinglePlay(55)
        Else
            Call MultiPlay(55)
        End If
    End Sub
    '**Timer Auto wenden
    Private Sub TWenden_Tick(sender As Object, e As EventArgs) Handles TWenden.Tick
        If rcmdSingle.Checked = True Then
            Call SinglePlay(55)
        Else
            Call MultiPlay(55)
        End If
    End Sub
    '**Timer Multiplayer 
    Private Sub TMultiPl_Tick(sender As Object, e As EventArgs) Handles TMultiPl.Tick
        Call MultiPlay(56)
    End Sub

    '** Form beenden, erst wenn Online-Spiel beendet
    Private Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
        If cmdSteuerung.Text.Contains("#5") Or cmdSteuerung.Text.Contains("#6") Then
            MsgBox("Beenden Sie Bitte erst das geöffnete Spiel." & vbNewLine & vbNewLine & ¶
            "Multiplayer Spiele können von den anderen User durch das unsachgemäße Beenden ¶
            evtl nicht zu Ende gespielt werden." & vbNewLine & vbNewLine & "Danke...")
            e.Cancel = True
        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.