日期:2013-06-13  浏览次数:20865 次

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 Comman