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(po
'整个棋格的大小为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(po
















