五子棋两个控件之一fiveclient

Option Explicit
'整个棋格的大小为15x15
Dim mGrid(1 To 15, 1 To 15) As typeGrid
'每个棋格的宽度和长度
Dim Gridwidth, Gridheight As Integer
'go=ture表示可以下棋，=false表示不能下棋或该对方下
Dim Go As Boolean
'使用的棋子颜色
Dim MyColor As String
'当前玩家的名字
Dim Username As String

Private Sub AllFight_Click()
'在列表框中选择要观看的棋局
If AllFight.Tag > 0 And AllFight.Text <> "" And cmdCall.Caption <> "退出棋局" Then
    '观看的按扭有效
    cmdLook.Enabled = True
Else
    '观看的按扭无效
    cmdLook.Enabled = False
End If
End Sub

Private Sub AllFight_DropDown()
AllFight.Clear
'向服务器发送列出所有棋局的请求
Winsock.SendData "/AllP"
End Sub

Private Sub cmdCall_Click()
If cmdCall.Caption = "呼叫" Then
'以下为玩家呼叫对方
    If userList.Text = Username Then
        MsgBox "不能呼叫自己"
        Exit Sub
    End If
    If userList.Text <> "" Then
        cmdCall.Enabled = False
        '向服务器发送呼叫其他玩家下棋的请求
        Winsock.SendData "/Call" & userList.Text
    End If
Else
    '如果cmdcall.caption<>"呼叫"(即是"退出棋局")
    '向服务器发送退出棋局的消息
    Winsock.SendData "/Quit"
End If
End Sub

Private Sub cmdDiscont_Click()
'断开与服务器的连接，并设置各个控件的状态
Winsock.Close
Command1.Enabled = True
cmdDiscont.Enabled = False
userList.Enabled = False
cmdCall.Enabled = False
AllFight.Enabled = False
txtName.Locked = False
Text1.Text = "与服务器的连接断开了......"
End Sub

Private Sub cmdLook_Click()
'观战或退出观战的按扭
If cmdLook.Caption = "观战" Then
    '如果观战，则不能呼叫
    cmdCall.Enabled = False
    '向服务器发出观战的请求
    Winsock.SendData "/Look" & AllFight.Tag
Else
    '向服务器发出退出观战请求
    Winsock.SendData "/QtLk"
    cmdLook.Caption = "观战"
    '根据是否选择了棋局确定观战按扭是否可用
    If AllFight.Tag > 0 And AllFight.Text <> "" Then
        cmdLook.Enabled = True
    Else
        cmdLook.Enabled = False
    End If
    '退出观战，呼叫按扭可用
    cmdCall.Enabled = True
    '初始化棋格
    IniGrid
End If
End Sub

Private Sub UserControl_Initialize()
Pic1.Cls
'确定棋格的宽度和高度以及棋盘的大小
Gridwidth = 300
Gridheight = 300
Pic1.Width = 300 * 15
Pic1.Height = 300 * 15
'初始化棋格
Call IniGrid
'go=false表示不能下棋
Go = False
'设置各个按钮是否可用
cmdDiscont.Enabled = False
userList.Enabled = False
cmdCall.Enabled = False
txtSend.Enabled = False
txtName.Enabled = True
cmdLook.Enabled = False
AllFight.Enabled = False
MyColor = "Black"
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'将初始化属性值赋予winsock
Winsock.RemoteHost = PropBag.ReadProperty("mRemoteHost", "10.10.10.10")
Winsock.RemotePort = PropBag.ReadProperty("mRemotePort", "1001")
End Sub

Private Sub userlist_DropDown()
'向服务器发送查看所有线上者名单
Winsock.SendData "/LstP"
End Sub

Private Sub Command1_Click()
'连接服务器
If Trim(txtName.Text) = "" Then
    MsgBox "必须写上你的称呼！！"
    Exit Sub
End If
'确定服务器的地址和通讯端口
'Winsock.RemoteHost = mRemoteHost
'Winsock.RemotePort = mRemotePort
If Winsock.State <> sckClosed Then
    Winsock.Close
End If
Winsock.Connect
End Sub

Private Sub Pic1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用鼠标在棋盘上点击下棋的处理
Dim i, j As Integer
If Go = False Then Exit Sub
If Button = 1 Then
    i = Round(X / Gridwidth)
    j = Round(Y / Gridheight)
    '取得下子的位置
    Label2.Caption = "x: " & i & "y:" & j
    If X < (i + 0.3) * Gridwidth And X > (i - 0.3) * Gridwidth And Y < (j + 0.3) * Gridheight And Y > (j - 0.3) * Gridheight Then
        '判断下子的位置是否在棋格的一定范围内
        If i > 0 And i < 15 And j > 0 And j < 15 Then
        If mGrid(i, j).mPill = 0 Then
            '设置该位置下了棋子
            mGrid(i, j).mPill = 1
            '在棋盘上画棋子
            Call Drawpill(i, j, MyColor)
            '该对方走
            Go = False
            Label5.Caption = "该对方走......" & MyColor
            '向服务器发送下子位置和使用颜色
            Winsock.SendData "/Data" & i & ";" & j & ";" & MyColor
        End If
    End If
    End If
End If
End Sub

Private Sub txtSend_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If talkOpt2.Value = True Then
    '向服务器发送与所有人聊天的内容
        Winsock.SendData "/Talk" & txtSend.Text
    Else
    '向服务器发送只与对手聊天的内容
        Text1.Text = Text1.Text & txtName.Text & "：" & txtSend.Text & vbCrLf
        Winsock.SendData "/ToSg" & txtSend.Text
    End If
    txtSend.Text = ""
End If
End Sub

Private Sub Winsock_Close()
'关闭与服务器连接，设置个各个控件的可用状态
Command1.Enabled = True
cmdDiscont.Enabled = False
userList.Enabled = False
cmdCall.Enabled = False
AllFight.Enabled = False
txtName.Locked = False
Text1.Text = "与服务器的连接断开了......"
End Sub

Private Sub Winsock_Connect()
'连接成功触发该事件
'向服务器发送注册玩家姓名的信息
Winsock.SendData "/Regi" & txtName.Text & ";" & MyColor
'设置各个控件的可用状态
Command1.Enabled = False
cmdCall.Caption = "呼叫"
cmdLook.Caption = "观战"
cmdDiscont.Enabled = True
userList.Enabled = True
AllFight.Enabled = True
End Sub

Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
Dim Information As String
'information接收服务器发送的数据
Winsock.GetData Information
Dim pos As Integer
Dim mHeader As String
Dim tempstr As String
Dim mArray
'取得服务器发送数据的前5个字符，以此判断要进行什么样的处理
'这5个字符的字符串可以说就是我们的协议
mHeader = Left$(Information, 5)
Select Case mHeader
    Case "/Data"
    '接收对方下子后的位置
        Dim tempij As String
        Dim i, j As Integer
        tempij = Mid(Information, 6)
        pos = InStr(1, tempij, ";", vbTextCompare)
        Dim pos2 As Integer
        Dim mColor1 As String
        pos2 = InStr(pos + 1, tempij, ";")
        '对方下子的位置（i,j）
        i = Mid(tempij, 1, pos - 1)
        j = Mid(tempij, pos + 1, pos2 - pos - 1)
        mColor1 = Mid(tempij, pos2 + 1)
        mGrid(i, j).mPill = 1
        If mColor1 = "White" Then
            Call Drawpill(i, j, "White")
        Else
            Call Drawpill(i, j, "Black")
        End If
        If cmdLook.Caption <> "退出观战" Then
            Label5.Caption = "该你走了......" & MyColor
            Go = True
        End If
    Case "/LgOn"
    '接收注册玩家姓名后服务器返回的信息
        Text1.Text = Text1.Text & Mid(Information, 6) & vbCrLf
    Case "/User"
    '向服务器请求列出所有玩家，服务器返回的数据处理
        tempstr = Mid(Information, 6)
        mArray = Split(tempstr, ";")
        userList.Clear
        For i = 1 To UBound(mArray)
            pos = InStr(1, mArray(i), ":")
            userList.AddItem Left$(mArray(i), pos - 1)
            Text1.Text = Text1.Text & mArray(i) & vbCrLf
        Next i
    Case "/Call"
        '处理玩家呼叫对方下棋
        pos = InStr(6, Information, ";")
        tempstr = Mid(Information, 6)
        Dim answer
        answer = MsgBox(tempstr & "想与你下一局，可以吗？", vbYesNo)
        If answer = vbYes Then
            cmdCall.Caption = "退出棋局"
            Winsock.SendData "/Play" & "OK" & CInt(Mid(Information, pos + 1)) & ";" & "对手答应和你下几把"
            Label5.Caption = "对方走......" & MyColor
            '被呼叫者用黑棋
            MyColor = "Black"
        Else
            Winsock.SendData "/Play" & "NO" & CInt(Mid(Information, pos + 1)) & ";" & "对手不想和你下"
        End If
    Case "/Play"
    '呼叫者得到被呼叫者的回答处理
        pos = InStr(7, Information, ";")
        tempstr = Mid(Information, 6, 2)
        Dim mIndex As Integer
        mIndex = CInt(Mid(Information, 8, pos - 8))
        If tempstr = "OK" Then
            cmdCall.Enabled = True
            cmdCall.Caption = "退出棋局"
            Go = True
            '呼叫者用白棋
            MyColor = "White"
            'Form1.Caption = Username & "与" & userList.Text & "大战五子棋！！"
            Text1.Text = Text1.Text & Mid(Information, pos + 1) & vbCrLf
            Label5.Caption = "该你走......" & MyColor
        Else
            cmdCall.Enabled = True
            Text1.Text = Text1.Text & Mid(Information, pos + 1) & vbCrLf
            'MsgBox "对方不想与你下棋"
        End If
    Case "/Regi"
    '玩家注册后，处理服务器返回的信息
        Username = txtName.Text
        cmdCall.Enabled = True
        txtName.Locked = True
        txtSend.Enabled = True
        Text1.Text = Text1.Text & Mid(Information, 6) & vbCrLf
    Case "/Quit"
    '对手退出棋局后，处理服务器发送过来的消息
        cmdCall.Caption = "呼叫"
        Text1.Text = Text1.Text & "你的对手已经退出棋局了" & vbCrLf
        '不能下棋了
        Go = False
        '初始化棋格
        Call IniGrid
    Case "/AllP"
    '向服务器请求返回所有棋局信息后，服务器返回的所有棋局玩家的姓名和棋局索引
        tempstr = Mid(Information, 6)
        mArray = Split(tempstr, ";")
        AllFight.Clear
        '将棋局的信息和索引加入到列表框allfight中
        For i = 0 To UBound(mArray) - 1
            pos = InStr(1, mArray(i), ":")
            AllFight.Tag = CInt(Mid(mArray(i), 1, pos - 1))
            AllFight.AddItem Mid(mArray(i), pos + 1)
        Next i
    Case "/Grid"
        '向服务器发送棋局信息
        tempstr = ""
        For i = 1 To 15
            For j = 1 To 15
                tempstr = tempstr & mGrid(i, j).mPill & ";" & mGrid(i, j).mColor & ";"
            Next j
        Next i
        Dim tempIndex As Integer
        Winsock.SendData "/Grid" & Mid(Information, 6) & ";" & tempstr
    Case "/GetG"
        '参加观看的玩家向服务器请求返回棋局的信息后
        '从服务器取得棋局信息
        tempstr = ""
        tempstr = Mid(Information, 6)
        mArray = Split(tempstr, ";")
        Call IniGrid
        Dim kkk
        kkk = UBound(mArray)
        For i = 1 To 15
            For j = 1 To 15
                mGrid(i, j).mPill = CInt(mArray(2 * (i - 1) * 15 + 2 * j - 2))
                mGrid(i, j).mColor = mArray(2 * (i - 1) * 15 + 2 * j - 1)
            Next j
        Next i
        '根据返回的棋局信息绘制正在对奕的棋局
        Call FillPill
        cmdLook.Caption = "退出观战"
    Case Else
        Text1.Text = Text1.Text & Information & vbCrLf
End Select
End Sub

Private Sub DrawGrid()
'绘制棋格15x15
Dim i, j As Integer
For i = 1 To 15
    Pic1.Line (i * Gridwidth, 0)-(i * Gridwidth, Pic1.Height)
Next i
For j = 1 To 15
    Pic1.Line (0, j * Gridwidth)-(Pic1.Width, j * Gridwidth)
Next j
End Sub

Private Sub Drawpill(ByVal i As Integer, ByVal j As Integer, ByVal mColor As String)
'根据参数以一定的颜色绘制棋子
If mColor = "Black" Then
    Pic1.ForeColor = vbBlack
    Pic1.FillColor = vbBlack
    mGrid(i, j).mColor = "Black"
Else
    Pic1.ForeColor = vbWhite
    Pic1.FillColor = vbWhite
    mGrid(i, j).mColor = "White"
End If
'绘制棋子
Pic1.Circle (i * Gridwidth, j * Gridwidth), 120
End Sub

Private Sub Winsock_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'出错提示及处理
Command1.Enabled = True
cmdDiscont.Enabled = False
userList.Enabled = False
cmdCall.Enabled = False
AllFight.Enabled = False
txtName.Locked = False
Text1.Text = "与服务器的连接断开了......"
Winsock.Close
MsgBox "与服务器的连接失败，请重试......"
End Sub

Private Sub JudgeWin()
'判断输赢的算法,请读者完善该算法
End Sub

Private Sub IniGrid()
'初始化存放棋子信息的数组及重新绘制棋格
Dim i, j As Integer
For i = 1 To 15
    For j = 1 To 15
        mGrid(i, j).mPill = 0
        mGrid(i, j).mColor = ""
    Next j
Next i
Pic1.Cls
Call DrawGrid
End Sub

Private Sub FillPill()
'根据存储棋子信息的数组mgrid绘制棋子
Dim i, j As Integer
For i = 1 To 15
    For j = 1 To 15
        If mGrid(i, j).mPill = 1 Then
            Call Drawpill(i, j, mGrid(i, j).mColor)
        End If
    Next j
Next i
End Sub