wuziclient.frm

vb游戏程序代码

                TCP2.SendData "/L:"


            '如果对方发来的是"/L",则表示你赢了这一局棋
            Case "L"
                MsgBox "恭喜你,你赢了这局比赛,希望你再接再励!", vbOKOnly
                IfPlaying = False
                Drawing = False
                TimeBlack.Enabled = False
                TimeWhite.Enabled = False

            '表示观战，服务器将某一局棋的信息发送过来
            Case "G"
                
                Dim TempPos0
                Dim TempPos1
                Dim Temppos2
                
                IfWatching = True
                TempPos0 = 4
                TempPos1 = InStr(5, Information, ":", vbTextCompare)
                Do While TempPos1 <> 0
                    str11 = Mid$(Information, TempPos0, TempPos1 - TempPos0)
                    Buffer = Buffer & Left$(str11, 2) & "-" & Right$(str11, 2) & ":"
                    Call DrawPill2(CInt(Left$(str11, 2)), CInt(Right$(str11, 2)))

            
                    TempPos0 = TempPos1 + 1
                    TempPos1 = InStr(TempPos1 + 1, Information, ":", vbTextCompare)
                    If tmeppos1 <> 0 Then
                    
                        Temppos2 = TempPos1
                    End If
                '以上循环顺序取出棋子的位置，并画出棋子
                Loop
                
                TempPos1 = InStr(Temppos2, Information, "|", vbTextCompare)
                BlackName.Caption = Mid$(Information, Temppos2 + 1, TempPos1 - Temppos2 - 1)
                WhiteName.Caption = Mid$(Information, TempPos1 + 1)

            '表示观战失败，没有这个棋局
            Case "g"
                MsgBox "没有这个棋局！", vbCritical
                MessageBox.Text = MessageBox.Text & "没有这个棋局！" & _
                Chr(10) & Chr(13)
                IfWatching = False
                WatchQiJu = 0
            
            '观战后，对局双方每下一颗棋子，都会在你的棋盘上画出，并在Buffer中
	    '加入新的棋子信息
            Case "S"
                Call DrawPill2(CInt(Mid$(Information, 4, 2)), CInt(Right(Information, 2)))
                Buffer = Buffer & Mid$(Information, 4, 2) & "-" & Right(Information, 2) & ":"

            '表示对方想悔棋
            Case "H"
                Dim AnserNumber As Integer
                Dim StepInfo As String
                Dim StepX As Integer
                Dim StepY As Integer
                AnserNumber = MsgBox("对方想悔棋，你同意吗？", vbYesNo)
                If AnserNumber = vbYes Then
                    '如果同意悔棋，则进行以下修改，从Buffer中去掉前一个棋的
		    '信息，同时还要在棋盘上去掉原来的棋子
                    StepInfo = Right(Buffer, 6)
                    StepX = CInt(Left(StepInfo, 2))
                    StepY = CInt(Left(Right(StepInfo, 3), 2))
                    
                    PicQipan.ForeColor = &HC0E0FF
                    PicQipan.FillColor = &HC0E0FF
                    
                    PicQipan.Circle (StepX * SubWidth, StepY * SubWidth), _
                    SubWidth / 3
                   
                    PicQipan.ForeColor = vbBlack
		    '下面根据不同的棋子位置去掉棋子
                    If StepX <> 1 And StepX < 14 Then
                    
                    PicQipan.Line ((StepX - 0.5) * SubWidth, StepY * SubWidth)-( _
                    (StepX + 0.5) * SubWidth, StepY * SubWidth)
                    
                    Else
                     
                     If StepX = 1 Then
                        PicQipan.Line (StepX * SubWidth, StepY * SubWidth)-( _
                        (StepX + 0.5) * SubWidth, StepY * SubWidth)
                     Else
                        PicQipan.Line ((StepX - 0.5) * SubWidth, StepY * SubWidth)-( _
                        StepX * SubWidth, StepY * SubWidth)
                     End If
                     
                    End If
                    
                    If StepY <> 1 And StepY < 14 Then
                        
                     PicQipan.Line (StepX * SubWidth, (StepY - 0.5) * SubWidth)-( _
                     StepX * SubWidth, (StepY + 0.5) * SubWidth)
                   
                    Else
                        If StepX = 1 Then
                            PicQipan.Line (StepX * SubWidth, StepY * SubWidth)-( _
                            StepX * SubWidth, (StepY + 0.5) * SubWidth)
                        Else
                            PicQipan.Line (StepX * SubWidth, (StepY - 0.5) * SubWidth)-( _
                            StepX * SubWidth, StepY * SubWidth)
                        End If
                    End If
                    
                    
                    Buffer = Mid$(Buffer, 1, Len(Buffer) - 6)
                    Drawing = Not Drawing
		    '发送信息,表示同意悔棋
                    TCP2.SendData "/T:" & vbYes
                Else
		    '否则发送信息,表示不同意
                    TCP2.SendData "/T:" & vbNo
                End If

            '当自己发出悔棋信号后,对方返回的态度
            Case "T"
                Dim AnserNumber1 As Integer
                AnserNumber1 = CInt(Mid$(Information, 4))
                
                If AnserNumber1 = vbNo Then
                    MsgBox "对方不同意悔棋！", vbCritical
 '                   Drawing = True
                Else
                    
                If AnserNumber = vbYes Then
                        
                    StepInfo = Right(Buffer, 6)
                    StepX = CInt(Left(StepInfo, 2))
                    StepY = CInt(Left(Right(StepInfo, 3), 2))
                    
                    PicQipan.ForeColor = &HC0E0FF
                    PicQipan.FillColor = &HC0E0FF
                    
                    PicQipan.Circle (StepX * SubWidth, StepY * SubWidth), _
                    SubWidth / 3
                   
                    PicQipan.ForeColor = vbBlack
                    If StepX <> 1 And StepX < 14 Then
                    
                    PicQipan.Line ((StepX - 0.5) * SubWidth, StepY * SubWidth)-( _
                    (StepX + 0.5) * SubWidth, StepY * SubWidth)
                    
                    Else
                     
                     If StepX = 1 Then
                        PicQipan.Line (StepX * SubWidth, StepY * SubWidth)-( _
                        (StepX + 0.5) * SubWidth, StepY * SubWidth)
                     Else
                        PicQipan.Line ((StepX - 0.5) * SubWidth, StepY * SubWidth)-( _
                        StepX * SubWidth, StepY * SubWidth)
                     End If
                     
                    End If
                    
                    If StepY <> 1 And StepY < 14 Then
                        
                     PicQipan.Line (StepX * SubWidth, (StepY - 0.5) * SubWidth)-( _
                     StepX * SubWidth, (StepY + 0.5) * SubWidth)
                   
                    Else
                        If StepX = 1 Then
                            PicQipan.Line (StepX * SubWidth, StepY * SubWidth)-( _
                            StepX * SubWidth, (StepY + 0.5) * SubWidth)
                        Else
                            PicQipan.Line (StepX * SubWidth, (StepY - 0.5) * SubWidth)-( _
                            StepX * SubWidth, StepY * SubWidth)
                        End If
                    End If
                    
                    '去掉一步
                    Buffer = Mid$(Buffer, 1, Len(Buffer) - 6)
                    Drawing = Not Drawing
                    
                End If
                End If

            '表示是其他的信息
            Case "N"
                MessageBox.Text = MessageBox.Text + Mid$(Information, 4)
            
                
                
             
    End Select


End If

'MessageBox.Text = Information

End Sub


'表示连接出现错误的时候,产生的Error事件,然后作出相应的反应
Private Sub TCP2_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)

MsgBox "连接失败!", vbCritical
Timer1.Enabled = False
Connect.Tag = 1
TCP2.Close
Connect.Caption = "继续连接"
End Sub

Private Sub TimeBlack_Timer()
   ' TimeDisplayB.Text=cdate
'    Mytime = TimeDisplayB.Text
    Dim TimeUsed
    Dim TotalSecond As Integer
    Dim TotalMinuteTimeUsed As Single
    
    
 If Drawing Then
    If TimeDisplayB.Text <> "" Then
        TimeDisplayB.Text = Format(CDate(Time - _
        CDate(Mytime) + MidVariant), "hh:mm:ss")
    
    Else
        TimeDisplayB.Text = Format(CDate(Time - _
        CDate(Mytime)), "hh:mm:ss")
    End If
    
    TotalMinuteTimeUsed = Minute(CDate(TimeDisplayB.Text))
    
    If TotalMinuteTimeUsed > CanUseTime Then
        TimeUsed = CDate(Time - CDate(Mytime))
        TotalSecond = Second(TimeUsed) + Minute(TimeUsed) * 60
        If TotalSecond > EveryStepTime Then
            TimeCanUseCount = TimeCanUseCount - CInt(TotalSecond / EveryStepTime)
            If TimeCanUseCount < 0 Then
            
                TCP2.SendData "/L"
                MsgBox "你已经超时判输", vbOKOnly
                TimeWhite.Enabled = False
                TimeBlack.Enabled = False
                Drawing = False
                Exit Sub
            End If
        End If
    End If

Else
      If TimeDisplayB.Text <> "" Then
        TimeDisplayB.Text = Format(CDate(Time - _
        CDate(Mytime) + MidVariant), "hh:mm:ss")
      Else
        
        TimeDisplayB.Text = Format(CDate(Time - _
        CDate(Mytime)), "hh:mm:ss")
       End If
    
End If
    
End Sub


'限制连接时限
Private Sub Timer1_Timer()
If TimeCount < 3 Then
    timecont = TimeCount + 1
Else
    TCP2.Close
    Connect.Tag = 1
    MsgBox "无法连接上服务器!", vbCritical
    TimeCount = 0
    Timer1.Enabled = False
    
End If
End Sub

'用来显示和控制白方的时间
Private Sub TimeWhite_Timer()
    Dim TimeUsed
    Dim TotalSecond As Integer
    Dim TotalMinuteTimeUsed As Single
    
 If Drawing Then
    
    If TimeDisplayW.Text <> "" Then
        TimeDisplayW.Text = Format(CDate(Time - CDate(Mytime) + _
        MidVariant), "hh:mm:ss")
    
    Else
        TimeDisplayW.Text = Format(CDate(Time - CDate(Mytime)), "hh:mm:ss")
    End If
    
    TotalMinuteTimeUsed = Minute(CDate(TimeDisplayW.Text))
    
    If TotalMinuteTimeUsed > CanUseTime Then
        TimeUsed = CDate(Time - CDate(Mytime))
        TotalSecond = Second(TimeUsed) + Minute(TimeUsed) * 60
        If TotalSecond > EveryStepTime Then
            TimeCanUseCount = TimeCanUseCount - CInt(TotalSecond / EveryStepTime)
            If TimeCanUseCount < 0 Then
            
                TCP2.SendData "/L"
                MsgBox "你已经超时判输", vbOKOnly
                TimeWhite.Enabled = False
                TimeBlack.Enabled = False
                Exit Sub
            End If
        End If
    End If
Else
    If TimeDisplayW.Text <> "" Then
        TimeDisplayW.Text = Format(CDate(Time - CDate(Mytime) + _
        MidVariant), "hh:mm:ss")
    Else
        TimeDisplayW.Text = Format(CDate(Time - CDate(Mytime)), "hh:mm:ss")
    End If
End If
    

End Sub


'下面为工具栏的ButtonClick事件
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim FileName As String
Dim FileNum
Dim StrPosition As String

Select Case Button.Index
    '如果为1,表示想和本地朋友下一局
    Case 1
        Buffer = ""
        IfWatching = False
        Call PlayInLocal
    '如果为2,表示想打开一个以前的棋局
    Case 2
        
        
        CommonDialog1.Filter = "*.wxp|*.wxp"
        CommonDialog1.ShowOpen
        
        FileName = CommonDialog1.FileName
        
        
    PicQipan.Cls
    
    PicQipan.ForeColor = vbBlack
    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
        
    Buffer = ""
    
        If FileName <> "" Then
            FileNum = FreeFile
            Open FileName For Input As FileNum
            LocalPlayColor = False
            Do While Not EOF(FileNum)
                Line Input #FileNum, StrPosition
                
                Buffer = Buffer & Format(CInt(Left$(StrPosition, 2)), "00") & "-" & Format(CInt(Right$(StrPosition, 2)), "00") & ":"
                Call DrawPill2(CInt(Left$(StrPosition, 2)), _
                CInt(Right$(StrPosition, 2)))
                
            Loop
        Close #FileNum
            
         End If

    '保存当前棋局到文件
    Case 3
        
        If Buffer <> "" Then
        CommonDialog1.Filter = "*.wxp|*.wxp"
        CommonDialog1.ShowSave
        FileName = CommonDialog1.FileName
        FileNum = FreeFile
        Open FileName For Output As FileNum
        
        tempposition0 = 1
        tempposition1 = InStr(2, Buffer, ":", vbTextCompare)
        Do While tempposition1 <> 0
            str11 = Mid$(Buffer, tempposition0, tempposition1 - tempposition0)

            Print #FileNum, str11
            tempposition0 = tempposition1 + 1
            tempposition1 = InStr(tempposition1 + 1, Buffer, ":", vbTextCompare)
        Loop


        Close #FileNum