wuziclient.frm

vb游戏程序代码

End Sub


'将信息显示屏清空
Private Sub Clear_Click()
MessageBox.Text = ""
End Sub

'发送信息
Private Sub CmdMessage_Click()
    '首先判断发送信息框是否为空,MessageSend.Text为聊天内容显示文本框
    If MessageSend.Text <> "" Then
        '根据聊天类型来发送信息
        Select Case TalkWay.ListIndex
        '如果是0,则为shout,表示每个人都可以看见,"/3"表示让服务器理解为是shout模式
        Case 0
            TCP2.SendData "/3:" & YourNickName & "<shout>::" & MessageSend.Text
        '如果是1,表示为私聊,首先根据对方的名字确定对方的用户代号
        Case 1
            For i = 0 To MaxConnect
                If Use(i) Then
                    If AllUserss(i).Nickname = UserChoose.Text Then
                            Usernumber = AllUserss(i).IndexNum
                            Exit For
                    End If
                End If
            Next
            
            
            
            TCP2.SendData "/4:" & YourNickName & "<only talk to " & _
            UserChoose.Text & ">::" & MessageSend.Text & ":" & Format(Usernumber, "000")
            
            str11 = YourNickName & "<only talk to " & _
            UserChoose.Text & ">::" & MessageSend.Text & Format(Usernumber, "000")
        '表示chat模式,chat表示的是只有观战的人才可以看见
        Case 3
            If IfWatching Then
                '"/5"表示让服务器知道这是chat模式,WatchQiJu表示观战的棋局数
                TCP2.SendData "/5:" & MessageSend.Text & ":" & Format(WatchQiJu, "000")
            Else
                MsgBox "只有观战的时候才能够chat！", vbCritical
            End If
        End Select
    End If

End Sub

'表示想要找人对弈,显示对弈设置框,即Frame5.Visible=True,隐藏其他Frame
Private Sub cmdPlay_Click()
    Frame5.Visible = True
    Frame1.Visible = False
    Frame2.Visible = False
    Frame6.Visible = False
    
End Sub


'连接服务器,在连接上服务器以前,所有的其他按钮都会失效
Private Sub Connect_Click()
'表示连接上网
If Connect.Tag = 1 Then
    TCP2.Connect
'    Connect.Enabled = False
'    Register.Enabled = True
    

    MessageBox.Text = "Connect the server..." & Chr$(13) & Chr$(10)

    Timer1.Enabled = True
    Connect.Tag = 2
'    Connect.Caption = "下网"
'Users.Enabled = True
'表示下网
Else
    '"/E"表示的是让服务器知道自己要退出
    TCP2.SendData "/E:"
    TCP2.Close
    Connect.Caption = "上网"
    Connect.Enabled = True
    Connect.Tag = 1
    Connected = False
    IfPlaying = False
    
    Register.Enabled = False
    Users.Enabled = False
    Sendmessage.Enabled = False
    Timer1.Enabled = False
    cmdPlay.Enabled = False
    Watch.Enabled = False
    
    WuziClient.Caption = "五子棋客户端程序"
    
End If


End Sub



Private Sub Form_Load()
Dim X As Integer
Dim Y As Integer
'X = Screen.Width
'Y = Screen.Height
'X = (X - Me.Width) / 2
'Y = (Y - Me.Height) / 2
'Me.Move X, Y
MyColor = 1
'OtherColor = 2
'表示没有参加棋局,所以当鼠标在棋盘上不能画棋子
Drawing = False

'TimeDisplayB.Text = Format(Time, "hh:mm:ss")
    '设置矩阵,让每个点对应一个棋盘点,初始值为"5"
    For l = 1 To 14
        For j = 1 To 14
            DataArray(i, j) = 5
        Next j
    Next l


'在下拉列表框中加入些固定项
TalkWay.AddItem "shout", 0
TalkWay.AddItem "tell", 1
TalkWay.AddItem "chat", 2

'设置对弈类型和对弈颜色的初始值
TalkWay.ListIndex = 0
ColorChoose.ListIndex = 0

'定义远程主机的主机名,也可以是主机的IP地址
'TCP2.RemoteHost = "caojw"
TCP2.RemoteHost = "konggang"  '一定要改成自己合适的值

'定义远程主机的端口
TCP2.RemotePort = 2002

End Sub

'在窗体大小改变的时候改变棋盘大小
Private Sub Form_Resize()
'PicQipan.Move ScaleLeft, ScaleTop, ScaleWidth * 0.5, ScaleHeight
For i = 1 To 14
    PicQipan.Line (SubWidth, SubWidth * i)-(SubWidth * 14, _
    SubWidth * i)
    PicQipan.Line (SubWidth * i, SubWidth)-(SubWidth * i, _
    SubWidth * 14)
    
Next i
End Sub

'在这里,因为功能键比较多,所以通过这个控件来实现按钮的水平移动
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub HScroll1_Change()
    Frame3.Left = (HScroll1.Value - 40) * 100
End Sub

'登陆注册需要填的一些项,因为在本程序中没有加入数据库的功能,所以不能为用户
'保存数据
Private Sub login_Click()
If Nickname.Text = "" Then
    note = MsgBox("请输入昵称", vbCritical, "注意")
    Nickname.SetFocus
    Exit Sub
End If
    
If Password.Text = "" Then
    note = MsgBox("请输入密码", vbCritical, "注意")
    Password.SetFocus
    Exit Sub
End If

If Email.Text = "" Then
    note = MsgBox("请输入电子邮件", vbCritical, "注意")
    Email.SetFocus
    Exit Sub
End If

'设定自己的nickname,以便在整个程序中使用
YourNickName = Nickname.Text
Sendmessage.Enabled = True
Users.Enabled = True
Frame1.Visible = False

On Error GoTo err1:
'向服务器发送注册信息,"/1"让服务器知道是注册信息
TCP2.SendData "/1:" & Nickname.Text & ":" & Password.Text & _
":" & Email.Text

Exit Sub
err1:
    MsgBox ("注册不成功!")
End Sub

Private Sub Picture1_Click()

End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

End Sub

'让信息显示屏不能获得焦点,因为显示屏是不能编辑的
Private Sub MessageBox_GotFocus()
    MessageSend.SetFocus
End Sub


'在该事件中来画棋子
Private Sub PicQipan_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim x0 As Integer
Dim y0 As Integer
Dim X1 As Single
Dim Y1 As Single

'如果没有轮到你下,则退出该事件
If Not Drawing Then
    Exit Sub
End If

'如果是在自己的机器上下,没有连接到服务器,则调用Call LocalFunction(X, Y)
If LocalPlay Then
    Call LocalFunction(X, Y)
    Exit Sub
End If


'判断鼠标落点是否超出棋盘边界
If X < 10 Or X > 14.5 * SubWidth Or Y < SubWidth Or Y > 14.5 * SubWidth Then
    MsgBox "超出棋盘界限,请重新下"
    Exit Sub
End If

'根据鼠标落点的位置,来判断在哪个位置画出棋子
If Abs(Int(X / SubWidth) - X / SubWidth) < 0.5 Then
    x0 = Int(X / SubWidth)
Else
    x0 = Int(X / SubWidth) + 1
End If

If Abs(Int(Y / SubWidth) - Y / SubWidth) < 0.5 Then
    y0 = Int(Y / SubWidth)
Else
    y0 = Int(Y / SubWidth) + 1
End If
'X = X + SubWidth / 2
'Y = Y + SubWidth / 2
'X0 = X / SubWidth
'Y0 = Y / SubWidth


'判断是否该位置已经有棋子
If DataArray(x0, y0) <> 5 Then
    '当前位置已经有棋子了,
    MsgBox "当前位置已经有棋子了，请重新走!", vbCritical, "NOTE!"
    Exit Sub
End If


'如果没有,则修改矩阵的该点值为你的颜色值,"0"表示黑色,"1"表示白色
DataArray(x0, y0) = MyColor

'存储下棋的整个过程,即每一个子的位置和顺序
Buffer = Buffer & Format(x0, "00") & "-" & Format(y0, "00") & ":"

'下面的程序为判断是否已经赢了
For i = 1 To 14
    For j = 1 To 14
    
    If DataArray(i, j) = MyColor And Not IfSucceed Then
                
        
        If (14 - i) >= 4 And (14 - j) >= 4 Then
            If DataArray(i + 1, j + 1) = MyColor Then
                If DataArray(i + 2, j + 2) = MyColor Then
                    If DataArray(i + 3, j + 3) = MyColor Then
                        If DataArray(i + 4, j + 4) = MyColor Then
                            IfSucceed = True
                            Exit For
                        Exit For
                        End If
                    End If
                End If
            End If
        End If
        
        If i > 4 And (14 - j) >= 4 Then
            If DataArray(i - 1, j + 1) = MyColor Then
                If DataArray(i - 2, j + 2) = MyColor Then
                    If DataArray(i - 3, j + 3) = MyColor Then
                        If DataArray(i - 4, j + 4) = MyColor Then
                            IfSucceed = True
                            Exit For
                        Exit For
                        End If
                    End If
                End If
            End If
        End If
        
        
        'IfSucceed = IfSucceed + 1
        If (14 - i) >= 4 Then
        If DataArray(i + 1, j) = MyColor Then
            'IfSucceed = IfSucceed + 1
                If DataArray(i + 2, j) = MyColor Then
                    If DataArray(i + 3, j) = MyColor Then
                        If DataArray(i + 4, j) = MyColor Then
                            IfSucceed = True
                            Exit For
                        Exit For
                        End If
                    End If
                End If
        End If
        End If
        
        If (14 - j) >= 4 Then
        If DataArray(i, j + 1) = MyColor Then
            If DataArray(i, j + 2) = MyColor Then
                If DataArray(i, j + 3) = MyColor Then
                    If DataArray(i, j + 4) = MyColor Then
                        IfSucceed = True
                        Exit For
                    Exit For
                    End If
                End If
            End If
        End If
        End If
        
    End If
        
        
    Next j
Next i

If IfSucceed Then
    
If MyColor = 0 Then
    PicQipan.FillColor = vbBlack
    PicQipan.ForeColor = vbBlack
Else
    PicQipan.FillColor = vbWhite
    PicQipan.ForeColor = vbWhite
End If
'PicQipan.DrawMode
    PicQipan.Circle (x0 * SubWidth, y0 * SubWidth), SubWidth / 3
    '如果已经赢了,则向服务器发送信息,表示已经赢了,"/W"表示取胜信息
    TCP2.SendData "/W:"
    Drawing = False
    TimeBlack.Enabled = False
    TimeWhite.Enabled = False
    IfPlaying = False
    Exit Sub
End If



If MyColor = 0 Then
    PicQipan.FillColor = vbBlack
    PicQipan.ForeColor = vbBlack
    '下完后,在对方名称文本框中显示"对方走..."的字符串,如果你执黑,则在
    '白方显示
    WhiteName.Caption = "对方走..."
    BlackName.Caption = YourNickName
Else
    PicQipan.FillColor = vbWhite
    PicQipan.ForeColor = vbWhite
    WhiteName.Caption = YourNickName
    BlackName.Caption = "对方走..."
    
End If


'画出棋子
'PicQipan.DrawStyle = 6
PicQipan.FillStyle = 0
'PicQipan.DrawMode
PicQipan.Circle (x0 * SubWidth, y0 * SubWidth), SubWidth / 3

'Call DrawPill(X0, Y0)
'设定为不可画模式
Drawing = False
'设定几个Time计时控件的工作过程
'如果执黑,则黑方计时停止,白方计时开始
If MyColor = 0 Then
    TimeBlack.Enabled = False