VERSION 5.00 Begin VB.Form frmConcentration BackColor = &H00E0E0E0& BorderStyle = 1 'Fixed Single Caption = "Concentration" ClientHeight = 6735 ClientLeft = 2925 ClientTop = 2640 ClientWidth = 9165 ControlBox = 0 'False LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6735 ScaleWidth = 9165 Begin VB.Frame Frame2 BackColor = &H00E0E0E0& Caption = "Best Scores" BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2775 Left = 7500 TabIndex = 7 Top = 3840 Width = 1515 Begin VB.CommandButton cmdReset BackColor = &H00E0E0E0& Caption = "&Reset" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 855 Left = 120 Picture = "Concen.frx":0000 Style = 1 'Graphical TabIndex = 12 Top = 1800 Width = 1275 End Begin VB.Label lblRecTurns Alignment = 2 'Center BackColor = &H00000000& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 315 Left = 300 TabIndex = 11 Top = 1200 Width = 855 End Begin VB.Label lblRecTime Alignment = 2 'Center BackColor = &H00000000& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 315 Left = 300 TabIndex = 9 Top = 540 Width = 855 End Begin VB.Label Label10 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Time:" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 420 TabIndex = 8 Top = 240 Width = 510 End Begin VB.Label Label8 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "# Turns:" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 300 TabIndex = 10 Top = 900 Width = 810 End End Begin VB.Frame Frame1 BackColor = &H00E0E0E0& Caption = "This Game" BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1635 Left = 7500 TabIndex = 2 Top = 2100 Width = 1515 Begin VB.Label Label6 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "# Turns:" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 345 TabIndex = 5 Top = 900 Width = 810 End Begin VB.Label lblNbrOfTurns Alignment = 2 'Center BackColor = &H00000000& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 315 Left = 300 TabIndex = 6 Top = 1200 Width = 855 End Begin VB.Label Label5 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Time:" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 465 TabIndex = 3 Top = 240 Width = 510 End Begin VB.Label lblElapsedTime Alignment = 2 'Center BackColor = &H00000000& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 315 Left = 300 TabIndex = 4 Top = 540 Width = 855 End End Begin VB.Timer tmrGamePlay Interval = 1000 Left = 8760 Top = 480 End Begin VB.CommandButton cmdExit BackColor = &H00E0E0E0& Caption = "E&xit" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 855 Left = 7620 Picture = "Concen.frx":08CA Style = 1 'Graphical TabIndex = 1 Top = 1140 Width = 1275 End Begin VB.CommandButton cmdNewGame BackColor = &H00E0E0E0& Caption = "&New Game" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 855 Left = 7620 Picture = "Concen.frx":1194 Style = 1 'Graphical TabIndex = 0 Top = 180 Width = 1275 End Begin VB.Image imgGameCard Height = 1500 Index = 23 Left = 6240 Stretch = -1 'True Top = 5100 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 22 Left = 5040 Stretch = -1 'True Top = 5100 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 21 Left = 3840 Stretch = -1 'True Top = 5100 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 20 Left = 2640 Stretch = -1 'True Top = 5100 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 19 Left = 1440 Stretch = -1 'True Top = 5100 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 18 Left = 240 Stretch = -1 'True Top = 5100 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 17 Left = 6240 Stretch = -1 'True Top = 3480 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 16 Left = 5040 Stretch = -1 'True Top = 3480 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 15 Left = 3840 Stretch = -1 'True Top = 3480 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 14 Left = 2640 Stretch = -1 'True Top = 3480 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 13 Left = 1440 Stretch = -1 'True Top = 3480 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 12 Left = 240 Stretch = -1 'True Top = 3480 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 11 Left = 6240 Stretch = -1 'True Top = 1860 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 10 Left = 5040 Stretch = -1 'True Top = 1860 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 9 Left = 3840 Stretch = -1 'True Top = 1860 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 8 Left = 2640 Stretch = -1 'True Top = 1860 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 7 Left = 1440 Stretch = -1 'True Top = 1860 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 6 Left = 240 Stretch = -1 'True Top = 1860 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 5 Left = 6240 Stretch = -1 'True Top = 240 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 4 Left = 5040 Stretch = -1 'True Top = 240 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 3 Left = 3840 Stretch = -1 'True Top = 240 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 2 Left = 2640 Stretch = -1 'True Top = 240 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 1 Left = 1440 Stretch = -1 'True Top = 240 Width = 1080 End Begin VB.Image imgGameCard Height = 1500 Index = 0 Left = 240 Stretch = -1 'True Top = 240 Width = 1080 End End Attribute VB_Name = "frmConcentration" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private mintGameCards(0 To 23) As Integer Private mintClickCount As Integer Private mintFirstCard As Integer Private mintSecondCard As Integer Private mintMatches As Integer Private mintElapsedMins As Integer Private mintElapsedSecs As Integer Private mintNbrOfTurns As Integer Private mstrFileName As String Private mstrBestTime As String Private mintBestTurns As Integer Private Sub Form_Load() Dim strBackSlash As String CenterForm Me strBackSlash = IIf(Right$(App.Path, 1) = "\", "", "\") mstrFileName = App.Path & strBackSlash & "CONBEST.TXT" If Dir(mstrFileName) = "" Then Open mstrFileName For Output As #1 Write #1, "99:99", 9999 Close #1 End If cmdNewGame_Click End Sub Private Sub Form_Unload(Cancel As Integer) Unload frmCards End Sub Private Sub imgGameCard_Click(Index As Integer) Dim strMsg As String mintClickCount = mintClickCount + 1 If mintClickCount = 1 Then mintFirstCard = Index imgGameCard(Index) = frmCards.imgCard(mintGameCards(Index)) Else mintSecondCard = Index imgGameCard(Index) = frmCards.imgCard(mintGameCards(Index)) mintNbrOfTurns = mintNbrOfTurns + 1 lblNbrOfTurns = mintNbrOfTurns WaitASecond If mintGameCards(mintFirstCard) = mintGameCards(mintSecondCard) Then imgGameCard(mintFirstCard).Enabled = False imgGameCard(mintSecondCard).Enabled = False mintMatches = mintMatches + 1 If mintMatches = 12 Then tmrGamePlay.Enabled = False If lblElapsedTime < mstrBestTime _ Or mintNbrOfTurns < mintBestTurns Then Open mstrFileName For Output As #1 If lblElapsedTime < mstrBestTime _ And mintNbrOfTurns < mintBestTurns Then strMsg = "Congratulations! You set new records for both " _ & "best time and fewest number of turns." lblRecTime = lblElapsedTime lblRecTurns = lblNbrOfTurns ElseIf lblElapsedTime < mstrBestTime Then strMsg = "Congratulations! You set a new record for " _ & "best time." lblRecTime = lblElapsedTime Else strMsg = "Congratulations! You set a new record for " _ & "fewest number of turns." lblRecTurns = lblNbrOfTurns End If Write #1, lblRecTime, Val(lblRecTurns) Close #1 MsgBox strMsg, vbExclamation, "New Record" End If End If Else imgGameCard(mintFirstCard) = frmCards.imgCard(0) imgGameCard(mintFirstCard).Enabled = True imgGameCard(mintSecondCard) = frmCards.imgCard(0) imgGameCard(mintSecondCard).Enabled = True End If mintClickCount = 0 End If End Sub Private Sub cmdNewGame_Click() Dim intX As Integer Dim intY As Integer Dim intCardNbr As Integer Dim blnGoodCardNumber As Boolean Dim intImageNbr As Integer Dim blnGoodImageNumber As Boolean Dim blnCardNbrSelected(1 To 52) As Boolean Dim blnImageSelected(0 To 23) As Boolean Open mstrFileName For Input As #1 Input #1, mstrBestTime, mintBestTurns Close #1 lblRecTime.Caption = mstrBestTime lblRecTurns.Caption = mintBestTurns Randomize mintMatches = 0 mintElapsedMins = 0 mintElapsedSecs = 0 mintNbrOfTurns = 0 lblElapsedTime = "" lblNbrOfTurns = "" For intX = 0 To 23 With imgGameCard(intX) .Visible = True .Picture = frmCards.imgCard(0) .Enabled = True End With Next For intX = 1 To 12 blnGoodCardNumber = False Do intCardNbr = 1 + Int(52 * Rnd) If Not blnCardNbrSelected(intCardNbr) Then blnCardNbrSelected(intCardNbr) = True blnGoodCardNumber = True For intY = 1 To 2 blnGoodImageNumber = False Do intImageNbr = Int(24 * Rnd) If Not blnImageSelected(intImageNbr) Then blnGoodImageNumber = True blnImageSelected(intImageNbr) = True mintGameCards(intImageNbr) = intCardNbr End If Loop Until blnGoodImageNumber Next End If Loop Until blnGoodCardNumber Next tmrGamePlay.Enabled = True End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdReset_Click() If MsgBox("Are you sure you want to reset the best scores?", _ vbQuestion + vbYesNo + vbDefaultButton2, _ "Reset Best Scores") = vbNo Then Exit Sub End If Open mstrFileName For Output As #1 Write #1, "99:99", 9999 Close #1 End Sub Private Sub WaitASecond() Dim sngStart As Single Me.Enabled = False sngStart = Timer Do While Timer < sngStart + 1 DoEvents Loop Me.Enabled = True End Sub Private Sub tmrGamePlay_Timer() mintElapsedSecs = mintElapsedSecs + 1 If mintElapsedSecs > 59 Then mintElapsedMins = mintElapsedMins + 1 If mintElapsedMins > 59 Then If MsgBox("Time's Up! Do you want to start a new game?", _ vbQuestion + vbYesNo, "Concentration") = vbYes Then cmdNewGame_Click Else Unload Me End If Exit Sub End If mintElapsedSecs = 0 End If lblElapsedTime = Format$(mintElapsedMins, "00") & ":" _ & Format$(mintElapsedSecs, "00") End Sub