main.frm

中国象棋支持网络功能(VB)

Open c_cdgFile.FileName For Input As #2
Input #2, local_side, pos_side
message = message + Chr(local_side + 65)
message = message + Chr(pos_side + 65)

If local_side = FF_SIDE1 Then
c_sColor.FillColor = vbRed
Else
c_sColor.FillColor = vbBlack
End If

If local_side = pos_side Then
pic_noclick.Visible = False
pic_click.Visible = True
Else
pic_click.Visible = False
pic_noclick.Visible = True
End If

For i = 0 To 31
Input #2, temp, y_off, x_off
message = message + Chr(temp + 65) + Chr(x_off + 48) + Chr(y_off + 48)
c_chess(i).Left = x_off * 600 + 195
c_chess(i).Top = y_off * 600
    If temp = 0 Then
    c_chess(i).Visible = False
    Else
    c_chess(i).Visible = True
    End If
Next i
Close #2
c_MunLoad.Enabled = False
message = message + " Eold"
If bIsNet = True Then
    c_sUse.SendData message
End If
m_State = FF_UA_USE
Exit Sub

'    If bIsNet = False Then
'    TransUseState FF_SYS_INIT_LOCAL
'    Else
'    ClearBoard
'    ClearCheck
'    c_MunLoad.Visible = False
'    End If
'    Dim string_load As String
    
'Open c_CdgFile.filename For Input As #2
'Input #2, local_side
'Input #2, string_load

'Dim message As String
'   If local_side = FF_SIDE1 Then
'    c_sColor.FillColor = vbBlack
'    pic_noclick.Visible = False
'    pic_click.Visible = True
'    message = "Load W"
'    Else
'    pic_click.Visible = False
'    pic_noclick.Visible = True
'    message = "Load B"
'    c_sColor.FillColor = vbWhite
'    End If
    
'If bIsNet = False Then local_side = FF_SIDE1
'Dim i As Integer
'For i = 1 To Len(string_load) Step 2
'    x_off = Asc(Mid(string_load, i, 1)) - 65
'    y_off = Asc(Mid(string_load, i + 1, 1)) - 65
'    GoPos x_off, y_off
'Next i
'message = message + string_load
'message = message + " Eold"
'Close #2

'If bIsNet = True Then
'    TransUseState FF_SYS_USE_CON
'    c_sUse.SendData message
'End If
'Exit Sub

calcelhandle:
Close #2
End Sub

Private Sub c_MunNew_Click()
If b_isCon = False Or b_Server = False Then Exit Sub
MsgBox "请选单双让对方猜先", vbOKOnly, "Chinese Chess"
Load f_Gfst
f_Gfst.Show vbModal, main
c_sUse.SendData "Gues " + m_Set
c_MunNew.Visible = False
End Sub

Private Sub c_MunSave_Click()
On Error GoTo calcelhandle
c_cdgFile.DialogTitle = "Save"
c_cdgFile.ShowSave
Dim i As Integer
Open c_cdgFile.FileName For Output As #1

Print #1, local_side, pos_side
For i = 0 To 31
    If c_chess(i).Visible = True Then
    Print #1, 1, (c_chess(i).Top / 600), ((c_chess(i).Left - 195) / 600)
    Else
    Print #1, 0, (c_chess(i).Top / 600), ((c_chess(i).Left - 195) / 600)
    End If
Next i
'Close #1

Exit Sub
calcelhandle:
Close #1
End Sub

Private Sub c_MunShow_Click()
c_MunShow.Checked = Not c_MunShow.Checked
frm_net.Visible = c_MunShow.Checked
If frm_net.Visible = True Then
main.Width = 8835
Else
main.Width = 5880
End If
End Sub

Private Sub c_pboard_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (bIsNet = True) And (Not m_State = FF_UA_USE) Then Exit Sub
If Not pos_side = local_side Then Exit Sub

If Chess_On = FF_EMP Then Exit Sub

If X < 195 Or Y < 0 Then Exit Sub
If X > 9 * 600 + 195 Or Y > 10 * 600 Then Exit Sub
Dim x_off, y_off As Integer
x_off = Int((X - 195) / 600)
y_off = Int(Y / 600)
If X - (x_off * 600 + 195) > 475 Or Y - y_off * 600 > 475 Then Exit Sub

'If Not m_board(x_off, y_off) = FF_EMP Then Exit Sub
If GoChess(Chess_On, x_off, y_off) = False Then Exit Sub
If bIsNet = True And m_State = FF_UA_USE Then c_sUse.SendData _
        "Post " + Chr(Chess_On + 65) + Chr(x_off + 48) + Chr(y_off + 48)

'If bIsNet = False Then TransSide local_side
Chess_On = FF_EMP
c_spChessOn.Visible = False
End Sub

Private Sub Form_Load()
On Error GoTo errhandle
TransState FF_US_INITALL

If bIsNet = True Then
TransState FF_US_INITNET
c_sListen.Listen
Else
TransState FF_US_INITLOCAL
End If
Exit Sub

errhandle:
MsgBox "System Wrong", vbOKOnly, "Chinese Chess"
End
End Sub

Private Sub c_CmdCon_Click()
On Error GoTo errhandle
c_sUse.LocalPort = 0
c_sUse.RemotePort = 6112
    c_sUse.RemoteHost = c_eAddr.Text
    c_sUse.Connect
    c_CmdCon.Enabled = False
Exit Sub

errhandle:
    MsgBox "Net wrong, Click <Connect> for a while", vbOKOnly, "Chinese Chess"
End Sub

Private Sub c_sListen_ConnectionRequest(ByVal requestID As Long)
If b_isCon = True Or (Not c_sUse.State = 0) Then Exit Sub
c_sUse.LocalPort = 0
c_sUse.Accept requestID
TransState FF_US_NET_CON
b_Server = True
End Sub

Private Sub c_sListen_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 Description, vbOKOnly, "Chinese Chess"
End
End Sub

Private Sub c_sUse_Close()
MsgBox "Connect Closed", vbOKOnly, "Chinese Chess"
TransState FF_US_INITALL
TransState FF_US_INITNET
c_eAddr.Text = c_sUse.RemoteHostIP
End Sub

Private Sub c_sUse_Connect()
c_sUse.SendData "Init"
b_Server = False
TransState FF_US_NET_CON
m_State = FF_UA_INIT
End Sub


Private Sub c_sUse_DataArrival(ByVal bytesTotal As Long)
If bIsNet = False Then Exit Sub
Dim message As String
Dim x_off, y_off, i, temp As Integer

c_sUse.GetData message, vbString, bytesTotal

Select Case Left(message, 4)
Case "Msag"
    c_eMsg.Text = Right(message, Len(message) - 5)
Case "Init"
    If (Not m_State = FF_UA_INVALID) Or (b_Server = False) Then _
        GoTo Errorhandle
    'TransState FF_US_NET_CON
    c_eState.Text = c_sUse.RemoteHost + "@" + c_sUse.RemoteHostIP + "来了"
    m_State = FF_UA_INIT
    c_MunNew.Visible = True
Case "Gues"
    If (Not m_State = FF_UA_INIT) Or (b_Server = True) Then _
        GoTo Errorhandle
    'MAKE GUESS FIRST
    m_BeSet = Mid(message, 6, 1)
    MsgBox "猜先", vbOKOnly, "Chinese Chess"
    Load f_Gfst
    f_Gfst.Show vbModal, main
    If Not m_Set = m_BeSet Then
        c_sUse.SendData "Your"
        local_side = FF_SIDE2
        pic_click.Visible = False
        pic_noclick.Visible = True
        c_sColor.FillColor = vbBlack
        TransBoard
    Else
        c_sUse.SendData "Mfst"
        local_side = FF_SIDE1
        pic_noclick.Visible = False
        pic_click.Visible = True
        c_sColor.FillColor = vbRed
    End If
    TransState FF_US_USE_CON
Case "Your"
    If (Not m_State = FF_UA_INIT) Or (b_Server = False) Then _
        GoTo Errorhandle
    TransState FF_US_USE_CON
    local_side = FF_SIDE1
    pic_noclick.Visible = False
    pic_click.Visible = True
    c_sColor.FillColor = vbRed
Case "Mfst"
    If (Not m_State = FF_UA_INIT) Or (b_Server = False) Then _
        GoTo Errorhandle
    TransState FF_US_USE_CON
    local_side = FF_SIDE2
    pic_click.Visible = False
    pic_noclick.Visible = True
    c_sColor.FillColor = vbBlack
    TransBoard
Case "Load"
    If (Not m_State = FF_UA_INIT) Or (b_Server = True) Then _
        GoTo Errorhandle

    local_side = Asc(Mid(message, 6, 1)) - 65
    TransSide local_side
    pos_side = Asc(Mid(message, 7, 1)) - 65

    If local_side = FF_SIDE1 Then
    c_sColor.FillColor = vbRed
    Else
    c_sColor.FillColor = vbBlack
    End If
    
    If pos_side = local_side Then
    pic_noclick.Visible = False
    pic_click.Visible = True
    Else
    pic_click.Visible = False
    pic_noclick.Visible = True
    End If
    
    Dim j As Integer
    j = 0
    For i = 8 To bytesTotal - 5 Step 3
    temp = Asc(Mid(message, i, 1)) - 65
    x_off = Asc(Mid(message, i + 1, 1)) - 48
    y_off = Asc(Mid(message, i + 2, 1)) - 48
    If x_off < 0 Or x_off > 8 Or y_off < 0 Or y_off > 9 Then Exit Sub
    c_chess(j).Top = y_off * 600
    c_chess(j).Left = x_off * 600 + 195
    If temp = 0 Then
    c_chess(j).Visible = False
    Else
    c_chess(j).Visible = True
    End If
    j = j + 1
    Next i
    TransBoard
    m_State = FF_UA_USE
Case "Post"
Dim chess, chess_die, x_begin, y_begin, count As Integer
    If Not m_State = FF_UA_USE Then GoTo Errorhandle
    If pos_side = local_side Then GoTo Errorhandle

    chess = Asc(Mid(message, 6, 1)) - 65
    x_off = Asc(Mid(message, 7, 1)) - 48
    y_off = Asc(Mid(message, 8, 1)) - 48
    y_off = 9 - y_off
    x_off = 8 - x_off
    
    chess_die = FindChessInPos(x_off, y_off)
    If GoChess(chess, x_off, y_off) = False Then
        If chess = 9 Or chess = 10 Or chess = 25 Or chess = 25 Or chess = 26 Then
           If chess_die = -1 Then GoTo Errorhandle
           x_begin = (c_chess(chess).Left - 195) / 600
           y_begin = (c_chess(chess).Top) / 600
            count = 0
            If (Not x_begin = x_off) And (Not y_begin = y_off) Then GoTo Errorhandle
            If x_begin = x_off Then
            For i = y_begin + Sgn(y_off - y_begin) To y_off - Sgn(y_off - y_begin) Step Sgn(y_off - y_begin)
                If Not FindChessInPos(x_off, i) = -1 Then count = count + 1
            Next i
            End If
            
            If y_begin = y_off Then
            For i = x_begin + Sgn(x_off - x_begin) To x_off - Sgn(x_off - x_begin) Step Sgn(x_off - x_begin)
                If Not FindChessInPos(i, y_off) = -1 Then count = count + 1
            Next i
            End If
        Else
        GoTo Errorhandle
        End If
        If count = 1 Then
            c_chess(chess).Top = c_chess(chess_die).Top
            c_chess(chess).Left = c_chess(chess_die).Left
            c_chess(chess_die).Visible = False
            If chess_die = 0 Or chess_die = 16 Then
                Die chess_die
                Exit Sub
            End If
            TransSide pos_side
            pic_click.Visible = Not pic_click.Visible
            pic_noclick.Visible = Not pic_noclick.Visible
        End If
    Else
        If chess_die = -1 Then Exit Sub
        c_chess(chess_die).Visible = False
            If chess_die = 0 Or chess_die = 16 Then
                Die chess_die
                Exit Sub
            End If
    End If

Case Else
    GoTo Errorhandle
End Select
Exit Sub

Errorhandle:
    If Not message = "Invalid Command" Then
        c_sUse.SendData "Invalid Command"
    Else
    c_eState.Text = "错误的命令或操作"
    End If
    
End Sub


Private Sub c_sUse_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 Description, vbOKOnly, "Chinese Chess"
TransState FF_US_INITALL
TransState FF_US_INITNET
End Sub