Code-Bin #59 - Horse Racing Visual Basic

Horse Racing Visual Basic
Posted by: Adam | November 11, 2007 @ 2:30pm

VisualBasic Code

Option Explicit

Dim UserBet As Long
Dim UserHorse As Integer
Dim UserWallet As Long

Dim Horses As Variant
Dim HorsesFinished As Integer
Dim OrderOfBrilliance As String
Dim RealOrder(0 To 3) As Integer

Dim StartCount As Integer
Dim ElapsedTime As Integer
Dim HorseTimes(0 To 3) As Integer
Dim HorseMovement(0 To 3) As Integer
Dim HorseOdds(0 To 3) As Integer

Dim KeyCount1 As String
Dim LastKey As Integer

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then
        RestartTimer.Enabled = True
        UserWallet = 500
        lblWallet.Caption = "�" & UserWallet
    ElseIf KeyAscii = 77 Then
        KeyCount1 = "M"
        LastKey = 77
    ElseIf KeyAscii = 79 And LastKey = 77 Then
        KeyCount1 = "MO"
        LastKey = 79
    ElseIf KeyAscii = 78 And LastKey = 79 Then
        KeyCount1 = "MON"
        LastKey = 78
    ElseIf KeyAscii = 69 And LastKey = 78 Then
        KeyCount1 = "MONE"
        LastKey = 69
    ElseIf KeyAscii = 89 And LastKey = 69 Then
        KeyCount1 = "MONEY"
        
        If KeyCount1 = "MONEY" Then
            UserWallet = "30000"
            lblWallet.Caption = "�" & UserWallet
        End If
    End If
End Sub

Private Sub Form_Load()
    Debug.Print "---App Start"
    
    ' Setup Horse env variables
    Horses = Array("Ace", "Aftershock", "Maestro", "Sabre")
    
    Call SetHorse
    
    Dim j As Integer
    For j = LBound(Horses) To UBound(Horses)
        ' Show visible information about horses
        cmbHorses.AddItem Horses(j)
        lblHorse(j).Caption = Horses(j) & " on track " & j + 1 & " at " & HorseOdds(j) & ":1"
    Next
    
    ' Store and show the user's pot
    UserWallet = 500
    lblWallet.Caption = "�" & UserWallet
    
    ' Starting countdown timer
    StartCount = 5
    
    ' Elapsed time count
    ElapsedTime = 1
End Sub

Private Sub SetHorse()
    Debug.Print "---HORSE VALUES---"
    
    Dim i As Integer
    For i = 0 To 3
        ' Calculate horse transport times
        Randomize
        HorseTimes(i) = CInt((5 - 1 + 1) * Rnd + 1)
        
        HorseMovement(i) = CInt(8020 * (HorseTimes(i) / 1000))
        HorseTimer(i).Interval = HorseTimes(i)
        Debug.Print "Horse " & i + 1 & " interval: " & HorseMovement(i)
        Debug.Print "Horse " & i + 1 & " time: " & HorseTimer(i).Interval
    Next
    
    Dim j As Integer
    For j = 0 To 3
        ' Calculate horse odds
        Randomize
        HorseOdds(j) = CInt((5 - 1 + 1) * Rnd + 1)
        
        Debug.Print "Horse  " & j + 1 & " has odds: " & HorseOdds(j) & ":1"
    Next
End Sub

Private Sub cmbHorses_Click()
    ' When a horse is selected, let the user place a bet
    lblChoice.Visible = True
    lblBet.Visible = True
    lblBet2.Visible = True
    txtBet.Visible = True
End Sub

Private Sub txtBet_Change()
On Error GoTo TypeMismatchHandler
    
    ' Some error checking to prevent users entering spurious data,
    ' i.e. text instead of integers
    If Not txtBet.Text = "" Then
        ' Preventing buffer overflows..
        If CLng(txtBet.Text) >= 5 And Len(txtBet.Text) < 5 Then
            cmdBet.Visible = True
        End If
    Else
        cmdBet.Visible = False
    End If
    
    Exit Sub
    
TypeMismatchHandler:
    txtBet.Text = ""
End Sub

Private Sub cmdBet_Click()
On Error GoTo TypeMismatchHandler
    
    ' Similar error checks as before, but repeated for  safety
    If Not txtBet.Text = "" And Len(txtBet.Text) < 5 Then
        If CLng(txtBet.Text) >= 5 And CLng(txtBet.Text) <= 1000 Then
            ' Make sure that the user isn't betting more than they can pull
            If UserWallet - CLng(txtBet.Text) < 0 Then
                lblBetDone.Caption = "Sorry, you do not have enough money to make that bet."
            Else
                Debug.Print "---BET MADE---"
                
                ' Update the user's pot
                UserWallet = UserWallet - CLng(txtBet.Text)
                lblWallet.Caption = "�" & UserWallet
                
                Debug.Print "User Money: " & UserWallet
                
                ' Store betting information
                ' Horse and amount bet
                UserHorse = cmbHorses.ListIndex
                UserBet = CLng(txtBet.Text)
                
                Debug.Print "User Bet: " & UserBet
                
                ' Prevent the user from making any further changes to bet
                cmdBet.Enabled = False
                txtBet.Enabled = False
                cmbHorses.Enabled = False
                
                lblBetDone.Caption = "Great! Your bet has been placed. Now get to the track, the race is about to begin!"
                
                ' Enable race timer so that the race can begin
                RaceStartTimer.Enabled = True
            End If
        Else
            lblBetDone.Caption = "Sorry, you can not make a bet of such an amount."
        End If
    Else
        lblBetDone.Caption = "Sorry, that is not a valid amount to bet."
    End If
        
    Exit Sub

TypeMismatchHandler:
    lblBetDone.Caption = "There was a problem with your request."
End Sub

Private Sub RaceStartTimer_Timer()
    If Not StartCount <= 0 Then
        lblTimer.Caption = StartCount
    Else
        Debug.Print "---RACE STARTED---"
        lblTimer.Visible = False
        RaceStartTimer.Enabled = False
        
        ' Show the race track
        lblBegun.Visible = True
        lblTrackStart.Visible = True
        lblTrackStart2.Visible = True
        lblTrackEnd.Visible = True
        lblTrackEnd2.Visible = True
        lblTrack1.Visible = True
        lblTrack2.Visible = True
        lblTrack3.Visible = True
        lblTrack4.Visible = True
        shpTrack1.Visible = True
        shpTrack2.Visible = True
        shpTrack3.Visible = True
        shpTrack4.Visible = True
        shpEndLine.Visible = True
        shpStartLine.Visible = True
        
        NRaceHorse(0).Visible = True
        NRaceHorse(1).Visible = True
        NRaceHorse(2).Visible = True
        NRaceHorse(3).Visible = True
        
        lblTime.Visible = True
        lblTheTimer.Visible = True
        HorseTimer(0).Enabled = True
        HorseTimer(1).Enabled = True
        HorseTimer(2).Enabled = True
        HorseTimer(3).Enabled = True
        Timer.Enabled = True
    End If
    
    StartCount = StartCount - 1
End Sub

Private Sub Timer_Timer()
    lblTheTimer.Caption = "0:" & ElapsedTime
    
    ElapsedTime = ElapsedTime + 1
End Sub

Private Sub HorseTimer_Timer(Index As Integer)
    NRaceHorse(Index).Left = NRaceHorse(Index).Left + HorseMovement(Index)
    
    'Debug.Print "Horse " & Index & " is at Left val " & NRaceHorse(Index).Left
    If NRaceHorse(Index).Left >= 13300 Then
        Debug.Print "Horse " & Index & " finished at Left val " & NRaceHorse(Index).Left
        HorseTimer(Index).Enabled = False
        HorsesFinished = HorsesFinished + 1
        
        If OrderOfBrilliance = "r" Then
            OrderOfBrilliance = CStr(Index)
        Else
            OrderOfBrilliance = OrderOfBrilliance & CStr(Index)
        End If
    End If
    
    If HorsesFinished = 4 Then
        Debug.Print "Horse " & Index + 1 & " has finished the race last."
        Timer.Enabled = False
    End If
    
    If Len(OrderOfBrilliance) = 4 Then
        Debug.Print "End of race proc called"
        Call HorsesEnd
    End If
End Sub

Private Sub HorsesEnd()
    Debug.Print "End of race proc started"
    
    Dim i As Integer
    For i = 0 To 3
        Dim SplitString(0 To 3) As String
        RealOrder(i) = Mid(OrderOfBrilliance, i + 1, 1)
    Next
    
    TableTimer.Enabled = True
End Sub

Private Sub TableTimer_Timer()
    Debug.Print "---TRACK HIDDEN---"
    
    lblTrackStart.Visible = False
    lblTrackStart2.Visible = False
    lblTrackEnd.Visible = False
    lblTrackEnd2.Visible = False
    lblTrack1.Visible = False
    lblTrack2.Visible = False
    lblTrack3.Visible = False
    lblTrack4.Visible = False
    shpTrack1.Visible = False
    shpTrack2.Visible = False
    shpTrack3.Visible = False
    shpTrack4.Visible = False
    shpEndLine.Visible = False
    shpStartLine.Visible = False
    
    NRaceHorse(0).Visible = False
    NRaceHorse(1).Visible = False
    NRaceHorse(2).Visible = False
    NRaceHorse(3).Visible = False
    
    lblTime.Visible = False
    lblTheTimer.Visible = False
    
    '''-------------------------
    
    lblBegun.Caption = "The Winners Are:"
    
    lblPos1.Visible = True
    lblPos2.Visible = True
    lblPos3.Visible = True
    lblPos4.Visible = True
    
    lblStatDesc.Visible = True
    lblWinLoss.Visible = True
    
    lblComfort.Visible = True
    
    Dim i As Integer
    For i = 0 To 3
        lblPos(i).Visible = True
        lblPos(i).Caption = Horses(RealOrder(i))
    Next
    
    If RealOrder(0) = UserHorse Then
        lblWinLoss.Caption = ", at the odds " & HorseOdds(UserHorse) & ":1, won �" & UserBet * HorseOdds(UserHorse) & "!"
        UserWallet = UserWallet + (UserBet * HorseOdds(UserHorse))
        lblComfort.Caption = "Well done! Now let's see if you can double that sum."
    Else
        lblWinLoss.Caption = "lost �" & UserBet & "!"
        lblComfort.Caption = "Better luck next time! Play again! Let's see if you can regain your loss!"
    End If
    
    If UserWallet > 0 Then
        lblWallet.Caption = "�" & UserWallet
    End If
    
    lblRestart.Visible = True
    
    TableTimer.Enabled = False
    RestartTimer.Enabled = True
End Sub

Private Sub RestartTimer_Timer()
    Debug.Print "-----RACE RESTARTED-----"
    
    lblTrackStart.Visible = False
    lblTrackStart2.Visible = False
    lblTrackEnd.Visible = False
    lblTrackEnd2.Visible = False
    lblTrack1.Visible = False
    lblTrack2.Visible = False
    lblTrack3.Visible = False
    lblTrack4.Visible = False
    shpTrack1.Visible = False
    shpTrack2.Visible = False
    shpTrack3.Visible = False
    shpTrack4.Visible = False
    shpEndLine.Visible = False
    shpStartLine.Visible = False
    
    NRaceHorse(0).Visible = False
    NRaceHorse(1).Visible = False
    NRaceHorse(2).Visible = False
    NRaceHorse(3).Visible = False
    
    lblTime.Visible = False
    lblTheTimer.Visible = False
    
    lblBegun.Caption = "And they're off!"
    lblBegun.Visible = False
    
    lblPos1.Visible = False
    lblPos2.Visible = False
    lblPos3.Visible = False
    lblPos4.Visible = False
    
    lblStatDesc.Visible = False
    lblWinLoss.Visible = False
    lblComfort.Visible = False
    
    lblTimer.Caption = ""
    lblTimer.Visible = True
    
    OrderOfBrilliance = "r"
    
    RealOrder(0) = 0
    RealOrder(1) = 0
    RealOrder(2) = 0
    RealOrder(3) = 0
    
    HorseOdds(0) = 0
    HorseOdds(1) = 0
    HorseOdds(2) = 0
    HorseOdds(3) = 0
    
    UserHorse = -1
    
    HorsesFinished = 0
    
    UserBet = 0
    
    Dim i As Integer
    For i = 0 To 3
        lblPos(i).Visible = False
    Next
    
    Dim j As Integer
    For j = 0 To 3
        NRaceHorse(j).Left = 5280
    Next
    
    lblTheTimer.Caption = "0:00"
    
    cmdBet.Enabled = True
    cmdBet.Visible = False
    txtBet.Enabled = True
    txtBet.Visible = False
    txtBet.Text = ""
    cmbHorses.Enabled = True
    
    lblChoice.Visible = False
    lblBet.Visible = False
    lblBet2.Visible = False
    lblBetDone.Caption = ""
    
    Call SetHorse
    
    Dim k As Integer
    For k = LBound(Horses) To UBound(Horses)
        ' Show visible information about horses
        lblHorse(k).Caption = Horses(k) & " on track " & k + 1 & " at " & HorseOdds(k) & ":1"
    Next
    
    StartCount = 5
    
    ElapsedTime = 1
    
    lblRestart.Visible = False
    
    TableTimer.Enabled = False
    
    If UserWallet <= 0 Then
        UserWallet = 100
        lblWallet.Caption = "�" & UserWallet
        MsgBox ("Looks like you've run out of money. But no worries, you're in luck, a friendly banker has sent some cash your way. Let's see if you can regain your losses.")
    End If
    
    RestartTimer.Enabled = False
End Sub

Syntax Highlighting

[Open in new window]

Author Comments

none

Rating

4.59 / 8
301 Votes