Private Sub Timer1_Timer()
Dim ms As Boolean
Dim Info, temp As String
Dim p, p1, p2, i As Integer
Dim Ch
' Begin of Time Show Process
If ModemState <>LOGIN And SocketState <>CONNECTED Then
'it is not a multiusers game
Exit Sub
Else
If (S_R = 1) And (TURN = BLACKP) Then
Black_Time = Black_Time + Time - Start_Time
TimeB.Caption = CDate(Black_Time / 200)
Else
If (S_R = 1) And (TURN = WHITEP) Then
White_Time = White_Time + Time - Start_Time
TimeW.Caption = CDate(White_Time / 200)
Else
If (S_R = 0) And (TURN = WHITEP) Then
Black_Time = Black_Time + Time - Start_Time
TimeB.Caption = CDate(Black_Time / 200)
Else
If (S_R = 0) And (TURN = BLACKP) Then
White_Time = White_Time + Time - Start_Time
TimeW.Caption = CDate(White_Time / 200)
End If
End If
End If
End If
End If
'End If
' End of Time Show Process
'Begin of winsockt process
If SocketState = CONNECTED And Begin_Flag = 1 Then
ms = Net.Message_Exist
If ms = False Then
Exit Sub
End If
Info = Net.WaitForValue(Chr$(26), 5)
If g_ErrorCode = 1 Then
'Some error such as Timeout occured
Exit Sub
End If
p1 = InStr(Info, "B")
p2 = InStr(Info, "E|")
If p1 = 0 Or p2 = 0 Then
Exit Sub
End If
temp = Mid$(Info, p1 + 1, p2 - p1 - 1)
ParseLine (temp)
Msg(Msg_No).No = CInt(ParseArray(1))
Msg(Msg_No).Color = CInt(ParseArray(2))
If IsNumeric(ParseArray(3)) Then
Msg(Msg_No).X = CInt(ParseArray(3))
Msg(Msg_No).Y = CInt(ParseArray(4))
Else
Msg(Msg_No).X = ParseArray(3)
Msg(Msg_No).Y = ParseArray(4)
End If
If Msg(Msg_No).Color = GIVEUP Then
Beep
MsgBox ("对方已经认输了")
Net.Winsock1.SendData ("R_O" + Chr$(26))
Pause 3
Call Begin_Click
Exit Sub
End If
If Side = BLACKP Then
p = Draw_Point(Msg(Msg_No).X, Msg(Msg_No).Y, WHITEP)
Record(Step).Color = WHITEP
step_show.Cls
step_show.Print Step
TURN = BLACKP
Else
p = Draw_Point(Msg(Msg_No).X, Msg(Msg_No).Y, BLACKP)
Record(Step).Color = BLACKP
step_show.Cls
step_show.Print Step
TURN = WHITEP
End If
Record(Step).X = Msg(Msg_No).X
Record(Step).Y = Msg(Msg_No).Y
Step = Step + 1
S_R = 1
R_R = 0
p = Count_All_Gas
If (Msg(Msg_No).X >0 And Msg(Msg_No).Y >0 _
And Msg(Msg_No).X <20 And Msg(Msg_No).Y <20) Then
Board(Msg(Msg_No).X, Msg(Msg_No).Y).Current = True
Refresh_Board
Board(Msg(Msg_No).X, Msg(Msg_No).Y).Current = False
End If
Msg_No = Msg_No + 1
Pause 1
Net.Winsock1.SendData ("R_O" + Chr$(26))
Exit Sub
End If
'End of process of winsocket
'Begin of modem process
If ModemState <>LOGIN Or R_R <>1 Then
'It isn't a Inter_Modem Game
Exit Sub
End If
ms = Modem_F.Exist_Msg
If ms = False Then
'IO Port don't have any message
Exit Sub
End If
Info = Modem_F.WaitForValue(Chr$(26), 5)
'Wait a playing message
If g_ErrorCode = 1 Then
'Some error such as Timeout occured
Exit Sub
End If
p1 = InStr(Info, "B")
p2 = InStr(Info, "E|")
If p1 = 0 Or p2 = 0 Then
Exit Sub
End If
temp = Mid$(Info, p1 + 1, p2 - p1 - 1)
ParseLine (temp)
Msg(Msg_No).No = CInt(ParseArray(1))
Msg(Msg_No).Color = CInt(ParseArray(2))
If IsNumeric(ParseArray(3)) Then
Msg(Msg_No).X = CInt(ParseArray(3))
Msg(Msg_No).Y = CInt(ParseArray(4))
Else
Msg(Msg_No).X = ParseArray(3)
Msg(Msg_No).Y = ParseArray(4)
End If
Modem_F.Comm1.InBufferCount = 0
'Clear Buffer
If Msg(Msg_No).Color = LOGOUT Then
Beep
MsgBox ("对方已经退出了")
Modem_F.Comm1.InBufferCount = 0
Modem_F.Comm1.Output = "R_O" + Chr$(26)
Cls
Step = 0
Start_Time = Time
Black_Time = 0
White_Time = 0
Exit Sub
End If
If Msg(Msg_No).Color = FINISHED Then
Beep
Ch = MsgBox("对方要求结束比赛，可以吗？", vbYesNo)
Modem_F.Comm1.InBufferCount = 0
If Ch = 6 Then
Modem_F.Comm1.Output = "YESR_O" + Chr$(26)
Else
Modem_F.Comm1.Output = "NOR_O" + Chr$(26)
Exit Sub
End If
PlayState = FINISHED
Count_Area.Enabled = True
End If
If Msg(Msg_No).Color = GIVEUP Then
Beep
MsgBox ("对方已经认输了")
Modem_F.Comm1.InBufferCount = 0
Modem_F.Comm1.Output = "R_O" + Chr$(26)
Call Begin_Click
Exit Sub
End If
If Msg(Msg_No).Color = TALK Then
Beep
MsgBox (Modem_F.His_Name.Text &"说: " &Msg(Msg_No).X)
Modem_F.Comm1.InBufferCount = 0
Modem_F.Comm1.Output = "R_O" + Chr$(26)
Exit Sub
End If
If Msg(Msg_No).Color = UNDO Then
Step = Step - 1
Beep
Modem_F.Comm1.InBufferCount = 0
Modem_F.Comm1.Output = "R_O" + Chr$(26)
Draw_Board
Ini_Board
For i = 1 To Step - 1
Board(Record(i).X, Record(i).Y).Current = False
p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
step_show.Cls
step_show.Print Step
p = Count_All_Gas
Next i
Board(Record(Step - 1).X, Record(Step - 1).Y).Current = True
Refresh_Board
Board(Record(Step - 1).X, Record(Step - 1).Y).Current = False
S_R = 1
R_R = 0
TURN = Side
Exit Sub
End If
Modem_F.Comm1.InBufferCount = 0
Modem_F.Comm1.Output = "R_O" + Chr$(26)
If Side = BLACKP Then
p = Draw_Point(Msg(Msg_No).X, Msg(Msg_No).Y, WHITEP)
Record(Step).Color = WHITEP
step_show.Cls
step_show.Print Step
Else
p = Draw_Point(Msg(Msg_No).X, Msg(Msg_No).Y, BLACKP)
Record(Step).Color = BLACKP
step_show.Cls
step_show.Print Step
End If
Record(Step).X = Msg(Msg_No).X
Record(Step).Y = Msg(Msg_No).Y
Step = Step + 1
S_R = 1
R_R = 0
p = Count_All_Gas
If (Msg(Msg_No).X >0 And Msg(Msg_No).Y >0 _
And Msg(Msg_No).X <20 And Msg(Msg_No).Y <20) Then
Board(Msg(Msg_No).X, Msg(Msg_No).Y).Current = True
Refresh_Board
Board(Msg(Msg_No).X, Msg(Msg_No).Y).Current = False
End If
Msg_No = Msg_No + 1
End Sub
Private Sub Timer2_Timer()
ShowS.Cls
ShowS.Print " :-):-):-):-):-) " + Show_String(C1) + " (:-(:-(:-(:-(:-"
C1 = C1 + 1
If C1 = 10 Then
C1 = 0
End If
Game_Time.Cls
Game_Time.Print " 现在时间: " &Time
End Sub
Private Sub Set_Hand(h As Integer)
'设置让子（1-9）
Dim p As Integer
If h <= 1 Then
'Not a Handicap game
Exit Sub
End If
部分代码。。
思路：2.得到棋子上下左右四口气的坐标
(X-1,Y),(X+1,Y),(X,Y-1),(X,y+1)
3.将上面的条件递归，如果发现任何一口气上的棋子与本棋子同色，那么将满足条件的棋子坐标放入一个数组。
4.这个数组里面就存放了所有棋的连接块，然后再对这个连接块进行每一个棋子的有气无气判断，只需要有一颗棋有气，则表示这块棋有气，
否则这块气无气，从棋盘上清空即可。
围棋可不好编，特别是附带AI的话，算法如果没有借鉴，自创的话任务量很大，且不一定成功，我没这方面实践经验，但对于你的思路可以给你以下建议1，第一条，是不可行的，建议你用GDI绘图来绘制棋盘，这样可以判断坐标，方便落子
2，棋子同样采用动态绘图，填充黑白两色，落子与清除会很简单，只要在鼠标点击事件中，重绘棋盘，在鼠标对应坐标位置新画一个棋子就好
3，围棋我没研究过，算法不好说，但如果只是做个双人围棋，不涉及人机对战，在前两条的基础上可以实现你想要的原则，但涉及人机对战，AI算法将是最大的难题，勉强编的话，机器会蠢如猪
另外不要自惭形秽，编程涉及多个方面，有些人玩数据库，有些人玩绘图，有些人乐于深挖控件的内行，还有些人喜欢研究高等数学的算法，每个方面都需要积累，特别是自己积累的类库，这些类库是自己长期收集或者自创的函数与类的集合，高手之所以厉害，除了自己勤奋乐于研究外，还因为日积月累和站在前人肩上
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）