frmfighter.frm

血蜘蛛决斗游戏的源码

Private a As Boolean, aa As Boolean
Private bb As Integer, b As Integer
Private i As Integer, i2 As Integer
Dim wsdata As String 'winsock data that will be send
Dim SingleSelected As Boolean
Dim KeyboardSelected As Boolean

Private Sub Form_Load()
    Randomize
    SingleSelected = False
    KeyboardSelected = False
    aaa = lblPlayerName.Caption
    aaaa = lblCompName.Caption
    f.Left = 240
    m.Left = 7560
    f.Top = 5280
    m.Top = 5280
    bb = 100
    b = 100
    l.Value = b
    w.Value = bb
    f.Picture = picPlayerForwardNormalLeft.Picture
    m.Picture = picPlayerForwardNormalRight.Picture
    lblWinner.Caption = ""
    lblFighter.ForeColor = vbRed
    Call mnuNormalItem_Click
    Call mnuSpiderNormalItem_Click
    Call mnuSpiderNormalItem2_Click
    bb = 100
    b = 100
    w.Value = bb
    l.Value = b
    tmrComputerAI.Enabled = False
    tmrCompRecover.Enabled = False
    i2 = 5
    i = 5
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If lblFighter.ForeColor = vbGreen Then
        'constant moves for left player
        If KeyCode = vbKeyRight Then
            f.Picture = picPlayerForward.Picture
            'Call sndPlaySound(App.Path & "\Sounds\Forward.wav", 1)
            If m.Left - f.Left < 1000 Then
                Exit Sub
            Else
                f.ZOrder (1)
                f.Left = f.Left + 200
            End If
        ElseIf KeyCode = vbKeyLeft Then
                If f.Left - 300 < 100 Then
                    Exit Sub
                End If
            i2 = 1
            f.ZOrder (1)
            f.Picture = picPlayerBack.Picture
            f.Left = f.Left - 200
        ElseIf KeyCode = vbKeyControl Then
            a = True
            f.ZOrder (1)
            f.Picture = picPlayerPunch.Picture
            'Call sndPlaySound(App.Path & "\Sounds\Punch.wav", 1)
        ElseIf KeyCode = vbKeyShift Then
            f.ZOrder (1)
            a = True
            f.Picture = picPlayerKick.Picture
            'Call sndPlaySound(App.Path & "\Sounds\Kick.wav", 1)
        End If
        'assign a multiplayer on keyboard right player
        If mnuTwoPlayerItem.Checked = True Then
            mnuSinglePlayerItem.Checked = False
            mnuTwoPlayer2Item.Checked = False
            If KeyCode = vbKeyA Then
                m.Picture = picCompForward.Picture
                'Call sndPlaySound(App.Path & "\Sounds\Forward.wav", 1)
                If m.Left - f.Left < 1000 Then
                    Exit Sub
                Else
                    m.ZOrder (1)
                    m.Left = m.Left - 200
                End If
            ElseIf KeyCode = vbKeyS Then
                If m.Left + 300 >= 5280 Then
                    Exit Sub
                End If
                i = 1
                m.ZOrder (1)
                m.Picture = picCompBack.Picture
                m.Left = m.Left + 200
            ElseIf KeyCode = vbKeyG Then
                aa = True
                m.ZOrder (1)
                m.Picture = picCompPunch.Picture
                'Call sndPlaySound(App.Path & "\Sounds\Punch.wav", 1)
            ElseIf KeyCode = vbKeyH Then
                m.ZOrder (1)
                aa = True
                m.Picture = picCompKick.Picture
                'Call sndPlaySound(App.Path & "\Sounds\Kick.wav", 1)
            End If
        'assign a multiplayer lan/internet connectivity left player left moves to remote right player
        ElseIf mnuTwoPlayer2Item.Checked = True Then
            mnuSinglePlayerItem.Checked = False
            mnuTwoPlayerItem.Checked = False
            If CurrentGameConnection = "Server" Then
                If KeyCode = vbKeyRight Then
                    ws.SendData "KeyRight-" & (7800 - f.Left)
                ElseIf KeyCode = vbKeyLeft Then
                    ws.SendData "KeyLeft-" & (7800 - f.Left)
                ElseIf KeyCode = vbKeyControl Then
                    ws.SendData "KeyControl"
                ElseIf KeyCode = vbKeyShift Then
                    ws.SendData "KeyShift"
                End If
            ElseIf CurrentGameConnection = "Client" Then
                If KeyCode = vbKeyRight Then
                    ws.SendData "KeyRight2-" & (7800 - f.Left)
                ElseIf KeyCode = vbKeyLeft Then
                    ws.SendData "KeyLeft2-" & (7800 - f.Left)
                ElseIf KeyCode = vbKeyControl Then
                    ws.SendData "KeyControl2"
                ElseIf KeyCode = vbKeyShift Then
                    ws.SendData "KeyShift2"
                End If
            End If
        End If
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    i = 5
    i2 = 5
    If mnuTwoPlayerItem.Checked = True Then
        If lblFighter.ForeColor = vbGreen Then
            If aa = True Then
                If m.Left - f.Left < 1000 Then
                    bb = bb - i2
                    f.Picture = picPlayerHit.Picture
                    'Call sndPlaySound(App.Path & "\Sounds\Hit.wav", 1)
                    tmrCompRecover.Enabled = True
                End If
            End If
            If w.Value - 5 = 0 Then
                tmrPlayerRecover.Enabled = False
                w.Value = bb
                f.Picture = picPlayerLoss.Picture
                'Call sndPlaySound(App.Path & "\Sounds\Win.wav", 1)
                m.Left = f.Left + f.Width
                bb = 0
                w.Value = bb
                lblCompPoints.Caption = Val(lblCompPoints.Caption) + Val(lblCompMoney.Caption)
                lblWinner.Caption = aaaa & " Wins!"
                tmrRegeneration.Enabled = False
                tmrComputerAI.Enabled = False
                lblFighter.ForeColor = vbRed
            Else
                On Error GoTo health3:
                    w.Value = bb
health3:
    If Err.Number = 380 Then
            bb = 0
            w.Value = b
            tmrPlayerRecover.Enabled = False
            w.Value = bb
            f.Picture = picPlayerLoss.Picture
            'Call sndPlaySound(App.Path & "\Sounds\Win.wav", 1)
            m.Left = f.Left + f.Width
            lblCompPoints.Caption = Val(lblCompPoints.Caption) + Val(lblCompMoney.Caption)
            lblWinner.Caption = aaaa & " Wins!"
            tmrRegeneration.Enabled = False
            tmrComputerAI.Enabled = False
            lblFighter.ForeColor = vbRed
        End If

            End If
        m.Picture = picCompNone.Picture
        aa = False
    End If
End If
'///////////////////////////////////////////////////////////////////
    If lblFighter.ForeColor = vbGreen Then
        If a = True Then
            If m.Left - f.Left < 1000 Then
                b = b - i
                m.Picture = picCompHit.Picture
                'Call sndPlaySound(App.Path & "\Sounds\Hit.wav", 1)
                tmrCompRecover.Enabled = True
            End If
        End If
    
            If l.Value - 5 = 0 Then
                tmrCompRecover.Enabled = False
                l.Value = b
                m.Picture = picCompLoss.Picture
                'Call sndPlaySound(App.Path & "\Sounds\Win.wav", 1)
                f.Left = m.Left - 2000
                b = 0
                l.Value = b
                lblPlayerPoints.Caption = Val(lblPlayerPoints.Caption) + Val(lblPlayerMoney.Caption)
                lblWinner.Caption = aaa & " Wins!"
                tmrRegeneration.Enabled = False
                tmrComputerAI.Enabled = False
                lblFighter.ForeColor = vbRed
            Else
            On Error GoTo health2:
                l.Value = b
health2:
        If Err.Number = 380 Then
            b = 0
            l.Value = b
            tmrCompRecover.Enabled = False
            l.Value = b
            m.Picture = picCompLoss.Picture
            'Call sndPlaySound(App.Path & "\Sounds\Win.wav", 1)
            f.Left = m.Left - 2000
            lblPlayerPoints.Caption = Val(lblPlayerPoints.Caption) + Val(lblPlayerMoney.Caption)
            lblWinner.Caption = aaa & " Wins!"
            tmrRegeneration.Enabled = False
            tmrComputerAI.Enabled = False
            lblFighter.ForeColor = vbRed
        End If
            End If
        
        f.Picture = picPlayerNone.Picture
        a = False
    End If
End Sub

Private Sub mnuControlsItem_Click()
    frmControls.Show vbModal
End Sub

Private Sub mnuCreditsItem_Click()
    frmCredits.Show vbModal
End Sub

Private Sub mnuExitItem_Click()
    Unload frmControls
    Unload frmCredits
    Unload Me
End Sub

Private Sub mnuFightItem_Click()
    lblFighter.ForeColor = vbGreen
    If mnuSinglePlayerItem.Checked = True Then
        mnuDifficultyItem.Enabled = False
        tmrComputerAI.Enabled = True
        tmrCompRecover.Enabled = False
        Randomize
        f.Left = 240
        m.Left = 7560
        f.Top = 5280
        m.Top = 5280
        bb = 100
        b = 100
        l.Value = b
        w.Value = bb
        m.Picture = picCompNone.Picture
        f.Picture = picPlayerNone.Picture
        lblWinner.Caption = ""
        tmrRegeneration.Enabled = True
        bb = 100
        b = 100
        w.Value = bb
        l.Value = b
        tmrComputerAI.Enabled = True
        tmrCompRecover.Enabled = False
        i2 = 5
        i = 5
        mnuFightItem.Enabled = True
        mnuDifficultyItem.Enabled = True
    ElseIf mnuTwoPlayerItem.Checked = True Or mnuTwoPlayer2Item.Checked = True Then
        mnuFightItem.Enabled = False
        mnuDifficultyItem.Enabled = False
        tmrComputerAI.Enabled = False
        tmrCompRecover.Enabled = False
        Randomize
        f.Left = 240
        m.Left = 7560
        f.Top = 5280
        m.Top = 5280
        bb = 100
        b = 100
        l.Value = b
        w.Value = bb
        m.Picture = picCompNone.Picture
        f.Picture = picPlayerNone.Picture
        lblWinner.Caption = ""
        bb = 100
        b = 100
        tmrRegeneration.Enabled = True
        w.Value = bb
        l.Value = b
        tmrComputerAI.Enabled = False
        tmrCompRecover.Enabled = False
        i2 = 5
        i = 5
        mnuFightItem.Enabled = True
    End If
End Sub

Private Sub mnuHowtoPlayItem_Click()
    MsgBox "The object of the game is to eliminate your opponnent." & vbCrLf & _
            "And from there you can earn money and can be added to each" & vbCrLf & _
            "player and used the earned money as points that can be used" & vbCrLf & _
            "to buy yourself a new fighting spider according to its price." & vbCrLf & _
            "There are threee (3) set of games in which you can choose" & vbCrLf & _
            "and each of them have different set of game options." & vbCrLf & _
            "Just click on the Game Menu and you may select a game play." & vbCrLf & _
            "There are shortcut keys that you could use for your own convenience." & vbCrLf & _
            "Have fun with this game!!", vbOKOnly + vbInformation, "How to Play:"
End Sub

Private Sub mnuSpiderInformation_Click()
    frmSpiderInfo.Show
End Sub
 
Private Sub mnuNormalItem_Click()
    On Error GoTo ErrorLoad
    CurrentSpiderStage = "Normal"
    Me.Picture = LoadPicture(App.Path + "\Graphics\Default Background.jpg")
    mnuNormalItem.Checked = True
    mnuEasyItem.Checked = False
    mnuMediumItem.Checked = False
    mnuHardItem.Checked = False
    Exit Sub
ErrorLoad:
    MsgBox "Cannot find Default Background!", vbOKOnly + vbCritical, "Warning:"
End Sub

Private Sub mnuEasyItem_Click()
    On Error GoTo ErrorLoad
    CurrentSpiderStage = "Easy"
    Me.Picture = LoadPicture(App.Path + "\Graphics\House Background.jpg")
    mnuNormalItem.Checked = False
    mnuEasyItem.Checked = True
    mnuMediumItem.Checked = False
    mnuHardItem.Checked = False
    Exit Sub
ErrorLoad:
    MsgBox "Cannot find House Background!", vbOKOnly + vbCritical, "Warning:"
End Sub

Private Sub mnuMediumItem_Click()
    On Error GoTo ErrorLoad
    CurrentSpiderStage = "Medium"
    Me.Picture = LoadPicture(App.Path + "\Graphics\Basketball Background.jpg")
    mnuNormalItem.Checked = False
    mnuEasyItem.Checked = False
    mnuMediumItem.Checked = True
    mnuHardItem.Checked = False
    Exit Sub
ErrorLoad:
    MsgBox "Cannot find Basketball Court Background!", vbOKOnly + vbCritical, "Warning:"
End Sub

Private Sub mnuHardItem_Click()
    On Error GoTo ErrorLoad
    CurrentSpiderStage = "Hard"
    Me.Picture = LoadPicture(App.Path + "\Graphics\Playground Background.jpg")
    mnuNormalItem.Checked = False
    mnuEasyItem.Checked = False
    mnuMediumItem.Checked = False
    mnuHardItem.Checked = True
    Exit Sub
ErrorLoad:
    MsgBox "Cannot find Playground Background!", vbOKOnly + vbCritical, "Warning:"
End Sub

Private Sub mnuSinglePlayerItem_Click()
    CurrentGameType = "Singleplayer"
    mnuSinglePlayerItem.Checked = True
    mnuTwoPlayerItem.Checked = False
    mnuTwoPlayer2Item.Checked = False
    mnuDifficultyItem.Enabled = True
    If SingleSelected = False Then
        Do
            aaa = InputBox("Enter the player's name", "Fighter")
            If aaa = "" Then
                MsgBox ("Sorry, but that was an invalid name" & vbCrLf & "Please enter another name"), vbExclamation, "Fighte