frmgame.frm

猜字迷的游戏

   Exit Sub
End If

If CLng(x) < 0 Then
   MsgBox "输入错误", , Me.Caption
   Exit Sub
End If

If CheckSameNumber(x) = True Then
   MsgBox "数字重覆，请重新输入", , Me.Caption
   Exit Sub
End If

UserNumber = x

If ConnectStatus = True Then
   SendMsgToUser GAME_MSG & MSG_GAME_START & Format$(GAME_NUMBER, "0") & UserNumber
   GameSetUP.Enabled = False
   cmdGameStart.Enabled = False
   Me.Caption = "请稍候...传送资料中....正在等待对方回应....."
   Exit Sub
End If


Dim i%, j%
ReDim ArrayTemp(1 To (10 ^ GAME_NUMBER) - 1) As Integer

On Error GoTo CheckInputError

CPUNumber = ""
CPUArraySUM = 0
lstCPURecord.Clear
lstUserRecord.Clear
txtUserInput.Text = ""
txtCPUInput.Text = ""

Call GetRandomArray(10, 10)
For i% = 1 To GAME_NUMBER
    CPUNumber = CPUNumber & Format$(rndFlag(i) - 1, "0")
Next i%
For i% = 1 To (10 ^ GAME_NUMBER) - 1
    If CheckSameNumber(Format$(i%, FormatString)) <> True Then
       CPUArraySUM = CPUArraySUM + 1
       ArrayTemp(CPUArraySUM) = i%
    End If
Next i%

ReDim CPUArray(1 To CPUArraySUM)
For i% = 1 To CPUArraySUM
    CPUArray(i%) = ArrayTemp(i%)
Next i%

lblUserNumber = UserNumber
lblCPUNumber = CPUNumber
txtUserInput.Enabled = True
GameSetUP.Enabled = False
NetButter.Enabled = False

With cmdGameStart
    If .Caption = "游戏开始" Then
       .Caption = "重开新局"
    Else
       .Caption = "游戏开始"
    End If
End With

MsgBox "游戏开始", , Me.Caption
txtUserInput.SetFocus
Exit Sub

CheckInputError:
    If Err = 13 Then
          MsgBox "输入错误", , Me.Caption
    End If
    Resume QuitError
    
QuitError:
    Exit Sub
End Sub

Private Function GetRandomNo(no As Integer)
   Randomize
   GetRandomNo = Int(no * Rnd) + 1
End Function
Private Sub GetRandomArray(aNo As Integer, bNo As Integer)
   Dim i%, j%, count%
   Dim rNo As Integer
   Dim flag() As Integer

   ReDim rndFlag(1 To aNo)
   For i% = 1 To aNo
      rndFlag(i%) = 0
   Next i%

   ReDim flag(1 To bNo)
   For i% = 1 To bNo
      flag(i%) = 0
   Next i%

   For i% = 1 To aNo
      rNo = GetRandomNo(bNo - i% + 1)
      count% = 0
      For j% = 1 To bNo
         If flag(j%) = 0 Then
            count = count + 1
            If count = rNo Then
               flag(j%) = 1
               rndFlag(i%) = j%
               Exit For
            End If
         End If
      Next j%
   Next i%

   ReDim flag(0)
End Sub

Private Sub cmdSendMessage_Click()
SendMsgToUser NORMAL_MSG & txtSendMessage.Text
End Sub

Private Sub ConnectClose_Click()
'询问User是否断线,If Yes then Reset Visible Data
If MsgBox("确定要切断连线吗？", vbYesNo Or vbQuestion, Me.Caption) = vbYes Then
      If ConnectStatus = True Then
         SendMsgToUser CLOSE_MSG & "对方离线了！"
         ConnectStatus = False
      End If
      DoEvents
      GameSetUP.Enabled = True
      NetButter.Enabled = True
      ExitGame.Enabled = True
      AboutNumberGame.Enabled = True
      ConnectClose.Visible = False
      cmdGameStart.Enabled = True
      lblMyMessage.Visible = False
      lblConnectUserMessage.Visible = False
      lblUserName(1).Caption = "CPU"
      lblUserName(2).Caption = "User"
      lblSendMessage.Visible = False
      txtSendMessage.Visible = False
      cmdSendMessage.Visible = False
      wskConnect.Close
End If
End Sub

Private Sub ExitGame_Click()
'Exit Game
If MsgBox("要结束游戏了吗？", vbYesNo Or vbQuestion, Me.Caption) = vbYes Then
   Unload Me
End If
End Sub

Private Sub Form_Activate()
If cmdGameStart.Enabled Then cmdGameStart.SetFocus
End Sub
Private Sub Form_Load()

'Init Geme Level,Set From Position,Get My Computer Name,Set ConnectStatus False

Dim i As Integer
GAME_NUMBER = 3
FormatString = ""
For i% = 1 To GAME_NUMBER
     FormatString = FormatString & "0"
Next i%
LevelHard.Checked = vbUnchecked
LevelNormal.Checked = vbChecked

Dim x, y
x = (Screen.Width - Me.Width) / 2
y = (Screen.Height - Me.Height) / 2
Me.Move x, y

MyComputerName = frmGame.wskConnect.LocalHostName
ConnectStatus = False
End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'如果还处于连线状态,在离开游戏前将离线的讯息送给对方
If ConnectStatus = True Then
   SendMsgToUser CLOSE_MSG & "对方离线了！"
   ConnectStatus = False
   DoEvents
End If
End Sub

Private Sub LevelEasy_Click()
Dim i As Integer
If ConnectStatus = True And ConnectType = CONNECT_CLIENT Then
   MsgBox "User端不能设定游戏难度，请由Server端设定", , Me.Caption
   Exit Sub
End If

GAME_NUMBER = 2
FormatString = ""
For i% = 1 To GAME_NUMBER
     FormatString = FormatString & "0"
Next i%
LevelHard.Checked = vbUnchecked
LevelNormal.Checked = vbUnchecked
LevelEasy.Checked = vbChecked
End Sub

Private Sub LevelHard_Click()
Dim i As Integer
If ConnectStatus = True And ConnectType = CONNECT_CLIENT Then
   MsgBox "User端不能设定游戏难度，请由Server端设定", , Me.Caption
   Exit Sub
End If

GAME_NUMBER = 4
FormatString = ""
For i% = 1 To GAME_NUMBER
     FormatString = FormatString & "0"
Next i%
LevelHard.Checked = vbChecked
LevelNormal.Checked = vbUnchecked
LevelEasy.Checked = vbUnchecked
End Sub
Private Sub LevelNormal_Click()
Dim i As Integer
If ConnectStatus = True And ConnectType = CONNECT_CLIENT Then
   MsgBox "User端不能设定游戏难度，请由Server端设定", , Me.Caption
   Exit Sub
End If

GAME_NUMBER = 3
FormatString = ""
For i% = 1 To GAME_NUMBER
     FormatString = FormatString & "0"
Next i%
LevelHard.Checked = vbUnchecked
LevelNormal.Checked = vbChecked
LevelEasy.Checked = vbUnchecked
End Sub



Private Sub NetButter_Click()
frmNetConnect.Show 1
End Sub

Private Sub txtSendMessage_KeyPress(KeyAscii As Integer)
'If KeyPress Enter then Send Message to User
If KeyAscii = 13 Then
   KeyAscii = 0
   SendMsgToUser NORMAL_MSG & txtSendMessage.Text
End If
End Sub


Private Sub txtUserInput_KeyPress(KeyAscii As Integer)
'假如按了Enter就Check猜的数字对不对,有没有赢,
'如果处于连线状态,再将资料传给对方
If KeyAscii = 13 Then
   KeyAscii = 0
   If ConnectStatus = True Then
      If CheckUserNumber(txtUserInput.Text, CPUNumber) <> True Then
         txtUserInput.Enabled = False
         SendMsgToUser GAME_MSG & MSG_INPUT_OK & lstUserRecord.List(lstUserRecord.ListCount - 1)
      Else
         cmdGameStart.Enabled = True
         GameSetUP.Enabled = True
         txtUserInput.Enabled = False
         SendMsgToUser GAME_MSG & MSG_GAME_WIN & lstUserRecord.List(lstUserRecord.ListCount - 1)
      End If
      Exit Sub
   End If
   If CheckUserNumber(txtUserInput.Text, CPUNumber) <> True Then
      If txtUserInput.Enabled = True Then
         txtUserInput.SelStart = 0
         txtUserInput.SelLength = GAME_NUMBER
         txtUserInput.SetFocus
      End If
   Else
      cmdGameStart.Caption = "游戏开始"
      txtUserInput.Enabled = False
      GameSetUP.Enabled = True
      NetButter.Enabled = True
      MsgBox "You Win！！", , Me.Caption
   End If
ElseIf KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then
   KeyAscii = 0
End If
End Sub





Private Sub wskConnect_Close()
lblSendMessage.Visible = False
txtSendMessage.Visible = False
cmdSendMessage.Visible = False
End Sub

Private Sub wskConnect_Connect()
Call ResetConnectData
End Sub

Private Sub wskConnect_ConnectionRequest(ByVal requestID As Long)
If wskConnect.State <> sckClosed Then
   wskConnect.Close
   ConnectStatus = False
End If
'接受具有 requestID 参数的连线。
wskConnect.Accept requestID

Call SendMsgToUser(CONNECT_MSG & "连线中")
Call ResetConnectData
End Sub
Private Sub wskConnect_DataArrival(ByVal bytesTotal As Long)
'接受对方资料的处理,判对第一个判别字元,再做对应的动作
'Normal - 对话资料, Connect - 连线成立,Game - 游戏用资料,第二个字元再分类
'Close - 断线

Dim GetMsg As String
Dim MsgType As String
wskConnect.GetData GetMsg, vbString
'ReDim dataArray(bytesTotal) As Byte            'ByteArray的接收法
'wskConnect.GetData dataArray(), vbBinaryCompare

MsgType = Left$(GetMsg, 1)
GetMsg = Right$(GetMsg, Len(GetMsg) - 1)

Select Case MsgType
Case NORMAL_MSG
     lblConnectUserMessage.Caption = GetMsg
Case CONNECT_MSG
     lblMyMessage.Caption = GetMsg
Case GAME_MSG
     Dim GameMsg As String
     GameMsg = Left$(GetMsg, 1)
     GetMsg = Right$(GetMsg, Len(GetMsg) - 1)
     Select Case GameMsg
     Case MSG_GAME_START
          If MsgBox("主机端开启了一场新游戏，难度是" & Left$(GetMsg, 1) & "位数字，你要接受吗？", vbYesNo Or vbQuestion, Me.Caption) = vbYes Then
             Dim x As String
             Call SetGAME_NUMBER(Left$(GetMsg, 1))
             UserNumber = ""
             Do Until UserNumber <> ""
                x = InputBox("请输入你要让对方猜的" & Format$(CInt(Left$(GetMsg, 1)), "0") & "位数字", Me.Caption)
                If Len(x) <> GAME_NUMBER Then
                   MsgBox "长度错误，请重新输入", , Me.Caption
                   x = ""
                End If
                
                If x <> "" Then
                   If IsNumeric(x) = False Then
                      MsgBox "输入错误", , Me.Caption
                      x = ""
                   ElseIf CLng(x) < 0 Then
                      MsgBox "输入错误", , Me.Caption
                      x = ""
                   End If
                End If

                If x <> "" Then
                   If CheckSameNumber(x) = True Then
                      MsgBox "数字重覆，请重新输入", , Me.Caption
                      x = ""
                   End If
                End If

                UserNumber = x
                CPUNumber = Right$(GetMsg, GAME_NUMBER)
             Loop
             
             lstCPURecord.Clear
             lstUserRecord.Clear
             txtUserInput.Text = ""
             txtCPUInput.Text = ""
             
             SendMsgToUser GAME_MSG & MSG_CLIENT_START & UserNumber
          Else
             SendMsgToUser GAME_MSG & MSG_CLIENT_CANCEL_START
          End If
     Case MSG_CLIENT_START
          CPUNumber = GetMsg
          lstCPURecord.Clear
          lstUserRecord.Clear
          txtUserInput.Text = ""
          txtCPUInput.Text = ""

          Me.Caption = "大家来玩猜数字"
          MsgBox "游戏开始", , Me.Caption
          If (GetRandomNo(9999) Mod 2) = 0 Then
             SendMsgToUser GAME_MSG & MSG_INPUT_OK
             DoEvents
             SendMsgToUser NORMAL_MSG & "你是先手"
          Else
             SendMsgToUser NORMAL_MSG & "我是先手"
             txtUserInput.Enabled = True
             txtUserInput.SetFocus
             txtUserInput.SelStart = 0
             txtUserInput.SelLength = GAME_NUMBER
          End If
     Case MSG_CLIENT_CANCEL_START
          Me.Caption = "大家来玩猜数字"
          MsgBox "User端拒绝开始游戏的要求", , Me.Caption
          cmdGameStart.Enabled = True
          GameSetUP.Enabled = True
     Case MSG_INPUT_OK
          txtUserInput.Enabled = True
          txtUserInput.SetFocus
          txtUserInput.SelStart = 0
          txtUserInput.SelLength = GAME_NUMBER
          If GetMsg <> "" Then lstCPURecord.AddItem GetMsg
     Case MSG_GAME_WIN
          cmdGameStart.Enabled = True
          GameSetUP.Enabled = True
          lstCPURecord.AddItem GetMsg
          txtUserInput.Enabled = False
          MsgBox "你输了！对方的答案是" & CPUNumber, , Me.Caption
     End Select
Case CLOSE_MSG
     MsgBox GetMsg & "连线结束", vbOKOnly, Me.Caption
     
     Me.Caption = "大家来玩猜数字"
     GameSetUP.Enabled = True
     NetButter.Enabled = True
     ExitGame.Enabled = True
     AboutNumberGame.Enabled = True
     ConnectClose.Visible = False
     cmdGameStart.Enabled = True
     lblMyMessage.Visible = False
     lblConnectUserMessage.Visible = False
     lblUserName(1).Caption = "CPU"
     lblUserName(2).Caption = "User"
     wskConnect.Close
     ConnectStatus = False
End Select

Beep
End Sub