
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 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.
(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 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
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.