Visual Basic World - Programmierung und BeispieleVisual Basic World - Tipps und TutorialsVisual Basic World - Source-Code und Forum

<leer>

Programme: Mastermind

Autoren: Daniel Berger, Alexander Kopatz  Download: Projekt-Download
VB-Version: Visual Basic 6.0  Ansicht: Screenshot

Beschreibung

Programm: Mastermind - Quellcode/Source-Code Mastermind ist ein Logikspiel, bei welchem Sie die Zusammensetzung eines verdeckten Farbfeldes durch logische Kombination von frei wählbaren offenen Farbfeldern bestimmen müssen. Ziel ist es die verdeckte Farbkombination in möglichst wenigen Zügen zu erkennen. Das Spielprinzip basiert auf einer Idee von Mordecai Meirowitz aus den 1970er Jahren. Diese Visual Basic Umsetzung orientiert sich am Spielprinzip des Klassikers bietet jedoch Variationsmöglichkeiten. So kann sowohl die Anzahl der maximalen Runden als auch die Zahl der Farbfelder variiert werden. Die Farb- oder Volltreffer werden durch rote und grüne Boxen am Rande des Spielfeldes angezeigt. Viel Spaß beim Mastermind spielen!

Quellcode

frmMastermind
Form                     frmMastermind
Line                     Line1
PictureBox               picPin
PictureBox               picPin
PictureBox               picPin
PictureBox               picPin
Shape                    BingoBox
Shape                    BingoBox
Shape                    BingoBox
' VISUAL BASIC WORLD
' ===========================================
' Das große Portal zum Thema Visual Basic.
'
' Wenn Ihnen dieser Source Code gefallen hat,
' dann empfehlen Sie Visual Basic World bitte
' weiter und/oder setzen Sie einen Link auf:
'
' http://www.visualbasicworld.de/
'
' Vernetzen Sie sich mit uns:
'
' http://twitter.com/visualbasicwrld
'
' Dieses Programm ist urheberrechtlich geschützt
' und darf nur für private und nicht kommerzielle
' Zwecke verwendet werden!
'
' Programm: Mastermind
' Autoren: Daniel Berger, Alexander Kopatz
' Version: 1.0
' Datum: 2011-07-31
'
 
Option Explicit
 
Private Const MaxRounds As Integer = 10 'Maximale Anzahl an Runden
Private Const MaxPins As Integer = 4 'Maximale Anzahl an Spielsteinen (Pins) pro Runde
 
Private iZähler As Integer
Private iPin As Integer
 
'--- Globaler Speicher für Farben und Ergebnisse ---'
 
Private Type typRunde
   iFarbe(1 To 4) As Integer 'Welche Farbe hat welcher Stein
   iTreffer(1 To 4) As Integer 'diese Treffer wurden erzielt
End Type
 
Private Runde() As typRunde
 
'--- Zwischenspeicher für Runde und Pin ---'
 
Private iBuffRunde As Integer
Private iBuffPin As Integer
 
Private Sub CreateSpielfeld() '=== Diese Funktion generiert dynamisch ein Spielfeld ===' For iZähler = 1 To MaxRounds For iPin = 1 To MaxPins '=== leere Pins für das Spielfeld laden ===' Load Me.picPin(iZähler * 10 + iPin) 'Spielfelder werden erst zur Laufzeit dynamisch erstellt With Me.picPin(Me.picPin.UBound) .Top = iZähler * 750 + 350 .Left = iPin * 825 - 600 .Visible = True End With '=== leere BingoBoxen laden ===' Load Me.BingoBox(iZähler * 10 + iPin) With Me.BingoBox(Me.BingoBox.UBound) If iPin <= 2 Then 'Bei BingoBox 1 und 2 wird ein anderer Top-Wert 'benötigt als bei BingoBox 3 und 4 .Top = iZähler * 750 + 400 Else Me.BingoBox(Me.BingoBox.UBound).Top = iZähler * 750 + 675 End If If iPin Mod 2 = 0 Then .Left = .Left + 250 'Alle geraden BingoBoxen (2 und 4) werden zusätzlich 'um 250 nach Rechts verschoben um ins Bild zu passen .Visible = True End With Next Next Me.Height = Me.picPin(Me.picPin.UBound).Top + 1250 End Sub
Private Sub GetRndFirstSet() '=== Funktion erzeugt die erste zufällige Farbenreihe ===' Randomize Timer 'Zufallsgenerator wird mit dem Timer-Counter initialisiert um 'nicht bei jeder Spielrunde die selben Zufallszahlen zu erhalten. ReDim Runde(1) For iPin = 1 To MaxPins Runde(0).iFarbe(iPin) = Int((Rnd * 6) + 1) Runde(1).iFarbe(iPin) = 7 Next End Sub
Private Function GetColor(ByRef iFarbe As Integer) As Long Select Case iFarbe Case 1: GetColor = RGB(&HFF, 0, 0) 'rot Case 2: GetColor = RGB(0, &HFF, 0) 'grün Case 3: GetColor = RGB(0, 0, &HFF) 'blau Case 4: GetColor = RGB(&HFF, &HFF, 0) 'gelb Case 5: GetColor = RGB(&HFF, &HAF, 0) 'orange Case 6: GetColor = RGB(&HAB, 0, &HFF) 'lila Case 7: GetColor = vbWhite Case 0: GetColor = &HE0E0E0 End Select End Function
Private Sub PrintSpielfeld() Dim iCounter As Long '--- Treffer zurücksetzen For iZähler = 0 To UBound(Runde) For iPin = 1 To MaxPins Me.BingoBox(iZähler * 10 + iPin).Tag = "0" Me.BingoBox(iZähler * 10 + iPin).FillColor = &HE0E0E0 Next Next '--- Normale Steine und Treffer zeichnen For iZähler = 0 To UBound(Runde) For iPin = 1 To MaxPins 'Normale Spielsteine (Pins) zeichnen Me.picPin(iZähler * 10 + iPin).BackColor = GetColor(Runde(iZähler).iFarbe(iPin)) Next 'Hier werden die Trefferfelder (BingoBoxen) gezeichnet. Um keinen Hinweis 'auf die Position der Pins zu heben werden zunächst die Volltreffer gezeichnet 'und erst danach die Farbtreffer. For iPin = 1 To MaxPins 'Volltreffer zeichnen If Runde(iZähler).iTreffer(iPin) = 1 Then For iCounter = 1 To MaxPins With Me.BingoBox(iZähler * 10 + iCounter) If .Tag = "0" Then .FillColor = GetColor(1) .Tag = "1" If iCounter = 4 Then Victory Exit Sub End If Exit For End If End With Next End If Next For iPin = 1 To MaxPins 'Farbtreffer zeichnen If Runde(iZähler).iTreffer(iPin) = 2 Then For iCounter = 1 To MaxPins With Me.BingoBox(iZähler * 10 + iCounter) If .Tag = "0" Then .FillColor = GetColor(2) .Tag = "2" Exit For End If End With Next End If Next Next End Sub
Private Sub RundeBeenden() '--- Prüfen ob alle Felder ausgefüllt wurden For iPin = 1 To MaxPins If Runde(UBound(Runde)).iFarbe(iPin) = 7 Then: Exit Sub Next '--- Die Treffer prüfen For iZähler = 1 To MaxPins If Runde(0).iFarbe(iZähler) = Runde(UBound(Runde)).iFarbe(iZähler) Then Runde(UBound(Runde)).iTreffer(iZähler) = 1 'Volltreffer Else For iPin = 1 To MaxPins If Runde(UBound(Runde)).iTreffer(iPin) = 0 Then If Runde(0).iFarbe(iZähler) = Runde(UBound(Runde)).iFarbe(iPin) Then Runde(UBound(Runde)).iTreffer(iPin) = 2: Exit For 'Farbtreffer End If End If Next End If Next '--- Nächste Spielfeldrunde aktivieren If UBound(Runde) < MaxRounds Then ReDim Preserve Runde(UBound(Runde) + 1) For iPin = 1 To MaxPins Runde(UBound(Runde)).iFarbe(iPin) = 7 Next Else For iZähler = 1 To MaxPins picPin(iZähler).Visible = True Next End If End Sub
Private Sub Victory() Beep MsgBox "Herzlichen Glückwunsch! Sie haben diese Partie in Runde " & _ UBound(Runde) - 1 & " gewonnen!", vbInformation, "Sieg!" For iZähler = 0 To UBound(Runde) For iPin = 1 To MaxPins Me.picPin(iZähler * 10 + iPin).Enabled = False 'Alle Felder sperren... Next Next For iZähler = 1 To MaxPins picPin(iZähler).Visible = True Next End Sub
Private Sub Form_DblClick() If Me.picPin(11).Enabled = False Then Exit Sub 'Spiel bereits gewonnen... RundeBeenden PrintSpielfeld End Sub
Private Sub Form_Load() 'Hier geht's los! :-) CreateSpielfeld GetRndFirstSet PrintSpielfeld End Sub
Private Sub picPin_MouseUp(Index As Integer, Button As Integer, _ Shift As Integer, X As Single, Y As Single) iBuffRunde = Int(Index / 10) 'Ermittelt die aktuelle Runde iBuffPin = Index Mod 10 'Ermittelt den aktuellen Pin If iBuffRunde = UBound(Runde) Then 'Abfrage stellt sicher, dass immer nur die gerade 'aktive Runde bearbeitet werden kann (darf). With Runde(iBuffRunde) If Button = 1 Then .iFarbe(iBuffPin) = .iFarbe(iBuffPin) + 1 Else .iFarbe(iBuffPin) = .iFarbe(iBuffPin) - 1 End If If .iFarbe(iBuffPin) >= 7 Then .iFarbe(iBuffPin) = 1 If .iFarbe(iBuffPin) <= 0 Then .iFarbe(iBuffPin) = 6 End With picPin(Index).BackColor = GetColor(Runde(iBuffRunde).iFarbe(iBuffPin)) End If End Sub

Zusatzinformationen

» Wikipedia-Artikel zum Spiel Mastermind.
» Quellcode-Download zum Artikel.

ANZEIGE <leer>
<leer> Aktuelle Seite Back To Top
Druckansicht | Feedback | Favoriten
Copyright © Visual Basic World, 2000-2014 | Kontakt | Impressum

Visual Basic World @ Twitter

Folgen Sie Visual Basic World!

Visual Basic World @ Twitter
Wenn Ihnen Visual Basic World gefällt, dann folgen Sie uns doch bei Twitter (@visualbasicwrld).
Vielen Dank!



Fragen & Forum

Wenn Sie offene Fragen zur Programmierung mit Visual Basic haben und in der Tipps & Tricks Sektion oder bei den Tutorials nicht fündig wurden, dann werfen Sie doch einen Blick ins Visual Basic World Forum.


Visual Basic World Forum

Im Forum erhalten Sie schnell Hilfe und finden eine Vielzahl an bereits beantworteten Fragen und Problemen.

Viel Vergnügen bei der Benutzung!


Fotografie & Design

Fotograf in Mannheim und Heidelberg.

Mitarbeiter gesucht

Für das aktuelle Redesign und die zukünftige Betreuung von visualbasicworld.de suchen wir Unterstützung und Verstärkung für unser Team.

Wenn Sie über fundierte Programmierkenntnisse im Bereich Visual Basic und/oder HTML/CSS verfügen und Spaß daran haben in Ihrer Freizeit anderen Ihr Wissen zu vermitteln, dann Sie uns und werden Sie ein Teil des Visualbasicworld-Teams.