main.frm

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

'End Type

'CBoard
'Private Type CBoard
'    pos As CPoint
'    side As Integer
'End Type

Private Sub TransSide(ByRef side As Integer)
If side = FF_SIDE1 Then
    side = FF_SIDE2
Else
    side = FF_SIDE1
End If
End Sub

Private Sub TransState(method As Integer)
main.WindowState = vbNormal

Select Case method
Case FF_US_INITALL
    InitalBoard
    m_State = FF_UA_INVALID
    c_MunNew.Visible = False
    c_MunLoad.Enabled = True
    c_eState.Text = ""
    c_eMsg.Text = ""
    c_CmdSay.Enabled = False
    c_MunShow.Checked = bIsNet
    pos_side = FF_SIDE1
    Chess_On = FF_EMP
    c_spChessOn.Visible = False
    c_sUse.Close
    b_isCon = False
Case FF_US_INITNET
    frm_net.Visible = True
    main.Width = 8835
    pic_noclick.Visible = True
    pic_click.Visible = False
    c_sColor.FillColor = &H8000000F
    c_CmdCon.Enabled = True
Case FF_US_INITLOCAL
    frm_net.Visible = False
    main.Width = 5880
    pic_noclick.Visible = False
    pic_click.Visible = True
    c_sColor.FillColor = vbRed
    local_side = FF_SIDE1
Case FF_US_NET_CON
    c_CmdSay.Enabled = True
    b_isCon = True
    c_CmdCon.Enabled = False
    c_eState.Text = "网络连接成功"
Case FF_US_USE_CON
    m_State = FF_UA_USE
    c_MunLoad.Enabled = False
    c_MunNew.Visible = False
    c_eState.Text = "开始"
End Select
End Sub

Private Sub InitalBoard()
Dim i As Integer
'For i = 0 To 8
'For j = 0 To 9
'm_board(i * 8 + j).side = FF_EMP
'Next j
'Next i

Dim x_step, d_step As Integer
x_step = 0
d_step = -1
For i = 0 To 8
c_chess(i).Top = 0
c_chess(i).Left = 2595 + x_step * d_step
c_chess(i + 16).Top = 5400
c_chess(i + 16).Left = c_chess(i).Left
'm_board(4 + x_step / 600 * d_step, 0) = i
'm_board(4 + x_step / 600 * d_step, 9) = i + 16
If (i / 2 = Int(i / 2)) Then x_step = x_step + 600
d_step = -d_step
Next i

For i = 0 To 1
c_chess(i + 9).Top = 1200
c_chess(i + 9).Left = 795 + i * 3600
c_chess(i + 25).Top = 4200
c_chess(i + 25).Left = c_chess(i + 9).Left
'm_board(1 + i * 6, 2) = i + 9
'm_board(1 + i * 6, 7) = i + 25
Next i

For i = 0 To 4
c_chess(i + 11).Top = 1800
c_chess(i + 11).Left = 195 + i * 1200
c_chess(i + 27).Top = 3600
c_chess(i + 27).Left = c_chess(i + 11).Left
'm_board(i * 2, 3) = i + 11
'm_board(i * 2, 6) = i + 27
Next i

For i = 0 To 31
c_chess(i).Visible = True
Next i
End Sub

Private Function DuiJiang() As Boolean
Dim i, count, temp As Integer
If Not c_chess(0).Left = c_chess(16).Left Then
DuiJiang = False
Exit Function
End If

temp = Sgn(c_chess(16).Top - c_chess(0).Top)
count = 0
For i = c_chess(0).Top / 600 + temp To c_chess(16).Top / 600 - temp Step temp
If FindChessInPos((c_chess(0).Left - 195) / 600, i) > -1 Then count = count + 1
Next i

If count = 0 Then
DuiJiang = True
Exit Function
End If

DuiJiang = False
End Function

Private Sub Die(ByVal chess_die As Integer)
If chess_die = 0 Then
    MsgBox "Black is Die", vbOKOnly, "Chinese Chess"
Else
    MsgBox "Red is Die", vbOKOnly, "Chinese Chess"
End If
If bIsNet = True Then
    InitalBoard
    m_State = FF_UA_INIT
    c_MunNew.Visible = True
    c_MunLoad.Enabled = True
    c_eState.Text = ""
    c_eMsg.Text = ""
    c_CmdSay.Enabled = True
    c_MunShow.Checked = bIsNet
    pos_side = FF_SIDE1
    Chess_On = FF_EMP
    c_spChessOn.Visible = False
    frm_net.Visible = True
    pic_noclick.Visible = True
    pic_click.Visible = False
    c_sColor.FillColor = &H8000000F
Else
TransState FF_US_INITALL
TransState FF_US_INITLOCAL
End If
End Sub

Private Function GoChess(ByVal chess As Integer, ByVal x_off As Integer _
        , ByVal y_off As Integer) As Boolean

Dim use_side As Integer
Dim x_begin, y_begin As Integer
Dim Distent As Single
Dim i As Integer

If chess > 15 Then
    use_side = FF_SIDE2
Else
    use_side = FF_SIDE1
End If

x_begin = (c_chess(chess).Left - 195) / 600
y_begin = (c_chess(chess).Top) / 600

Distent = Sqr((x_off - x_begin) ^ 2 + (y_off - y_begin) ^ 2)

Select Case Int((chess - use_side * 16 + 1) / 2)
Case 0 'jian
    If Distent > 1 Then GoTo errhandle
    If x_off < 3 Or x_off > 5 Then GoTo errhandle
    If GetSelf(chess, y_off) > 2 Then GoTo errhandle
    c_chess(chess).Left = x_off * 600 + 195
    If DuiJiang = True Then
    MsgBox "Can Not this col", vbOKOnly, "Chinese Chess"
    c_chess(chess).Left = x_begin * 600 + 195
    GoTo errhandle
    End If
Case 1 'shi
    If Distent < 1.4 Or Distent > 1.5 Then GoTo errhandle
    If x_off < 3 Or x_off > 5 Then GoTo errhandle
    If GetSelf(chess, y_off) > 2 Then GoTo errhandle
Case 2 'xiang
    If Distent < 2.8 Or Distent > 2.9 Then GoTo errhandle
    If GetSelf(chess, y_off) > 4 Then GoTo errhandle
    If FindChessInPos((x_off + x_begin) / 2, (y_begin + y_off) / 2) > -1 Then GoTo errhandle
Case 3 'ma
    If Distent < 2.2 Or Distent > 2.3 Then GoTo errhandle
    If FindChessInPos(x_off - Sgn(x_off - x_begin), y_off - Sgn(y_off - y_begin)) > -1 Then GoTo errhandle
Case 4 'che
    If (Not x_begin = x_off) And (Not y_begin = y_off) Then GoTo errhandle
    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 GoTo errhandle
    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 GoTo errhandle
    Next i
    End If
Case 5 'pao
    If (Not x_begin = x_off) And (Not y_begin = y_off) Then GoTo errhandle
    If x_begin = x_off Then
    For i = y_begin + Sgn(y_off - y_begin) To y_off Step Sgn(y_off - y_begin)
        If Not FindChessInPos(x_off, i) = -1 Then GoTo errhandle
    Next i
    End If
    If y_begin = y_off Then
    For i = x_begin + Sgn(x_off - x_begin) To x_off Step Sgn(x_off - x_begin)
        If Not FindChessInPos(i, y_off) = -1 Then GoTo errhandle
    Next i
    End If
Case Else 'bing
    If Distent > 1 Then GoTo errhandle
    If GetSelf(chess, y_off) < GetSelf(chess, y_begin) Then GoTo errhandle
    If GetSelf(chess, y_off) < 5 And (Not x_off = x_begin) Then GoTo errhandle
End Select
    
c_chess(chess).Left = x_off * 600 + 195
c_chess(chess).Top = y_off * 600

If bIsNet = False Then
    TransSide local_side
    If c_sColor.FillColor = vbRed Then
    c_sColor.FillColor = vbBlack
    Else
    c_sColor.FillColor = vbRed
    End If
Else
    pic_click.Visible = Not pic_click.Visible
    pic_noclick.Visible = Not pic_click.Visible
End If

TransSide pos_side
GoChess = True
Exit Function

errhandle:
    GoChess = False
End Function

Private Function FindChessInPos(ByVal X As Integer, ByVal Y As Integer) As Integer
Dim i As Integer
For i = 0 To 31
    If c_chess(i).Visible = True And c_chess(i).Top / 600 = Y And (c_chess(i).Left - 195) / 600 = X Then
    FindChessInPos = i
    Exit Function
    End If
Next i
FindChessInPos = -1
End Function

Private Sub TransBoard()
Dim i, x_off, y_off As Integer
For i = 0 To 31
x_off = (c_chess(i).Left - 195) / 600
x_off = 8 - x_off
y_off = c_chess(i).Top / 600
y_off = 9 - y_off
c_chess(i).Left = x_off * 600 + 195
c_chess(i).Top = y_off * 600
Next i
End Sub

Private Function GetSelf(ByVal chess As Integer, ByVal Y As Integer) As Integer
Dim temp_side As Integer
If bIsNet = True Then
    temp_side = Int(chess / 16)
    If Not local_side = temp_side Then
    GetSelf = 9 - Y
    Else
    GetSelf = Y
    End If
Else
    If chess > 15 Then
    GetSelf = 9 - Y
    Else
    GetSelf = Y
    End If
End If
End Function

Private Sub c_chess_Click(Index As Integer)
If (bIsNet = True) And (Not m_State = FF_UA_USE) Then Exit Sub
If Not pos_side = local_side Then Exit Sub
Dim i As Integer
Dim count As Integer
Dim x_off, y_off, x_begin, y_begin As Integer
x_off = (c_chess(Index).Left - 195) / 600
y_off = (c_chess(Index).Top) / 600

If Not Int(Index / 16) = local_side Then
    Chess_On = Index
    c_spChessOn.Left = c_chess(Chess_On).Left - 60
    c_spChessOn.Top = c_chess(Chess_On).Top - 60
    c_spChessOn.Visible = True
Else
    If Chess_On = FF_EMP Then Exit Sub
    If GoChess(Chess_On, x_off, y_off) = True Then
        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)
        c_chess(Index).Visible = False
        If Index = 0 Or Index = 16 Then
            Die Index
            Exit Sub
        End If
       Chess_On = FF_EMP
        c_spChessOn.Visible = False
    Else
        If Chess_On = 9 Or Chess_On = 10 Or Chess_On = 25 Or Chess_On = 25 Or Chess_On = 26 Then
        x_begin = (c_chess(Chess_On).Left - 195) / 600
        y_begin = (c_chess(Chess_On).Top) / 600
        count = 0
        If (Not x_begin = x_off) And (Not y_begin = y_off) Then Exit Sub
            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
        End If
        End If
        If count = 1 Then
            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)
            c_chess(Chess_On).Top = c_chess(Index).Top
            c_chess(Chess_On).Left = c_chess(Index).Left
            c_chess(Index).Visible = False
            If Index = 0 Or Index = 16 Then
                Die Index
                Exit Sub
            End If
            Chess_On = FF_EMP
            c_spChessOn.Visible = False
            If bIsNet = False Then
                TransSide local_side
    If c_sColor.FillColor = vbRed Then
    c_sColor.FillColor = vbBlack
    Else
    c_sColor.FillColor = vbRed
    End If
            Else
                pic_click.Visible = Not pic_click.Visible
                pic_noclick.Visible = Not pic_noclick.Visible
            End If
            TransSide pos_side
        End If
End If
End Sub

Private Sub c_cmdReset_Click()
Load f_Gnet
f_Gnet.Show vbModal, main
TransState FF_US_INITALL
If bIsNet = True Then
TransState FF_US_INITNET
Else
TransState FF_US_INITLOCAL
End If

End Sub

Private Sub c_MunLoad_Click()
On Error GoTo calcelhandle
c_cdgFile.DialogTitle = "Load"
c_cdgFile.ShowOpen
Dim i, x_off, y_off, temp As Integer
Dim message As String

message = "Load "