?? main.frm
字號:
'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
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 "
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -