Titel: MBSimonChallenge v1.02
Autor: Manfred Becker
E-Mail: mani.becker@web.de
Url: http://manib.ma.funpic.de
Umgebung: Win95/98/NT/2000/XP
Schlagworte: Basic
Stufe: Fortgeschrittene
Beschreibung: Eine Emulation des Spiels MB Simon Challenge
Sektion: BASIC
UnterSektion: VisualBasic
Dieser Artikel beschreibt die Umsetzung des Spiels MB Simon Challenge. Ich habe es programmiert, damit ich beim Spiel gegen meinen Neffen hoffentlich auch einmal gewinne.
Dieses Programm ist die Weiterentwicklung der Version 1.01. Neu dazugekommen sind:
Simon Challenge ist ein elektronisches Spielzeug, das schnelle Reaktionsfähigkeit fordert! Per Sprachchip ruft es Spielkommandos aus, die so rasch wie möglich befolgt werden müssen – und das mit immer steigendem Tempo! Ob allein, zu zweit oder in einer Gruppe sorgt Simon Challenge für dynamischen Spielspaß und ist stets eine Herausforderung!
Aber wer ist eigentlich dieser Simon? Er ist nicht der Erfinder. Simon ist der Namensgeber eines amerikanischen Kinderspieles, dessen kompletter Name "Simon says ..." lautet. Einer in der Gruppe ist "Simon" und ruft den anderen Kommandos zu, etwa "Spring auf" oder "Berühr' Deine Zehen". Diese müssen sofort befolgt werden – aber nur, wenn sie mit der Formel "Simon sagt ..." beginnen. Wer bei einem simplen „Spring“ aufspringt, ist "raus", genauso wie der, der das "Simon sagt ..."-Kommando nicht befolgt. Es gilt also, genau zuzuhören, was da an Befehlen gegeben wird ... Das klingt einigermaßen vertraut – etwas ähnliches gibt es im deutschen Sprachraum als "Alle Vögel fliegen hoch ..." Aber daraus wurde nicht, wie aus "Simon", ein elektronisches Spiel – und zwar schon 1978!
Damals in kam in den USA ein rundes, schwarzes Ding aus Plastik auf den Markt, das man auf den Tisch stellen konnte. Es hatte vier verschiedenfarbige Leuchttasten und stieß Töne aus. Diese vorgegebenen Kombinationen mussten die dann Spieler fehlerfrei nachahmen. Dieses Spiel hieß "Simon" und war das erste elektronische Spiel, das einen sensationellen Erfolg verbuchen konnte und zum Kultobjekt wurde. Das klingt einigermaßen vertraut – im deutschen Sprachraum hieß das Gerät allerdings "Senso", denn einen Simon kannte man hier noch nicht ...
Doch das ändert sich jetzt mit Simon Challenge! Denn diese neue Variante fordert
vom Spieler mehr als Knöpfe zu drücken – hier ist echte Agilität gefragt. Auf fünf
verschiedene Kommandos hin müssen Knöpfe gedrückt, Räder gedreht und Schalter angetippt
werden, alles untermalt von Musik. Langzeitspaß bieten hierbei der vielfältig einstellbare
Schwierigkeitsgrad und die wechselnde Anzahl an Personen, mit denen man gemeinsam
spielen kann: in einer Spielvariante die auf Runden basiert, gibt man das Gerät
reihum immer weiter.
Die Kommandos lauten: “Drehen“: Den gelben Knopf drehen - “Tippen“: Den grünen Schalter
antippen - “Klopfen“: Auf den großen Knopf in der Mitte klopfen - “Ziehen“: Am blauen
Knauf ziehen - “Rollen“: Das orangefarbene Zahnrad rollen.
Hat man richtig reagiert, kommt rasch ein weiterer Befehl hinterher. Die Geschwindigkeit
steigt dabei immer weiter, sodass es stets schwieriger wird, zur rechten Zeit das
Richtige zu tun. Irrt man sich, gibt es einen Alarmton und das Spiel endet. Um das
alles noch eine Stufe schwieriger zu gestalten, kann man auch im Sound-Modus spielen.
Dabei werden keine Kommandos erteilt, sondern es wird lediglich ein Geräusch eingespielt,
etwa ein Heulton für den Befehl Rollen.
- "Solo": Ein Spieler spielt alleine gegen den Highscore
- "Kopf an Kopf": Die einzelnen Kommandos werden jeweils einem von zwei Spielern
zugeteilt, sodass jeder Spieler für 2 Anweisungen zuständig ist. Kommt der Befehl
zum Klopfen, geht es darum, welcher der beiden Spieler schneller reagiert und den
mittleren Knopf betätigt.
- "Weitergeben": In diesem Modus können mehrere Spieler ihre Reaktion unter Beweis
stellen. Wer einen Fehler macht, scheidet aus. Beim Kommando „weitergeben“, wird
Simon Challenge an den nächsten Spieler weitergegeben. Gespielt wird, bis nur noch
ein Spieler übrig bleibt.
Alle drei Spielarten die Simon Challenge bietet, können sowohl im Sprach- als auch im Sound-Modus gespielt werden. Simon Challenge besitzt einen Lautstärkeregler und einen Kopfhörerausgang: so kann kann man still für sich spielen oder das Gerät für den großen Partyspaß an die Stereoanlage anschließen. Zum Betrieb sind 3 LR6 Batterien erforderlich.
Bei dieser Emulation werden nun alle drei Spielvarianten emuliert! Allerdings bleibt es euch frei, Verbesserungen oder Erweiterungen daran vorzunehmen. Mit diesem VisualBasic 6 Programmsource sollte das für euch ja kein Problem sein.
Die Umsetzung für die Spielvariante "Solo" gestaltet sich eigentlich recht einfach. Man benötigt das Hintergrundbild und jeweils einen Bereich für die Aktionsschalter. Dafür kann man jeweils ein Image verwenden, denn ein Image ist unsichtbar, kann aber auf einen Maus-Klick reagieren.
Dann lassen wir uns einen zufälligen Wert für das nächste Kommando ermitteln, und machen die jeweilige Sprachausgabe. Eine eigene Klasse für die WavFile-Anbindung macht die Sprachausgabe sehr einfach. Gleichzeitig starten wir einen Timer, der kontrolliert, ob die Timeout-Zeit schon abgelaufen ist.
Nun muss der Spieler einen der Aktionsschalter anklicken. Dabei prüfen wir, ob der jeweils richtige betätigt wurde. Falls ja, dann kommt das nächste Kommando. Falls nein, dann hat der Spieler verloren.
Verloren ist das Spiel auch dann, wenn es der Spieler nicht schafft innerhalb der Timeoutzeit einen Schalter zu betätigen. Das ist anfangs sehr einfach, wird aber mit der Zeit immer schwieriger, da sich die Timeoutzeit kontinuierlich verkürzt.
Hier spielen beliebig viele Spieler nach den gleichen Regeln wie bei der Spielvariante "Solo". Es gibt aber das zusätzliche Kommando "Weitergeben", welches angibt, dass ein Spielerwechsel vollzogen werden muss.
Macht ein Spieler einen Fehler, dann darf er nicht mehr weiterspielen. Gewonnen hat derjenige Spieler, welcher am Ende als Einziger übrig bleibt.
Da hier zwei Spieler beteiligt sind, die gegeneinander spielen, benötigen wir eine weitere Punkteanzeige. Die Eingaben erfolgen hier über die Tastatur. Die Maus wird bei dieser Spielvariante deaktiviert.
Beim Kommando "Klopfen" kommt es darauf an, welcher Spieler zuerst die jeweilige Taste betätigt. Der Schnellere erhält einen Punkt. Derjenige Spieler, welcher zuerst drei Punkte hat, ist der Gewinner.
Es gibt auch noch eine Info-Seite, die dem Spieler die Spielregeln aufzeigt. Diese Spielregeln befinden sich in dem Textfile MBSimonChallenge.txt, welches vor der Anzeige der Form geladen wird.
Mit dieser Version wurde auch eine Highscore Seite eingebunden. Die Liste der Namen wird dabei dynamisch aufgebaut. Bis zu zehn Einträge werden angezeigt, und in einer Textdatei (CSV-File) gespeichert.
Zunächst setzen wir alle notwendigen Objekte auf unsere Form:
 |
|
Als erstes definieren wir ein paar notwendige Variable:
'///////////////////////////////////////////////////////////////////////////
'//
'// Projekt : MBSimonChallenge
'// Sprache : Basic
'// Compiler: MS Visual Basic 6.0
'// Autor : Manfred Becker
'// E-Mail : mani.becker@web.de
'// Url : http://manib.ma.funpic.de
'// Modul : frmMain
'// Version : 1.02
'// Datum : 27.01.2008
'//
'///////////////////////////////////////////////////////////////////////////
Option Explicit
'Einstellung Spielvariante: "Solo", "Kopf an Kopf" oder "Weitergeben"
Private Enum GamePlayMode
gcSolo = 0
gcHeadToHead = 1
gcGiveToNext = 2
End Enum
'Einstellung der Lautstärke: "Leise", "Mittel" oder "Laut"
Private Enum GameVolume
gcVolSilent = 0
gcVolMedium = 1
gcVolLoud = 2
End Enum
'Einstellung Spielmodus: "Sound-Modus" oder "Voice-Modus"
Private Enum GameSoundMode
gcVoiceMode = 0 'Sprachausgabe
gcSoundMode = 1 'Soundausgabe
gcSilentMode = 2 'ohne jegliche Sprach- oder Soundausgabe (nur am PC)
End Enum
'Aufzählungstyp aller Kommandos
Private Enum GameCommands
gcKnock = 0
gcRoll = 1
gcType = 2
gcRotate = 3
gcPull = 4
gcNext = 5
End Enum
'Aufzählungstyp aller Spielzustände
Private Enum GameConditions
gcInitial = 0
gcRunning = 1
gcLost = 2
gcSetupPlayMode = 3
gcSetupVolume = 4
gcSetupSoundMode = 5
End Enum
'Aufzählungstyp aller Spieler
Private Enum Player
gcNoPlayer = 0
gcPlayer1 = 1
gcPlayer2 = 2
End Enum
'Datentyp zur Definition eines Rechtecks
Private Type Rect
Left As Long
Top As Long
Width As Long
Height As Long
End Type
'Lokale Variable
Private m_WavFile As clsWavFile
Private m_GamePlayMode As GamePlayMode
Private m_GameVolume As GameVolume
Private m_GameSoundMode As GameSoundMode
Private m_GameCondition As GameConditions
Private m_GameCommand As GameCommands
Private m_GameCommandOld As GameCommands
Private m_GameCommandMax As Integer
Private m_GameCommands(6) As String
Private m_GameTimeout As Long
Private m_GameTimeoutMax As Long
Private m_GameTimeoutStart As Long
Private m_GameLevel As Integer
Private m_GameScore1 As Long
Private m_GameScore2 As Long
Private m_GameHighScore As Long
Private m_GameName As String
Private m_GameCopyright As String
'Private m_GameUseSound As Boolean 'Das wird jetzt von der Klasse clsWavFile übernommen
Private m_GameSoundModes(3) As String
Private m_GamePlayModes(3) As String
Private m_GameVolumes(3) As String
Private m_GameVolumeValues(3) As Long
Private m_GameKeyDownPlayer As Player
Private m_GameCounter As Integer
'Lokale Variable für die Koordinaten aller Images
Private m_Background As Rect
Private m_Knock As Rect
Private m_Type As Rect
Private m_Pull As Rect
Private m_Roll As Rect
Private m_Rotate As Rect
Private m_Form As Rect
Nun kümmern wir uns um die Initialisierung der Objekte. Dafür ist die Load-Funktion bestens geeignet, denn sie wird beim Programmstart einmalig aufgerufen. Hier wird auch unser WavFile Objekt erzeugt:
Private Sub Form_Load()
'Formular zentrieren
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
'Variable initialisieren
Randomize Timer
m_GameName = "MB Simon Challenge v1.02"
m_GameCopyright = m_GameName & " (c) 26.01.2008 by Manfred Becker"
m_GamePlayMode = gcSolo
m_GameCommandMax = 5
m_GameVolume = gcVolMedium
m_GameSoundMode = gcVoiceMode
m_GameCondition = gcInitial
m_GameCommands(0) = "Klopfen"
m_GameCommands(1) = "Rollen"
m_GameCommands(2) = "Tippen"
m_GameCommands(3) = "Drehen"
m_GameCommands(4) = "Ziehen"
m_GameCommands(5) = "Weitergeben"
m_GameSoundModes(0) = "Voice"
m_GameSoundModes(1) = "Sound"
m_GameSoundModes(2) = "Silent"
m_GamePlayModes(0) = "Solo"
m_GamePlayModes(1) = "Kopf an Kopf"
m_GamePlayModes(2) = "Weitergeben"
m_GameVolumes(0) = "leise"
m_GameVolumes(1) = "mittel"
m_GameVolumes(2) = "laut"
m_GameVolumeValues(0) = &H27EF26B0 'leise
m_GameVolumeValues(1) = &H80007C00 'mittel
m_GameVolumeValues(2) = &HFFFFF800 'laut
m_GameTimeoutMax = 2000
m_GameHighScore = 0
'wir sichern uns die original Positionsdaten der Images.
'Diese werden später bei der Positionsberechnung benötigt.
m_Background.Left = imgBackground.Left
m_Background.Top = imgBackground.Top
m_Background.Width = imgBackground.Width
m_Background.Height = imgBackground.Height
m_Knock.Left = imgKnock.Left
m_Knock.Top = imgKnock.Top
m_Knock.Width = imgKnock.Width
m_Knock.Height = imgKnock.Height
m_Type.Left = imgType.Left
m_Type.Top = imgType.Top
m_Type.Width = imgType.Width
m_Type.Height = imgType.Height
m_Pull.Left = imgPull.Left
m_Pull.Top = imgPull.Top
m_Pull.Width = imgPull.Width
m_Pull.Height = imgPull.Height
m_Roll.Left = imgRoll.Left
m_Roll.Top = imgRoll.Top
m_Roll.Width = imgRoll.Width
m_Roll.Height = imgRoll.Height
m_Rotate.Left = imgRotate.Left
m_Rotate.Top = imgRotate.Top
m_Rotate.Width = imgRotate.Width
m_Rotate.Height = imgRotate.Height
'Ein paar ToolTip-Hinweise können nie schaden
imgKnock.ToolTipText = "Klopfen! (Spielstart)"
imgPull.ToolTipText = "Ziehen! (Spielvariante einstellen)"
imgRoll.ToolTipText = "Rollen! (Lautstärke einstellen)"
imgRotate.ToolTipText = "Drehen! (Highscore anzeigen)"
imgType.ToolTipText = "Tippen! (Spielmodus einstellen)"
'WavFile Objekt erzeugen
'Das Objekt erkennt nun automatisch, ob eine Soundkarte installiert ist
Set m_WavFile = New clsWavFile
'testen, ob Soundkarte installiert ist
'm_GameUseSound = m_WavFile.TestSoundkarte
'Lautstärke einstellen
Call m_WavFile.SetWaveVolume(m_GameVolumeValues(m_GameVolume))
Call m_WavFile.SetMidiVolume(m_GameVolumeValues(m_GameVolume))
'Copyright-Meldung ausgeben
Me.Caption = m_GameCopyright
Me.KeyPreview = True
'Spiel initialisieren
Call GameLost("")
End Sub
Funktion für Programmende. Hier muss unser WavFile Objekt wieder gelöscht werden:
Private Sub Form_Unload(Cancel As Integer)
'Sprachausgabe bei Programmende
If m_GameSoundMode <> gcSilentMode Then
Call m_WavFile.SndPlaySound("MBSimonChallenge.Aus.wav", SND_SYNC)
End If
'WavFile Objekt löschen
Set m_WavFile = Nothing
End Sub
Funktion für Anpassung bei Grössenänderung:
Private Sub Form_Resize()
Dim BorderTop As Long, BorderWidth As Long
Dim fx As Single, fy As Single
If Me.WindowState = vbMinimized Then Exit Sub
'Prüfe die Mindest-Breite
If Me.Width < 4000 Then Me.Width = 4000
'Prüfe die Mindest-Höhe
If Me.Height < 4000 Then Me.Height = 4000
'Prüfe, ob sich die Größe verändert hat
If m_Form.Width = Me.Width And m_Form.Height = Me.Height Then Exit Sub
'Neue Größe sichern
m_Form.Width = Me.Width
m_Form.Height = Me.Height
'Hintergrund-Image ausblenden
imgBackground.Visible = False
'Positioniere alle Labels und Images
lblCaption.Width = Me.Width - 420
imgBackground.Width = Me.Width - 420
imgBackground.Height = Me.Height - 2000
BorderTop = imgBackground.Top + imgBackground.Height + 120
BorderWidth = imgBackground.Width - 2400
lblScore1.Top = BorderTop + 60
lblScore2.Top = BorderTop + 60
shpCountdownBorder.Top = BorderTop
shpCountdownBorder.Width = BorderWidth
shpCountdownValue.Top = BorderTop + 60
shpCountdownValue.Width = BorderWidth - 120
lblScore2.Left = imgBackground.Left + imgBackground.Width - lblScore2.Width
lblHint.Width = Me.Width - 480
lblHint.Top = BorderTop + shpCountdownBorder.Height + 120
lblInfo.Left = imgBackground.Left + imgBackground.Width - lblInfo.Width
'X- und Y-Faktor zur Positionsberechnung der Images
fx = imgBackground.Width / m_Background.Width
fy = imgBackground.Height / m_Background.Height
'Positionsberechnung der Images
imgKnock.Left = imgBackground.Left + (m_Knock.Left - m_Background.Left) * fx
imgKnock.Top = imgBackground.Top + (m_Knock.Top - m_Background.Top) * fy
imgKnock.Width = m_Knock.Width * fx
imgKnock.Height = m_Knock.Height * fy
imgType.Left = imgBackground.Left + (m_Type.Left - m_Background.Left) * fx
imgType.Top = imgBackground.Top + (m_Type.Top - m_Background.Top) * fy
imgType.Width = m_Type.Width * fx
imgType.Height = m_Type.Height * fy
imgPull.Left = imgBackground.Left + (m_Pull.Left - m_Background.Left) * fx
imgPull.Top = imgBackground.Top + (m_Pull.Top - m_Background.Top) * fy
imgPull.Width = m_Pull.Width * fx
imgPull.Height = m_Pull.Height * fy
imgRoll.Left = imgBackground.Left + (m_Roll.Left - m_Background.Left) * fx
imgRoll.Top = imgBackground.Top + (m_Roll.Top - m_Background.Top) * fy
imgRoll.Width = m_Roll.Width * fx
imgRoll.Height = m_Roll.Height * fy
imgRotate.Left = imgBackground.Left + (m_Rotate.Left - m_Background.Left) * fx
imgRotate.Top = imgBackground.Top + (m_Rotate.Top - m_Background.Top) * fy
imgRotate.Width = m_Rotate.Width * fx
imgRotate.Height = m_Rotate.Height * fy
'Hintergrund-Image einblenden
imgBackground.Visible = True
End Sub
Funktion zum Starten des Spiels:
Private Sub GameStart()
'Midifile als Hintergrunfmusik abspielen
If chkPlayMidi.Value = vbChecked Then
Call m_WavFile.PlayMidi("MBSimonChallenge.Midifile.2.mid")
End If
lblHint.Caption = "Spiel """ & m_GamePlayModes(m_GamePlayMode) & """ wurde gestartet..."
m_GameCondition = gcRunning
m_GameCounter = -1 'wir beginnen bei -1, weil durch GameNextCommand der Wert hochgezählt wird
m_GameScore1 = -1 'wir beginnen bei -1, weil durch GameNextCommand der Wert hochgezählt wird
m_GameScore2 = -1 'wir beginnen bei -1, weil durch GameNextCommand der Wert hochgezählt wird
m_GameLevel = -1 'wir beginnen bei -1, weil durch GameNextCommand der Wert hochgezählt wird
m_GameKeyDownPlayer = gcNoPlayer
Call GameNextCommand 'nächstes Kommando ausgeben
TimerCountdown.Enabled = True 'Countdown-Timer starten
End Sub
Funktion für Spielende:
Private Sub GameLost(Reason As String, Optional Loser As Player)
'Sprachausgabe für Spielende
If m_GameSoundMode <> gcSilentMode And Reason <> "" Then
Call m_WavFile.SndPlaySound("MBSimonChallenge.Waah.wav", SND_SYNC)
End If
TimerCountdown.Enabled = False 'Countdown-Timer stoppen
m_GameCondition = gcLost
'Um welche Spielvariante handelt es sich?
If m_GamePlayMode = gcHeadToHead Then
'Spielvariante "Kopf an Kopf", Hinweis und Punktestand ausgeben
Select Case Loser
Case gcPlayer1
'Spieler 1 hat einen Fehler gemacht!
lblHint.Caption = "Spieler 2 hat gewonnen!"
Case gcPlayer2
'Spieler 2 hat einen Fehler gemacht!
lblHint.Caption = "Spieler 1 hat gewonnen!"
Case Else
'Timeout
If m_GameCommand = gcType Or m_GameCommand = gcRoll Then
'Spieler 1 hat sein Kommando nicht befolgt
lblHint.Caption = "Spieler 2 hat gewonnen!"
ElseIf m_GameCommand = gcPull Or m_GameCommand = gcRotate Then
'Spieler 2 hat sein Kommando nicht befolgt
lblHint.Caption = "Spieler 1 hat gewonnen!"
Else
'Keider der beiden Spieler hat geklopft
If m_GameScore1 > m_GameScore2 Then
lblHint.Caption = "Spieler 1 hat gewonnen!"
ElseIf m_GameScore1 < m_GameScore2 Then
lblHint.Caption = "Spieler 2 hat gewonnen!"
Else
lblHint.Caption = "Unentschieden!"
End If
End If
End Select
lblHint.Caption = lblHint.Caption & " " & _
"Das Komando war " & m_GameCommands(m_GameCommand) & "! " & _
Reason & " " & _
"Der Punktestand = " & Str(m_GameScore1) & " :" & Str(m_GameScore2)
Else
'Spielvariante: "Solo" und "Weitergeben", Hinweis und Punktestand ausgeben
lblHint.Caption = "Spiel ist beendet! " & _
"Das Komando war " & m_GameCommands(m_GameCommand) & "! " & _
Reason & " " & _
"Der Punktestand = " & Str(m_GameScore1)
If m_GameScore1 > 0 Then
'falls Highscore erreicht, dann Highscore-Wert sichern und ausgeben
If m_GameHighScore < m_GameScore1 Then
m_GameHighScore = m_GameScore1
lblHint.Caption = lblHint.Caption & _
" (Highscore!)"
End If
Call GameSetHighScore(m_GameScore1)
End If
End If
'Hinweis für Programmstart
lblCaption.Caption = "Zum Start: Klopfen!"
'Midifile als Hintergrunfmusik abspielen
If chkPlayMidi.Value = vbChecked Then
Call m_WavFile.PlayMidi("MBSimonChallenge.Midifile.1.mid")
End If
End Sub
Funktion zum Setzen des nächsten Kommandos:
Private Sub GameNextCommand()
m_GameCommandOld = m_GameCommand
If m_GameCommand <> gcNext Then
'Zählerstand erhöhen
m_GameCounter = m_GameCounter + 1
'jedes mal, wenn 16 Punkte dazugekommen sind, wird das Level erhöht,
'und damit die Timeout-Zeit verkürzt!
If m_GameCounter Mod 16 = 0 Then
m_GameLevel = m_GameLevel + 1
m_GameTimeoutStart = m_GameTimeoutMax - m_GameLevel * (m_GameTimeoutMax / 10)
End If
'Um welche Spielvariante handelt es sich?
If m_GamePlayMode = gcHeadToHead Then
'Spielvariante "Kopf an Kopf"
If m_GameKeyDownPlayer = gcNoPlayer Then
'Spielstart, Punkte zurücksetzen
m_GameScore1 = 0
m_GameScore2 = 0
lblScore1.Caption = m_GameScore1
lblScore2.Caption = m_GameScore2
Else
'den Punk macht derjenige Spieler, welcher zuerst geklopft hat.
'Hat ein Spieler 5 Punkte gesammelt, ist er der Gewinner.
If m_GameCommand = gcKnock Then
'Punkte erhöhen und anzeigen
If m_GameKeyDownPlayer = gcPlayer1 Then
m_GameScore1 = m_GameScore1 + 1
lblScore1.Caption = m_GameScore1
If m_GameScore1 = 5 Then
Call GameWinner(gcPlayer1)
Exit Sub
End If
ElseIf m_GameKeyDownPlayer = gcPlayer2 Then
m_GameScore2 = m_GameScore2 + 1
lblScore2.Caption = m_GameScore2
If m_GameScore1 = 5 Then
Call GameWinner(gcPlayer2)
Exit Sub
End If
End If
End If
End If
Else
'Spielvariante "Solo" oder "Weitergeben"
'Punkte erhöhen und anzeigen
m_GameScore1 = m_GameCounter
lblScore1.Caption = m_GameScore1
End If
End If
'Spieler zurücksetzen
m_GameKeyDownPlayer = gcNoPlayer
'Timeoutzeit zurückstellen
m_GameTimeout = m_GameTimeoutStart
'Für die Ermittlung des nächsten Kommandos, benötigen wir einen Zufallswert
'von 0 bis 4 bzw. 0 bis 5 (je nach Spielvariante)
Do
m_GameCommand = Int(Rnd * m_GameCommandMax)
'Wir verhindern, daßs das Kommando gcNext zweimal direkt hintereinander kommt!
Loop While (m_GameCommandOld = gcNext And m_GameCommand = gcNext)
'nächstes Kommando anzeigen
lblCaption.Caption = m_GameCommands(m_GameCommand) & "!"
'Sprachausgabe des Kommandos
If m_GameSoundMode <> gcSilentMode Then
Call m_WavFile.Play("MBSimonChallenge." & m_GameCommands(m_GameCommand) & "." & m_GameSoundModes(m_GameSoundMode) & ".wav")
End If
End Sub
Funktion für Spielende bei Spielvariante "Kopf an Kopf":
Private Sub GameWinner(winner As Player)
Dim strHint As String
If winner = gcPlayer1 Then
strHint = "Spieler 1 hat gewonnen!"
Else
strHint = "Spieler 2 hat gewonnen!"
End If
'Sprachausgabe für Spielende
If m_GameSoundMode <> gcSilentMode Then
Call m_WavFile.Play("MBSimonChallenge.HighScore.wav")
End If
TimerCountdown.Enabled = False 'Countdown-Timer stoppen
m_GameCondition = gcLost
'Hinweis und Punktestand ausgeben
lblHint.Caption = strHint & " " & _
"Der Punktestand = " & Str(m_GameScore1) & " :" & Str(m_GameScore2)
'Hinweis für Programmstart
lblCaption.Caption = "Zum Start: Klopfen!"
End Sub
Funktion zum Anzeigen der HighScore:
Private Sub GameShowHighScore()
Dim bFileExist As Boolean
bFileExist = frmHighScore.SetHighScoreFilename("MBSimonChallenge.HighScore.csv", m_GameName & " - HighScore")
If bFileExist Then
frmHighScore.TimerAutoUnload.Enabled = True
Call frmHighScore.Show(vbModal)
End If
m_GameHighScore = frmHighScore.GetHighScore
End Sub
Funktion zum Setzen einer neuen HighScore:
Private Sub GameSetHighScore(Score As Long)
'die Funktion CheckHighScore() gibt zurück, ob ein neuer HighScore erreicht wurde
If frmHighScore.CheckHighScore(Score) Then
'Sprachausgabe für neuen Highscore
If m_GameSoundMode <> gcSilentMode Then
Call m_WavFile.Play("MBSimonChallenge.HighScore.wav")
End If
Call frmHighScore.SetHighScoreFilename("MBSimonChallenge.HighScore.csv", m_GameName & " - HighScore")
Call frmHighScore.SetHighScore(Score)
Call frmHighScore.Show(vbModal)
'eigene HighScore aktualisieren
m_GameHighScore = frmHighScore.GetHighScore
End If
End Sub
Funktion zum Starten und Stoppen der Hintergrundmusik (Midi-File)
Private Sub chkPlayMidi_Click()
If chkPlayMidi.Value = vbChecked Then
If m_GameCondition <> gcRunning Then
Call m_WavFile.PlayMidi("MBSimonChallenge.Midifile.1.mid")
Else
Call m_WavFile.PlayMidi("MBSimonChallenge.Midifile.2.mid")
End If
Else
Call m_WavFile.StopMidi
End If
End Sub
Funktion für Tastaturabfrage
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
'Escape
Case vbKeyEscape 'Spielabbruch
Unload Me
'Tasten für Spieler 1
Case Asc("q"), Asc("Q") 'Tippen
If m_GameKeyDownPlayer = gcNoPlayer Then m_GameKeyDownPlayer = gcPlayer1
Call imgType_Click
Case Asc("y"), Asc("Y") 'Rollen
If m_GameKeyDownPlayer = gcNoPlayer Then m_GameKeyDownPlayer = gcPlayer1
Call imgRoll_Click
Case Asc("a"), Asc("A") 'Klopfen
If m_GameKeyDownPlayer = gcNoPlayer Then m_GameKeyDownPlayer = gcPlayer1
Call imgKnock_Click
'Tasten für Spieler 2
Case Asc("o"), Asc("O") 'Drehen
If m_GameKeyDownPlayer = gcNoPlayer Then m_GameKeyDownPlayer = gcPlayer2
Call imgRotate_Click
Case Asc("k"), Asc("K") 'Klopfen
If m_GameKeyDownPlayer = gcNoPlayer Then m_GameKeyDownPlayer = gcPlayer2
Call imgKnock_Click
Case Asc("m"), Asc("M") 'Ziehen
If m_GameKeyDownPlayer = gcNoPlayer Then m_GameKeyDownPlayer = gcPlayer2
Call imgPull_Click
End Select
End Sub
Funktion für Fehleingabe
Private Sub imgBackground_Click()
'Sprachausgabe bei Fehleingabe
If m_GameSoundMode <> gcSilentMode Then
Call m_WavFile.Play("MBSimonChallenge.Duerfen.wav")
End If
End Sub
Funktion zum Aufruf der Info-Maske:
Private Sub lblInfo_Click()
'Sprachausgabe für Info-Maske
If m_GameSoundMode <> gcSilentMode Then
Call m_WavFile.Play("MBSimonChallenge.TunSoll.wav")
End If
Call frmInfo.OpenFile("MBSimonChallenge.txt", m_GameName & " - Info")
Call frmInfo.Show(vbModal)
End Sub
Funktion Klopfen:
Private Sub imgKnock_Click()
If m_GameCondition = gcRunning Then
Select Case m_GamePlayMode
Case gcSolo 'Spielvariante "Solo"
If m_GameCommand = gcKnock Then
Call GameNextCommand
Else
Call GameLost("Sie haben geklopft!")
End If
Case gcHeadToHead 'Spielvariante "Kopf an Kopf"
If m_GameKeyDownPlayer <> gcNoPlayer Then
If m_GameCommand = gcKnock Then
Call GameNextCommand
Else
If m_GameCommandOld <> gcKnock Then
Call GameLost("Sie haben geklopft!", m_GameKeyDownPlayer)
End If
End If
End If
Case gcGiveToNext 'Spielvariante "Weitergeben"
If m_GameCommand <> gcNext Then
If m_GameCommand = gcKnock Then
Call GameNextCommand
Else
Call GameLost("Sie haben geklopft!")
End If
End If
End Select
Else
'Bei Spielvariante "Kopf an Kopf" müßsen Tasten verwendet werden
If m_GamePlayMode = gcHeadToHead Then
'Hinweis zur Tastenbelegung ausgeben
Dim strPrompt As String
strPrompt = strPrompt & "Spieler 1" & vbTab & vbTab & "Spieler 2" & vbCrLf
strPrompt = strPrompt & "[Q]=Tippen" & vbTab & "[O]=Drehen" & vbCrLf
strPrompt = strPrompt & "[A]=Klopfen" & vbTab & "[K]=Klopfen" & vbCrLf
strPrompt = strPrompt & "[Y]=Rollen" & vbTab & "[M]=Ziehen" & vbCrLf & vbCrLf
strPrompt = strPrompt & "Die Maus kann hierbei nicht verwendet werden!"
Call MsgBox(strPrompt, vbInformation, "Tastenbelegung")
End If
Call GameStart
End If
End Sub
Funktion Ziehen:
Private Sub imgPull_Click()
If m_GameCondition = gcRunning Then
Select Case m_GamePlayMode
Case gcSolo 'Spielvariante "Solo"
If m_GameCommand = gcPull Then
Call GameNextCommand
Else
Call GameLost("Sie haben gezogen!")
End If
Case gcHeadToHead 'Spielvariante "Kopf an Kopf"
If m_GameKeyDownPlayer <> gcNoPlayer Then
If m_GameCommand = gcPull Then
Call GameNextCommand
Else
Call GameLost("Sie haben gezogen!", m_GameKeyDownPlayer)
End If
End If
Case gcGiveToNext 'Spielvariante "Weitergeben"
If m_GameCommand <> gcNext Then
If m_GameCommand = gcPull Then
Call GameNextCommand
Else
Call GameLost("Sie haben gezogen!")
End If
End If
End Select
Else
If m_GameCondition <> gcSetupPlayMode Then
'In den Setup-Modus umschalten
m_GameCondition = gcSetupPlayMode
Else
'Einstellung Spielvariante: "Solo", "Kopf an Kopf" oder "Weitergeben"
m_GamePlayMode = m_GamePlayMode + 1
If m_GamePlayMode > gcGiveToNext Then m_GamePlayMode = gcSolo
'Anzahl Spiele-Kommandos
If m_GamePlayMode = gcGiveToNext Then
m_GameCommandMax = 6
Else
m_GameCommandMax = 5
End If
'Punkteanzeige
If m_GamePlayMode = gcHeadToHead Then
lblScore2.Visible = True
Else
lblScore2.Visible = False
End If
End If
'Spachausgabe
If m_GameSoundMode <> gcSilentMode Then
Select Case m_GamePlayMode
Case GamePlayMode.gcSolo
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Spielvariante.Solo.wav")
Case GamePlayMode.gcGiveToNext
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Spielvariante.Weitergeben.wav")
Case GamePlayMode.gcHeadToHead
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Spielvariante.KopfAnKopf.wav")
End Select
End If
'Anzeige des Spielvariante
lblHint.Caption = "Spielvariante = " & m_GamePlayModes(m_GamePlayMode)
End If
End Sub
Funktion Rollen:
Private Sub imgRoll_Click()
If m_GameCondition = gcRunning Then
Select Case m_GamePlayMode
Case gcSolo 'Spielvariante "Solo"
If m_GameCommand = gcRoll Then
Call GameNextCommand
Else
Call GameLost("Sie haben gerollt!")
End If
Case gcHeadToHead 'Spielvariante "Kopf an Kopf"
If m_GameKeyDownPlayer <> gcNoPlayer Then
If m_GameCommand = gcRoll Then
Call GameNextCommand
Else
Call GameLost("Sie haben gerollt!", m_GameKeyDownPlayer)
End If
End If
Case gcGiveToNext 'Spielvariante "Weitergeben"
If m_GameCommand <> gcNext Then
If m_GameCommand = gcRoll Then
Call GameNextCommand
Else
Call GameLost("Sie haben gerollt!")
End If
End If
End Select
Else
If m_GameCondition <> gcSetupVolume Then
'In den Setup-Modus umschalten
m_GameCondition = gcSetupVolume
Else
'Einstellung der Lautstärke: "Leise", "Mittel" oder "Laut"
m_GameVolume = m_GameVolume + 1
If m_GameVolume > gcVolLoud Then m_GameVolume = gcVolSilent
m_WavFile.SetWaveVolume (m_GameVolumeValues(m_GameVolume))
m_WavFile.SetMidiVolume (m_GameVolumeValues(m_GameVolume))
End If
'Spachausgabe
If m_GameSoundMode <> gcSilentMode Then
Select Case m_GameVolume
Case GameVolume.gcVolLoud
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Lautstaerke.Laut.wav")
Case GameVolume.gcVolMedium
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Lautstaerke.Mittel.wav")
Case GameVolume.gcVolSilent
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Lautstaerke.Leise.wav")
End Select
End If
'Anzeige des Lautstärke
lblHint.Caption = "Lautstärke = " & m_GameVolumes(m_GameVolume)
End If
End Sub
Funktion Drehen:
Private Sub imgRotate_Click()
If m_GameCondition = gcRunning Then
Select Case m_GamePlayMode
Case gcSolo 'Spielvariante "Solo"
If m_GameCommand = gcRotate Then
Call GameNextCommand
Else
Call GameLost("Sie haben gedreht!")
End If
Case gcHeadToHead 'Spielvariante "Kopf an Kopf"
If m_GameKeyDownPlayer <> gcNoPlayer Then
If m_GameCommand = gcRotate Then
Call GameNextCommand
Else
Call GameLost("Sie haben gedreht!", m_GameKeyDownPlayer)
End If
End If
Case gcGiveToNext 'Spielvariante "Weitergeben"
If m_GameCommand <> gcNext Then
If m_GameCommand = gcRotate Then
Call GameNextCommand
Else
Call GameLost("Sie haben gedreht!")
End If
End If
End Select
Else
'Spachausgabe
If m_GameSoundMode <> gcSilentMode Then
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Highscore.wav")
End If
'Anzeige der Highscore
Call GameShowHighScore
lblHint.Caption = "Highscore = " & Str(m_GameHighScore)
End If
End Sub
Funktion Tippen:
Private Sub imgType_Click()
If m_GameCondition = gcRunning Then
Select Case m_GamePlayMode
Case gcSolo 'Spielvariante "Solo"
If m_GameCommand = gcType Then
Call GameNextCommand
Else
Call GameLost("Sie haben getippt!")
End If
Case gcHeadToHead 'Spielvariante "Kopf an Kopf"
If m_GameKeyDownPlayer <> gcNoPlayer Then
If m_GameCommand = gcType Then
Call GameNextCommand
Else
Call GameLost("Sie haben getippt!", m_GameKeyDownPlayer)
End If
End If
Case gcGiveToNext 'Spielvariante "Weitergeben"
If m_GameCommand <> gcNext Then
If m_GameCommand = gcType Then
Call GameNextCommand
Else
Call GameLost("Sie haben getippt!")
End If
End If
End Select
Else
If m_GameCondition <> gcSetupSoundMode Then
'In den Setup-Modus umschalten
m_GameCondition = gcSetupSoundMode
Else
'Einstellung Spielmodus: "Sound-Modus" oder "Voice-Modus"
m_GameSoundMode = m_GameSoundMode + 1
If m_GameSoundMode > gcSilentMode Then m_GameSoundMode = gcVoiceMode
End If
'Spachausgabe
'If m_GameSoundMode <> gcSilentMode Then
Select Case m_GameSoundMode
Case GameSoundMode.gcSoundMode
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Spielmodus.Sound.wav")
Case GameSoundMode.gcVoiceMode
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Spielmodus.Voice.wav")
Case GameSoundMode.gcSilentMode
Call m_WavFile.Play("MBSimonChallenge.Einstellung.Spielmodus.Silent.wav")
End Select
'End If
'Anzeige des Spielemodus
lblHint.Caption = "Spielmodus = " & m_GameSoundModes(m_GameSoundMode)
End If
End Sub
Funktion für Countdown-Timer:
Private Sub TimerCountdown_Timer()
m_GameTimeout = m_GameTimeout - TimerCountdown.Interval
If m_GameTimeout > 0 Then
'Scroll-Bar aktualisieren
shpCountdownValue.Width = (shpCountdownBorder.Width - 120) / m_GameTimeoutStart * m_GameTimeout
Else
'Scroll-Bar auf 0 setzen
shpCountdownValue.Width = 0
If m_GamePlayMode = gcGiveToNext And m_GameCommand = gcNext Then
'Spielvariante "Weitergeben" und Kommando "gcNext" ermittelt das nächste Kommando
Call GameNextCommand
Else
Call GameLost("Die Zeit ist abgelaufen!", gcNoPlayer)
End If
End If
End Sub
Funktion für Splash-Timer. Hierbei wird beim Programmstart die HighScore-Seite angezeigt. Dadurch ermitteln wir ganz nebenbei den abgespeicherten HighScore-Wert.
Private Sub TimerSplash_Timer()
TimerSplash.Enabled = False
Call GameShowHighScore
End Sub
Zunächst setzen wir alle notwendigen Objekte auf unsere Form:
 |
|
Als erstes definieren wir ein paar notwendige Variable:
'/////////////////////////////////////////////////////////////////////////// '// '// Projekt : MBSimonChallenge '// Sprache : Basic '// Compiler: MS Visual Basic 6.0 '// Autor : Manfred Becker '// E-Mail : mani.becker@web.de '// Url : http://manib.ma.funpic.de '// Modul : frmInfo '// Version : 1.02 '// Datum : 27.01.2008 '// '/////////////////////////////////////////////////////////////////////////// Option Explicit
Funktion für Initialisierung der Variable:
Private Sub Form_Load()
'Formular zentrieren
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
Me.txtInfo.Text = "Please use OpenFile() to show any text from a textfile."
End Sub
Funktion für Grössenänderung der Form:
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then Exit Sub
txtInfo.Left = 0
txtInfo.Top = 0
txtInfo.Width = Me.Width - 120
txtInfo.Height = Me.Height - 400
End Sub
Funktion zum Öffnen einer beliebigen Textdatei:
Public Sub OpenFile(PathAndFilename As String, Optional Title As Variant)
On Error GoTo ErrorHandler
Dim strFileContent As String
Dim bFileIsOpen As Boolean
Dim nLen As Long
Dim FileNr As Long
'Variable initialisieren
bFileIsOpen = False
'Wir ermitteln die Dateilänge in Bytes
nLen = FileLen(PathAndFilename)
FileInput:
'nächste verfügbare Dateinummer
FileNr = FreeFile
'Öffnen der gewählten Datei
Open PathAndFilename For Input As #FileNr
'Das Öffnen hat funktioniert
bFileIsOpen = True
'Ändern des Mauszeigers in eine Sanduhr
Screen.MousePointer = vbHourglass
'Laden des Dateiinhalts
strFileContent = Input(nLen, FileNr)
'Das Laden hat funktioniert!
txtInfo.Text = strFileContent
'Wurde eine Überschrift übergeben?
If Not IsMissing(Title) Then
Me.Caption = Title
End If
ExitSub:
'Schliessen der Datei
If bFileIsOpen Then Close #FileNr
'Zurücksetzen des Mauszeigers
Screen.MousePointer = vbDefault
Exit Sub
ErrorHandler:
Dim ErrNumber As Integer
Dim ErrDescription As String
ErrNumber = Err.Number
ErrDescription = Err.Description
Select Case ErrNumber
Case 53
MsgBox "Datei kann nicht geöffnet werden: " + PathAndFilename
Case 62
If bFileIsOpen Then Close #FileNr
bFileIsOpen = False
nLen = nLen - 1
Resume FileInput
Case Else
MsgBox "Fehler:" & Str(ErrNumber) & vbCrLf & vbCrLf & ErrDescription
End Select
Resume ExitSub
End Sub
Funktion für Tasteneingaben:
Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case vbKeyEscape
Unload Me
End Select
End Sub
Zunächst setzen wir alle notwendigen Objekte auf unsere Form:
 |
|
Als erstes definieren wir ein paar notwendige Variable:
'///////////////////////////////////////////////////////////////////////////
'//
'// Projekt : MBSimonChallenge
'// Sprache : Basic
'// Compiler: MS Visual Basic 6.0
'// Autor : Manfred Becker
'// E-Mail : mani.becker@web.de
'// Url : http://manib.ma.funpic.de
'// Modul : frmHighScore
'// Version : 1.02
'// Datum : 27.01.2008
'//
'///////////////////////////////////////////////////////////////////////////
Option Explicit
'Datentyp für HighScore-Eintrag
Private Type HighScoreEntry
Id As String * 5
Name As String * 20
Score As String * 6
Date As String * 10
Time As String * 8
End Type
'Mit dieser Konstanten wird festgelegt,
'wie viele Einträge in der Liste angezeigt werden
Private Const INDEX_MAX As Integer = 10
'Lokale Variable
Private m_HighScoreFilename As String
Private m_HighScoreLines As Integer
Private m_HighScoreMin As Long
Private m_HighScoreMax As Long
Private m_HighScoreNew As Long
Private m_HighScoreChanged As Boolean
Private m_HighScoreTitle As String
Funktion zum Setzen des HighScore-Dateinamens. Optional kann eine Überschrift mitgegeben werden:
Public Function SetHighScoreFilename(PathAndFilename As String, Optional Title As Variant) As Boolean
m_HighScoreFilename = PathAndFilename
If Not IsMissing(Title) Then
m_HighScoreTitle = Title
Else
m_HighScoreTitle = ""
End If
SetHighScoreFilename = FileExist(PathAndFilename)
End Function
Funktion zur Ermittlung des aktuellen HighScore Punktestand:
Public Function GetHighScore() As Long
GetHighScore = m_HighScoreMax
End Function
Funktion zum Setzen der HighScore:
Public Sub SetHighScore(Score As Long)
Dim bRet As Boolean
If Score > m_HighScoreMin Then
m_HighScoreNew = Score
Else
m_HighScoreNew = 0
End If
End Sub
Funktion die prüft, ob der angegebene Punktestand in die HighScore-Liste aufgenommen würde:
Public Function CheckHighScore(Score As Long) As Boolean
Dim bRet As Boolean
If Score > m_HighScoreMin Then
bRet = True
Else
bRet = False
End If
CheckHighScore = bRet
End Function
Funktion die prüft, od die angegebene Datei existiert:
Private Function FileExist(FileName) As Boolean
On Error GoTo ErrorHandler
FileExist = Dir$(FileName) <> ""
Exit Function
ErrorHandler:
FileExist = False
Resume Next
End Function
Diese Funktion ermittelt aus einer Textzeile die HighScore-Einträge:
Private Function GetEntryFromTextline(Textline As String, ByRef Entry As HighScoreEntry) As String
Dim sRet As String
Dim nStart As Integer
Dim nEnd As Integer
Dim sValue As String
Dim Index As Integer
nEnd = 0
For Index = 0 To 4
nStart = nEnd + 1
nEnd = InStr(nStart, Textline, ";", vbTextCompare)
If nEnd = 0 Then nEnd = Len(Textline) + 1
If nStart <= nEnd Then
sValue = Trim(Mid(Textline, nStart, nEnd - nStart))
Select Case Index
Case 0: Entry.Id = sValue
Case 1: Entry.Name = sValue
Case 2: Entry.Score = sValue
Case 3: Entry.Date = sValue
Case 4: Entry.Time = sValue
End Select
Else
sRet = "Spaltenwert" & Str(Index) & " fehlt!"
Exit For
End If
Next Index
GetEntryFromTextline = sRet
End Function
Funktion zum Lesen der HighScore-Datei. Dabei werden auf der Form die Zeilen dynamisch aufgebaut. Wurde zuvor über die Funktion SetHighScore() ein neuer Punktestand angegeben, dann wird das Textfeld zur Eingabe des Namens freigeschaltet.
Private Function ReadHighScoreFile(PathAndFilename As String) As String
On Error GoTo ErrorHandler
Dim sRet As String
Dim strTextLine As String
Dim bFileIsOpen As Boolean
Dim nLen As Long
Dim FileNr As Long
Dim Index As Integer
Dim MyEntry As HighScoreEntry
Dim nScore As Long
'Variable initialisieren
m_HighScoreMin = 0
m_HighScoreMax = 0
sRet = ""
Index = -1
bFileIsOpen = False
'Wir ermitteln die Dateilänge in Bytes
nLen = FileLen(PathAndFilename)
FileInput:
'nächste verfügbare Dateinummer
FileNr = FreeFile
'Öffnen der gewählten Datei
Open PathAndFilename For Input As #FileNr
'Das Öffnen hat funktioniert
bFileIsOpen = True
'Ändern des Mauszeigers in eine Sanduhr
Screen.MousePointer = vbHourglass
'Laden des Dateiinhalts
Do While Not EOF(FileNr) ' Schleife bis Dateiende.
Line Input #FileNr, strTextLine ' Zeile in Variable einlesen.
sRet = GetEntryFromTextline(strTextLine, MyEntry)
If sRet = "" Then
If Index = -1 Then
'Überschrift zuweisen
lblId.Caption = Trim(MyEntry.Id)
lblName.Caption = Trim(MyEntry.Name)
lblScore.Caption = Trim(MyEntry.Score)
lblDate.Caption = Trim(MyEntry.Date)
lblTime.Caption = Trim(MyEntry.Time)
ElseIf Index >= 0 And Index < INDEX_MAX Then
If Index > 0 Then
Call LoadNewEntry(Index)
End If
If Val(m_HighScoreNew) > 0 And Val(m_HighScoreNew) > Val(MyEntry.Score) Then
'Neuer Punktestand einfügen
Call InsertNewEntry(Index)
Index = Index + 1
If Index = INDEX_MAX Then
Exit Do
End If
Call LoadNewEntry(Index)
End If
txtId(Index).Text = Trim(Str(Index + 1) & ".")
txtName(Index).Text = Trim(MyEntry.Name)
txtScore(Index).Text = Trim(MyEntry.Score)
txtDate(Index).Text = Trim(MyEntry.Date)
txtTime(Index).Text = Trim(MyEntry.Time)
nScore = Val(Trim(MyEntry.Score))
If m_HighScoreMax < nScore Then m_HighScoreMax = nScore
If m_HighScoreMin = 0 Then m_HighScoreMin = nScore
If m_HighScoreMin > nScore Then m_HighScoreMin = nScore
Else
Exit Do
End If
Index = Index + 1
End If
Loop
If Val(m_HighScoreNew) > 0 And Index < INDEX_MAX Then
'Neuer Punktestand einfügen
Call LoadNewEntry(Index)
Call InsertNewEntry(Index)
Index = Index + 1
End If
ExitSub:
If Index < INDEX_MAX Then
m_HighScoreMin = 0
End If
m_HighScoreLines = Index - 1
'Schliessen der Datei
If bFileIsOpen Then Close #FileNr
'Zurücksetzen des Mauszeigers
Screen.MousePointer = vbDefault
'Höhe der Form setzen
Me.Height = txtId(m_HighScoreLines).Top + txtId(m_HighScoreLines).Height + 480
'Rückgabewert
ReadHighScoreFile = sRet
Exit Function
ErrorHandler:
Dim ErrNumber As Integer
Dim ErrDescription As String
ErrNumber = Err.Number
ErrDescription = Err.Description
Select Case ErrNumber
Case 53
'Falls die Datei nicht existiert, aber ein neuer Eintrag
'gesichert werden soll, umgehen wir die Fehlermeldung!
If Val(m_HighScoreNew) > 0 And Index = -1 Then
'Neuer Punktestand einfügen
Index = 0
Call InsertNewEntry(Index)
Index = Index + 1
Resume ExitSub
End If
sRet = "Datei " & PathAndFilename & " nicht vorhanden!"
Index = 1
Case 62
If bFileIsOpen Then Close #FileNr
bFileIsOpen = False
nLen = nLen - 1
Resume FileInput
Case Else
sRet = "Fehler:" & Str(ErrNumber) & vbCrLf & vbCrLf & ErrDescription
End Select
Resume ExitSub
End Function
Funktion zum Schreiben der HighScore-Datei:
Private Function WriteHighScoreFile(PathAndFilename As String) As String
On Error GoTo ErrorHandler
Dim sRet As String
Dim strTextLine As String
Dim bFileIsOpen As Boolean
Dim FileNr As Long
Dim Index As Integer
'Variable initialisieren
sRet = ""
bFileIsOpen = False
'nächste verfügbare Dateinummer
FileNr = FreeFile
'Öffnen der gewählten Datei
Open PathAndFilename For Output As #FileNr
'Das Öffnen hat funktioniert
bFileIsOpen = True
'Ändern des Mauszeigers in eine Sanduhr
Screen.MousePointer = vbHourglass
'Sichern der Überschrift
strTextLine = lblId.Caption & ";" & _
lblName.Caption & ";" & _
lblScore.Caption & ";" & _
lblDate.Caption & ";" & _
lblTime.Caption
Print #FileNr, strTextLine
'Sichern der Daten
For Index = 0 To m_HighScoreLines
strTextLine = txtId(Index).Text & ";" & _
txtName(Index).Text & ";" & _
txtScore(Index).Text & ";" & _
txtDate(Index).Text & ";" & _
txtTime(Index).Text
Print #FileNr, strTextLine
Next Index
ExitSub:
'Schliessen der Datei
If bFileIsOpen Then Close #FileNr
'Zurücksetzen des Mauszeigers
Screen.MousePointer = vbDefault
'Rückgabewert
WriteHighScoreFile = sRet
Exit Function
ErrorHandler:
Dim ErrNumber As Integer
Dim ErrDescription As String
ErrNumber = Err.Number
ErrDescription = Err.Description
Select Case ErrNumber
Case 53
sRet = "Datei kann nicht geöffnet werden: " & PathAndFilename
Case Else
sRet = "Fehler:" & Str(ErrNumber) & vbCrLf & vbCrLf & ErrDescription
End Select
Resume ExitSub
End Function
Funktion zu Hinzufügen eines neuen HighScore-Eintrags:
Private Sub InsertNewEntry(Index As Integer)
Dim nScore As Long
txtId(Index).Text = Trim(Str(Index + 1) & ".")
txtName(Index).Text = "?"
txtScore(Index).Text = Trim(m_HighScoreNew)
txtDate(Index).Text = Date
txtTime(Index).Text = Left(Time, 5) 'ohne Sekunden
txtName(Index).Enabled = True
txtName(Index).Locked = False
txtName(Index).SelStart = 0
txtName(Index).SelLength = Len(txtName(Index).Text)
nScore = Val(m_HighScoreNew)
If m_HighScoreMax < nScore Then m_HighScoreMax = nScore
If m_HighScoreMin = 0 Then m_HighScoreMin = nScore
If m_HighScoreMin > nScore Then m_HighScoreMin = nScore
m_HighScoreChanged = True
m_HighScoreNew = 0
End Sub
Funktion zum Erstellen neuer Objekte für den HighScore-Eintrag:
Private Sub LoadNewEntry(Index As Integer)
Load txtId(Index)
txtId(Index).Move txtId(0).Left, txtId(0).Top + Index * (txtId(0).Height + 60)
txtId(Index).Visible = True
Load txtName(Index)
txtName(Index).Move txtName(0).Left, txtName(0).Top + Index * (txtName(0).Height + 60)
txtName(Index).Visible = True
Load txtScore(Index)
txtScore(Index).Move txtScore(0).Left, txtScore(0).Top + Index * (txtScore(0).Height + 60)
txtScore(Index).Visible = True
Load txtDate(Index)
txtDate(Index).Move txtDate(0).Left, txtDate(0).Top + Index * (txtDate(0).Height + 60)
txtDate(Index).Visible = True
Load txtTime(Index)
txtTime(Index).Move txtTime(0).Left, txtTime(0).Top + Index * (txtTime(0).Height + 60)
txtTime(Index).Visible = True
End Sub
Funktion für Tasteneingabe:
Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case vbKeyEscape, vbKeyReturn
Unload Me
End Select
End Sub
Funktion für Initialisierung der Variable:
Private Sub Form_Load()
'Titel anzeigen?
If m_HighScoreTitle <> "" Then Me.Caption = m_HighScoreTitle
m_HighScoreLines = 1
m_HighScoreChanged = False
'Falls ein Dateiname angegeben wurde...
If m_HighScoreFilename <> "" Then
'...Datei einlesen
Dim sRet As String
sRet = ReadHighScoreFile(m_HighScoreFilename)
If sRet <> "" Then
'MsgBox sRet
End If
Else
'...Hinweis ausgeben
Call MsgBox("Sie müssen einen Dateinamen angeben!" & vbCrLf & _
"Verwenden Sie dazu die Funktion SetHighScoreFilename()", vbOKOnly)
End If
'Formular zentrieren
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
End Sub
Funktion zum Entladen aller Objekte:
Private Sub Form_Unload(Cancel As Integer)
If m_HighScoreChanged Then
Dim sRet As String
sRet = WriteHighScoreFile(m_HighScoreFilename)
If sRet <> "" Then
MsgBox sRet
End If
End If
If (m_HighScoreLines > 1) Then
Dim Index As Integer
For Index = 1 To m_HighScoreLines
Unload txtId(Index)
Unload txtName(Index)
Unload txtScore(Index)
Unload txtDate(Index)
Unload txtTime(Index)
Next Index
End If
End Sub
Timer-Funktion für ein automatisches Entladen:
Private Sub TimerAutoUnload_Timer()
Unload Me
End Sub
Funktion für Tasteneingabe der Textbox:
Private Sub txtName_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case KeyAscii
Case vbKeyEscape, vbKeyReturn
'Überprüfe Eingabe
If txtName(Index).Text = "" Then
txtName(Index).SetFocus
Else
Unload Me
End If
Case vbKeyBack
'Taste Backspace lassen wir zu
Case Else
'Nur bestimmte Zeichen für die Eingabe zulassen.
If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.-+*#_=?<>()[]{} ", UCase(Chr(KeyAscii)), vbTextCompare) = 0 Then
KeyAscii = 0
End If
End Select
End Sub
Hier ist meine Klasse für die WavFile-Anbindung.
'///////////////////////////////////////////////////////////////////////////
'//
'// Projekt : MBSimonChallenge
'// Sprache : Basic
'// Compiler: MS Visual Basic 6.0
'// Autor : Manfred Becker
'// E-Mail : mani.becker@web.de
'// Url : http://manib.ma.funpic.de
'// Modul : clsWavFile
'// Version : 1.02
'// Datum : 27.01.2008
'//
'///////////////////////////////////////////////////////////////////////////
Option Explicit
'Lokale Variable
Private snd_Handle&
Private snd_Soundcard As Boolean
Private snd_Recording As Boolean
Private snd_NumDevs As Long
Private snd_PlayMidi As Boolean
'Deklaration der notwendigen API-Funktionen
Private Declare Function MySndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As Any, ByVal uFlags As Long) As Long
Private Declare Function MyMciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function MyWaveOutGetNumDevs Lib "winmm.dll" Alias "waveOutGetNumDevs" () As Long
Private Declare Function MyPlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Declare Function MyWaveOutGetVolume Lib "winmm.dll" Alias "waveOutGetVolume" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function MyWaveOutSetVolume Lib "winmm.dll" Alias "waveOutSetVolume" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Declare Function MyGetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function MyMidiOutGetVolume Lib "winmm.dll" Alias "midiOutGetVolume" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function MyMidiOutSetVolume Lib "winmm.dll" Alias "midiOutSetVolume" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
'Notwendige Flags, siehe WIN32API.TXT von VisualBasic
Public Enum SND_FLAGS
SND_SYNC = &H0 ' play synchronously (default)
SND_ASYNC = &H1 ' play asynchronously
SND_NODEFAULT = &H2 ' silence not default, if sound not found
SND_MEMORY = &H4 ' lpszSoundName points to a memory file
SND_LOOP = &H8 ' loop the sound until next sndPlaySound
SND_NOSTOP = &H10 ' don't stop any currently playing sound
End Enum
'Diese Prozedur wird einmal bei Instanzieren der Klasse ausgeführt
'und ist somit mit einem C++ Konstruktor vergleichbar
Private Sub Class_Initialize()
Call TestSoundkarte
snd_Recording = False
End Sub
'Diese Prozedur wird einmal bei Beenden der Klasse ausgeführt
'und ist somit mit einem C++ Destruktor vergleichbar
Private Sub Class_Terminate()
If snd_Soundcard Then
If snd_Recording Then
Call StopRecord
End If
SndPlaySound 0&, 0
If snd_PlayMidi Then
Call StopMidi
End If
End If
End Sub
'Funktion zum Test der Soundkarte
Public Function TestSoundkarte() As Boolean
snd_NumDevs = MyWaveOutGetNumDevs() 'Anzahl verfügbarer Soundkarten
snd_Soundcard = (snd_NumDevs > 0)
TestSoundkarte = snd_Soundcard
End Function
'Funktion zum Abspielen einer Wav-Datei mittels MyMciSendString
Public Sub Play(PathAndFilename As String)
If snd_Soundcard Then
MyMciSendString "CLOSE mysound", "", 0, snd_Handle
MyMciSendString "OPEN WAVEAUDIO!" & PathAndFilename & " ALIAS mysound", "", 0, snd_Handle
MyMciSendString "PLAY mysound from 0", "", 0, snd_Handle
End If
End Sub
'Funktion zum Abspielen einer Wav-Datei mittels SndPlaySound (incl. Flag-Steuerung)
Public Sub SndPlaySound(PathAndFilename As String, Flags As SND_FLAGS)
If snd_Soundcard Then
MySndPlaySound PathAndFilename, Flags
End If
End Sub
'Funktion zum Stoppen einer Wav-Datei
Public Sub SndStopSound()
If snd_Soundcard Then
MySndPlaySound 0&, 0
End If
End Sub
'Funktion zum Abspielen einer Wav-Datei mittels PlaySound (incl. Modul und Flag-Steuerung)
Public Function PlaySound(ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
If snd_Soundcard Then
PlaySound = MyPlaySound(lpszName, hModule, dwFlags)
Else
PlaySound = -1
End If
End Function
'Funktion zum Aufnehmen einer Wav-Datei
Public Sub StartRecord()
If snd_Soundcard Then
MyMciSendString "OPEN NEW TYPE WAVEAUDIO ALIAS mysound", "", 0, snd_Handle
MyMciSendString "SET mysound TIME FORMAT MS BITSPERSAMPLE 8 CHANNELS 2 SAMPLESPERSEC 22050 BYTESPERSEC 22050", "", 0, snd_Handle
MyMciSendString "DELETE mysound from 0", "", 0, snd_Handle
MyMciSendString "RECORD mysound from 0 overwrite", "", 0, snd_Handle
snd_Recording = True
End If
End Sub
'Funktion zum Stoppen der Aufnahme einer Wav-Datei
Public Sub StopRecord()
If snd_Soundcard Then
MyMciSendString "STOP mysound", "", 0, snd_Handle
snd_Recording = False
End If
End Sub
'Funktion zum Abspielen einer aufgenommenen Wav-Datei
Public Sub PlayRecord()
If snd_Soundcard Then
MyMciSendString "PLAY mysound from 0", "", 0, snd_Handle
End If
End Sub
'Funktion zum Sichern einer aufgenommenen Wav-Datei
Public Sub SaveRecord(PathAndFilename As String)
If snd_Soundcard Then
MyMciSendString "SAVE mysound " & PathAndFilename, "", 0, snd_Handle
MyMciSendString "CLOSE mysound", "", 0, snd_Handle
End If
End Sub
'Funktion zur Ermittlung der Wave-Lautstärke
Public Function GetWaveVolume() As Long
Dim dwRet As Long
Dim dwVolume As Long
Dim uDeviceID As Long
dwVolume = -1
uDeviceID = 0
If snd_Soundcard Then
dwRet = MyWaveOutGetVolume(uDeviceID, dwVolume)
End If
GetWaveVolume = dwVolume
End Function
'Funktion zum Setzen der Wave-Lautstärke
Public Sub SetWaveVolume(dwVolume As Long)
Dim dwRet As Long
Dim uDeviceID As Long
uDeviceID = 0
If snd_Soundcard Then
dwRet = MyWaveOutSetVolume(uDeviceID, dwVolume)
End If
End Sub
'Funktion ermittelt den kurzen Pfad-/Dateinamen einer Datei (8.3)
Private Function Long2ShortPath(ByVal LongPath As String) As String
Dim Buffer As String
Buffer = Space$(256)
If MyGetShortPathName(LongPath, Buffer, Len(Buffer)) <> 0 Then
Long2ShortPath = Left$(Buffer, InStr(Buffer, vbNullChar) - 1)
Else
Long2ShortPath = ""
End If
End Function
'Funktion zum Abspielen einer MIDI-Datei
Public Function PlayMidi(ByVal PathAndFilename As String) As Boolean
Dim Buffer As String
Dim ErrHandler As Long
Dim ShortPath As String
'Prüfen ob eine MIDI-Datei übergeben wurde
If UCase$(Mid$(PathAndFilename, Len(PathAndFilename) - 2)) <> "MID" Then
PlayMidi = False
Exit Function
End If
'Pfad-/Dateinamen in kurzen Pfad-/Dateinamen wandeln
ShortPath = Long2ShortPath(PathAndFilename)
If Len(ShortPath) = 0 Then
PlayMidi = False
Exit Function
End If
If snd_Soundcard Then
If snd_PlayMidi Then
Call StopMidi
End If
Buffer = Space$(256)
ErrHandler = MyMciSendString("open sequencer!" & ShortPath & " alias MIDI", Buffer, Len(Buffer), 0)
ErrHandler = MyMciSendString("play MIDI", Buffer, Len(Buffer), 0)
snd_PlayMidi = (ErrHandler = 0)
Else
snd_PlayMidi = False
End If
PlayMidi = snd_PlayMidi
End Function
'Funktion zum Stoppen des Abspielvorgangs
Public Sub StopMidi()
If snd_Soundcard Then
MyMciSendString "stop MIDI", 0, 0, 0
MyMciSendString "close MIDI", 0, 0, 0
snd_PlayMidi = False
End If
End Sub
'Funktion zur Ermittlung der Midi-Lautstärke
Public Function GetMidiVolume() As Long
Dim dwRet As Long
Dim dwVolume As Long
Dim uDeviceID As Long
dwVolume = -1
uDeviceID = 0
If snd_Soundcard Then
dwRet = MyMidiOutGetVolume(uDeviceID, dwVolume)
End If
GetMidiVolume = dwVolume
End Function
'Funktion zum Setzen der Wave-Lautstärke
Public Sub SetMidiVolume(dwVolume As Long)
Dim dwRet As Long
Dim uDeviceID As Long
uDeviceID = 0
If snd_Soundcard Then
dwRet = MyMidiOutSetVolume(uDeviceID, dwVolume)
End If
End Sub
Das war's mal wieder. Ich hoffe dieser Artikel hat euch gefallen. Über einen Eintrag in meinem Gästebuch würde ich mich freuen. Wenn ihr Anregungen habt, oder Verbesserungsvorschläge, dann gebt mir bitte ein Feedback. Falls ihr weitere interessante Artikel lesen wollt, dann schaut mal hier rein.
Ciao,
Manfred