wuziclient.frm

vb游戏程序代码

    TimeWhite.Enabled = True
    Mytime = Format(Time, "hh:mm:ss")
    If TimeDisplayW.Text <> "" Then
        MidVariant = CDate(TimeDisplayW.Text)
    End If
Else
    TimeWhite.Enabled = False
    TimeBlack.Enabled = True
    Mytime = Format(Time, "hh:mm:ss")
    If TimeDisplayB.Text <> "" Then
        MidVariant = CDate(TimeDisplayB.Text)
    End If
End If



If MyColor = 0 Then
    '向服务器方发送落子信息,即点坐标和时间
    TCP2.SendData "/D:" & Str(x0) & ":" & Str(y0) & ":" & _
    TimeDisplayB.Text
Else
    TCP2.SendData "/D:" & Str(x0) & ":" & Str(y0) & ":" & _
    TimeDisplayW.Text
End If

StatusBar1.SimpleText = "请稍后，对方正在考虑......"


End Sub


'显示注册设置框,即将Frame1.Visible=True
Private Sub Register_Click()
If Register.Tag = 1 Then
    Frame1.Visible = True
'    Register.Enabled = False
    Frame2.Visible = False
    Frame5.Visible = False
    Frame6.Visible = False
    
'    Register.Tag = 2
'    Register.Enabled = True
'    Users.Enabled = True

'Else
'    Register.Enabled = True
'    Register.Tag = 1
'    TCP2.Close
'    Register.Enabled = False
'    Users.Enabled = False
'    Sendmessage.Enabled = False
    
End If
End Sub


'显示发送信息设置宽,即将Frame2.Visible=True
Private Sub Sendmessage_Click()
    Frame2.Visible = True
    Frame1.Visible = False
    Frame5.Visible = False
    Frame6.Visible = False
    
End Sub


'当选择私聊时,则显示选择用户下拉框,否则隐藏
Private Sub TalkWay_Click()
If TalkWay.ListIndex = 1 Then
    UserChoose.Visible = True
    Label5.Visible = True
Else
    Label5.Visible = False
    UserChoose.Visible = False
End If

End Sub


'这是winsock控件的DataArrival事件,是本程序的核心
Private Sub TCP2_DataArrival(ByVal bytesTotal As Long)
Dim Information As String
Dim DivideInfo As String
'Dim UserNum As Integer
Dim TimeBCount As String

'将接收到的信息放在变量Information中
TCP2.GetData Information

'提取出功能字符
If Left(Information, 1) = "/" Then
   Select Case Mid$(Information, 2, 1)
        '如果为0,表示服务器通知你已经成功地连接到服务器了
        Case 0
        
        MessageBox.Text = MessageBox.Text & "你已经连接到服务器了,请首先注册!" & _
        Chr$(13) & Chr$(10)
        
        Timer1.Enabled = False
        TimeCount = 0
        
        Connect.Caption = "下网"
        Register.Enabled = True
        
        'PlayingNum为服务器发送过来的用户代号
        PlayingNum = CInt(Mid$(Information, 4))
                
        MsgBox "你已经连接到服务器了!!"

        '如果为1,表示你已经成功注册了
        Case 1
            MessageBox.Text = MessageBox.Text & _
            "你已经成功登陆到wxp的五子棋俱乐部，希望你们" & _
            "遵守各项规章制度，提高自己的五子棋水平!" & Chr$(13) & Chr$(10)
            MsgBox "你是第" & Mid$(Information, 4) & "个登陆到本系统的用户", vbOKOnly, "注册成功"
            
            Register.Enabled = False
            Sendmessage.Enabled = True
            Users.Enabled = True
            cmdPlay.Enabled = True
            Watch.Enabled = True
            Connected = True
            
            WuziClient.Caption = WuziClient.Caption & "--" & YourNickName & "登陆"

        '如果为2,表示更新网上用户,因为在本地的用户列表中可能是很早以前的用户,
        '现在许多已经下网又可能有许多上网,所以必须更新
        Case 2
'            MessageBox.Text = MessageBox.Text + Mid$(Information, 4)
            
            
            
            For i = 1 To MaxConnect
                Use(i) = False
            Next
            
            
            DivideInfo = Mid$(Information, 4)
            temp1 = 1
            temp2 = InStr(1, DivideInfo, "|", vbTextCompare)
            
            '将原来的对象清除,然后更新
            UserChoose.Clear
            '将原来的对象清除,然后更新
            Opponent.Clear
            
            If temp2 = 0 Then
            
                MessageBox.Text = MessageBox.Text & "目前没有用户!"
            
            Else

            '顺序读取每个名字,并加入到名字列表框中
            Do While temp2 <> 0
                tempstr1 = Mid$(DivideInfo, temp1, temp2 - temp1)
            
                AllUserss(CInt(Right(tempstr1, 3))).Nickname = _
                Left(tempstr1, Len(tempstr1) - 3)
                AllUserss(CInt(Right(tempstr1, 3))).IndexNum = _
                CInt(Right(tempstr1, 3))
                
                UserChoose.AddItem Left(tempstr1, Len(tempstr1) - 3)
                Opponent.AddItem Left(tempstr1, Len(tempstr1) - 3)
                
                MessageBox.Text = MessageBox.Text & _
                AllUserss(CInt(Right(tempstr1, 3))).Nickname & Chr$(13) & Chr$(10)
                
                UserNum = UserNum + 1
                Use(CInt(Right(tempstr1, 3))) = True
                temp1 = temp2 + 1
                temp2 = InStr(temp2 + 1, DivideInfo, "|", vbTextCompare)
                
                
             
            Loop
             
             End If
'             For i = 1 To MaxConnect
'                If AllUserss(i).Index <> "" Then
          '显示shout的内容
          Case 3
                MessageBox.Text = MessageBox.Text & Mid$(Information, 4) & _
                Chr$(13) & Chr$(10)
                
          '显示私聊的内容
          Case 4
                MessageBox.Text = MessageBox.Text & Mid$(Information, 4) & _
                Chr$(13) & Chr$(10)
                

          '显示Chat内容
          Case 5
                MessageBox.Text = MessageBox.Text & Mid$(Information, 4) & _
                Chr$(13) & Chr$(10)
                
          '表示有人想找你下棋
          Case "P"
            Dim Playcolor As Integer
            Dim DetailColor As String
            Dim OneName As String
            
            '提取出对方的名字
            OneName = Mid$(Information, 4, InStr(4, Information, _
            ":", vbTextCompare) - 4)
            num1 = InStr(4, Information, ":", vbTextCompare)
            num2 = InStr(num1 + 1, Information, ":", vbTextCompare)
            '比赛方式
            Style = CInt(Mid$(Information, num1 + 1, num2 - num1 - 1))
            '找出该比赛的具体规定
            PlayStyle.ListIndex = Style
            '提取出对方想选择的颜色
            Playcolor = CInt(Mid$(Information, num2 + 1))
            
            If Playcolor = 0 Then
                MyColor = 1
                DetailColor = "黑"
            Else
                MyColor = 0
                DetailColor = "白"
            End If
            
            answer = MsgBox(OneName & "想用" & DetailColor & "棋和你下" & Chr$(13) & Chr$(10) & PlayStyle.Text, vbYesNo, "NOTECE")
            '如果同意下棋
            If answer = vbYes Then
                '向服务器发送"/A",表示接受挑战
                IfWatching = False
                TCP2.SendData "/A:" & OneName & ":" & YourNickName & ":1"
                
                If MyColor = 0 Then
                    BlackName.Caption = YourNickName
                    WhiteName.Caption = OneName
                Else
                    BlackName.Caption = OneName
                    WhiteName.Caption = YourNickName
                End If
                OpponentName = OneName
                
                Select Case Style
                    Case 1
                        CanUseTime = 60
                        EveryStepTime = 60
                        TimeCanUseCount = 60
                    Case 2
                        
                        CanUseTime = 30
                        EveryStepTime = 30
                        TimeCanUseCount = 30
                    Case 3
                        CanUseTime = 10
                        EveryStepTime = 10
                        TimeCanUseCount = 10
                    Case 4
                        CanUseTime = 0
                        EveryStepTime = 10
                        TimeCanUseCount = 10
                    Case 5
                    
                    
                End Select
                
                Call NewGame
                
                If MyColor = 0 Then
                    Mytime = Format(Time, "hh:mm:ss")
                    TimeBlack.Enabled = True
'                Else
'                    Mytime = Format(Time, "hh:mm:ss")
'                    TimeWhite.Enabled = True
                End If
                LocalPlay = False
                
            Else
                TCP2.SendData "/A:" & OneName & ":" & YourNickName & ":0"
            End If
            
            '如果为R,表示有人注册上网
            Case "R"
                MessageBox.Text = MessageBox.Text & Mid$(Information, 4) & _
                "注册上网!" & Chr$(10) & Chr$(13)
                
            '如果为Q,表示有人下网
            Case "Q"
                MessageBox.Text = MessageBox.Text & Mid$(Information, 4) & _
                "下网!" & Chr$(10) & Chr$(13)
                
            
           '如果为A,表示你挑战对方个你的回复
           Case "A"
                Ansernum = Mid$(Information, 4, InStr(4, Information, ":", vbTextCompare) - 4)
                num1 = InStr(4, Information, ":", vbTextCompare)
                OpponentName = Mid$(Information, num1 + 1)

                '如果Ansernum为1,则表示接受挑战
                If Ansernum = "1" Then
                    
                    IfWatching = False
                    Call NewGame
                    
                    If MyColor = 0 Then
                        TimeBlack.Enabled = True
                        Mytime = Format(Time, "hh:mm:ss")
                        FirstStep = True
                        
                        WhiteName.Caption = OpponentName
                        BlackName.Caption = "你走..."
                    Else
                        FirstStep = False
                        TimeWhite.Enabled = False
                        
                        WhiteName.Caption = YourNickName
                        BlackName.Caption = "对方走..."
                    End If
                        
                    
                Else
                    MsgBox "对不起" & OpponentName & "不想和你下!", vbOKOnly, "哈哈"
                End If
                
                

           '表示对方传来的落子信息,其中包含棋子的坐标,至于传来的坐标格式
           '可以参照服务器端的设定,在服务器端设定好以后,在客户端按照他的
           '规则读取数据
           Case "D"
                Dim X As Integer
                Dim Y As Integer
                Dim TempNum1 As Integer
                Dim TempNum2 As Integer
                Dim HisTime As String

                '取出横坐标
                X = CInt(Mid$(Information, 4, InStr(4, _
                Information, ":", vbTextCompare) - 4))
           
                TempNum1 = InStr(4, Information, ":", vbTextCompare)
                TempNum2 = InStr(TempNum1 + 1, Information, ":", vbTextCompare)

                '取出纵坐标
                Y = CInt(Mid$(Information, TempNum1 + 1, TempNum2 - TempNum1 - 1))

                '取出对方的使用时间
                HisTime = Mid$(Information, TempNum2 + 1)
                

                '设定为可以落子模式
                Drawing = True
                Mytime = Format(Time, "hh:mm:ss")

                '将棋子信息加入到临时字符串中
                Buffer = Buffer & Format(X, "00") & "-" & Format(Y, "00") & ":"
                
                Call DrawPill(X, Y)
                If MyColor = 0 Then
                        '如果是黑棋,则黑方记时器启动
                        TimeBlack.Enabled = True
                        If TimeDisplayB.Text <> "" Then
                            MidVariant = CDate(TimeDisplayB.Text)
                        End If
                        
                        TimeWhite.Enabled = False
                        TimeDisplayW.Text = HisTime
                Else
                        '如果是白棋,则白方记时器启动
                        If TimeDisplayW.Text <> "" Then
                        
                            MidVariant = CDate(TimeDisplayW.Text)
                        
                        End If
                        TimeWhite.Enabled = True
                        TimeBlack.Enabled = False
                        TimeDisplayB.Text = HisTime
                End If
               
 '               StatusBar1.SimpleText = "你走!"
                If MyColor = 0 Then
                    BlackName.Caption = "你走..."
                    WhiteName.Caption = OpponentName
                    
                    
                Else
                    BlackName.Caption = OpponentName
                    WhiteName.Caption = "你走..."
                End If


            '如果对方取胜，则会发送"/W",表示对方赢了    
            Case "W"
                MsgBox "你输了!", vbOKOnly
                IfPlaying = False
                Drawing = False
                TimeBlack.Enabled = False
                TimeWhite.Enabled = False
		'发送“/L”，表示认输