7,786
社区成员
发帖
与我相关
我的任务
分享请发表友善的回复…
发表回复
crycoming 2001-09-04
- 打赏
- 举报
好像清风围棋上有控件，自己找找吧
everyask 2001-09-04
- 打赏
- 举报
up
everyask 2001-09-03
- 打赏
- 举报
ylt1437(乐天派) ：
这个程序好象是网络上的人人对弈版而不是人机对弈版吧？
这个程序好象是网络上的人人对弈版而不是人机对弈版吧？
ylt1437 2001-09-03
- 打赏
- 举报
给你源程序，给我分啊！
Option Explicit
Const Stepx = 270
Const Stepy = 270
Const StarSize = 20
Const PointSize = 100
Const SAVEF = 1
Const READF = 2
Dim Begin_Flag As Integer
Dim Startx, Starty, F, i As Integer
'F means the times of BACK Button clicked
Dim Start_Time, Black_Time, White_Time As Date
Dim MANUAL As Integer
Dim Count1, C1, Open_F As Integer
Dim Show_String(10) As String
Dim Step_Count
Public Sub Draw_Board()
Dim Intx, Inty As Integer
Startx = ScaleLeft + 1000
Starty = ScaleTop + 1000
DrawMode = 13
DrawWidth = 1
For Intx = 0 To 18
CurrentY = Starty - 0.7 * Stepy
CurrentX = Startx + (Intx - 0.5) * Stepx
Print Intx + 1
Next Intx
For Inty = 0 To 18
CurrentX = Startx - Stepx
CurrentY = Starty + (Inty - 0.5) * Stepy
Print Inty + 1
Next Inty
For Intx = 0 To 18
Line (Startx + Intx * Stepx, Starty)-(Startx + Intx * Stepx, Starty + 18 * Stepy), RGB(255, 255, 0)
Next Intx
For Inty = 0 To 18
Line (Startx, Starty + Inty * Stepy)-(Startx + 18 * Stepy, Starty + Inty * Stepy), RGB(255, 255, 0)
Next Inty
FillColor = QBColor(0)
FillStyle = 1
'draw 9 stars
For Intx = 0 To 18
For Inty = 0 To 18
If (Intx = 3 Or Intx = 9 Or Intx = 15) And (Inty = 3 Or Inty = 9 Or Inty = 15) Then
Circle (Startx + Intx * Stepx, Starty + Inty * Stepy), StarSize
Circle (Startx + Intx * Stepx, Starty + Inty * Stepy), 2 * StarSize
End If
Next Inty
Next Intx
End Sub
Public Function Ini_Board()
Dim i, j As Integer
For i = 1 To 19
For j = 1 To 19
Board(i, j).Color = EMPTYP
Board(i, j).X = i
Board(i, j).Y = j
Board(i, j).Status = UNCHECKED
Board(i, j).Gas = 0
Board(i, j).Current = False
Next j
Next i
End Function
Public Function Refresh_Board()
Dim i, j, t As Integer
Cls
Draw_Board
For i = 1 To 19
For j = 1 To 19
Board(i, j).Status = UNCHECKED
t = Draw_Point(Board(i, j).X, Board(i, j).Y, Board(i, j).Color)
Next j
Next i
End Function
Public Function Draw_Point(X, Y, Color As Integer) As Integer
Dim FILL, LineC
If Color = EMPTYP Or X <= 0 Or Y <= 0 Or X >= 20 Or Y >= 20 Then
Exit Function
End If
'It is not a legal input then exit
If Color = BLACKP Then
FILL = RGB(0, 0, 0)
FillStyle = vbFSSolid
If Board(X, Y).Current = False Then
FillColor = FILL
Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
Else
FillColor = FILL
Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
LineC = RGB(255, 255, 255)
Line ((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
Line ((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
End If
End If
'black point
If Color = WHITEP Then
FILL = RGB(255, 255, 255)
FillStyle = vbFSSolid
If Board(X, Y).Current = False Then
FillColor = FILL
Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
Else
FillColor = FILL
Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
LineC = RGB(0, 0, 0)
Line ((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
Line ((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
End If
End If
'white point
Board(X, Y).Color = Color
Board(X, Y).X = X
Board(X, Y).Y = Y
Board(X, Y).Status = UNCHECKED
Board(X, Y).Gas = 0
End Function
Private Sub About_Click(Index As Integer)
frmAbout.Show
End Sub
Private Sub All_Step_Click()
Dim p
If Step_Count <= 0 Then
Next_Step.Enabled = True
Priv_Step.Enabled = True
Exit Sub
End If
Next_Step.Enabled = False
Priv_Step.Enabled = True
Draw_Board
Ini_Board
MousePointer = 11
For i = 1 To Step_Count
p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
step_show.Cls
step_show.Print Step
p = Count_All_Gas
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
Next i
MousePointer = 1
Refresh_Board
Step = Step_Count
End Sub
Private Sub Back_Click()
Dim p
Static i, F, Save_Turn, Try As Integer
Step = Step - 1
If Step <= 1 Then
Call Begin_Click
Exit Sub
End If
'Modem process begin
If ModemState = LOGIN Then
If S_R = 0 Then
Step = Step + 1
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, UNDO, 0, 0)
Try = 0
Resend:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend
Else
Beep
MsgBox "对手已经离开！"
Call Modem_F.Disconnect_Click
Unload Modem_F
Call Begin_Click
Exit Sub
End If
End If
End If
'Modem process end
'Winsockt process begin
If SocketState = CONNECTED Then
If S_R = 0 Then
Step = Step + 1
Beep
Exit Sub
End If
Call Net.Con_msg(Msg_No, UNDO, 0, 0)
Try = 0
Resend1:
Call Net.Send_Msg(Msg_No)
Call Net.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend1
Else
Beep
MsgBox "对手已经离开！"
Call Net.Disconnect
Unload Net
Call Begin_Click
Exit Sub
End If
End If
End If
'Winsockt process end
Ini_Board
Draw_Board
Save_Turn = TURN
For i = 1 To Step - 1
Board(Record(Step - 1).X, Record(Step - 1).Y).Current = False
p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
step_show.Cls
step_show.Print Step
'If Record(i).Eat Then
p = Count_All_Gas
'End If
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
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
If ModemState = LOGIN Then
TURN = Side
S_R = 0
R_R = 1
Exit Sub
End If
If SocketState = CONNECTED Then
TURN = Side
S_R = 0
R_R = 1
Exit Sub
End If
F = F * -1
If F = 1 Then
' press 2*n times
If Save_Turn = BLACKP Then
TURN = BLACKP
Else
TURN = WHITEP
End If
Else
'press 2*n+1 times
If Save_Turn = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
End If
End Sub
Public Sub Begin_Click()
Dim p As Integer
Cls
Step = 1
Begin_Flag = 1
PlayState = 0
F = 1
Msg_No = 1
TURN = BLACKP
Draw_Board
Ini_Board
XY.Visible = True
TimeB.Visible = True
TimeW.Visible = True
Back.Enabled = True
Next_Step.Enabled = False
Priv_Step.Enabled = False
All_Step.Enabled = False
Start_Time = Time
Black_Time = 0
White_Time = 0
TimeB.Caption = " "
TimeW.Caption = " "
'Initalize some values
If SocketState = CONNECTED And Side = BLACKP Then
Form1.Caption = "网络对弈" + Net.My_name.Text + "执黑对" + Net.His_Name.Text
S_R = 1
R_R = 0
TURN = BLACKP
Set_Hand (Hand)
Back.Enabled = True
Count_Area.Enabled = False
Exit Sub
End If
If SocketState = CONNECTED And Side = WHITEP Then
Form1.Caption = "网络对弈" + Net.My_name.Text + "执白对" + Net.His_Name.Text
S_R = 0
R_R = 1
TURN = WHITEP
Set_Hand (Hand)
Back.Enabled = True
Count_Area.Enabled = False
Exit Sub
End If
If ModemState = LOGIN And Side = BLACKP Then
Form1.Caption = "MODEM 对弈 " + Modem_F.My_name.Text + "执黑对" + Modem_F.His_Name.Text
S_R = 1
R_R = 0
Modem_F.Comm1.InBufferCount = 0
TURN = BLACKP
Set_Hand (Hand)
Back.Enabled = True
Count_Area.Enabled = False
Exit Sub
End If
If ModemState = LOGIN And Side = WHITEP Then
Form1.Caption = "MODEM 对弈 " + Modem_F.My_name.Text + "执白对" + Modem_F.His_Name.Text
S_R = 0
R_R = 1
TURN = WHITEP
Modem_F.Comm1.InBufferCount = 0
Set_Hand (Hand)
Back.Enabled = True
Count_Area.Enabled = False
Exit Sub
End If
Form1.Caption = "打谱"
End Sub
Private Sub Count_Area_Click()
If Begin_Flag <> 1 Then
Exit Sub
End If
Count_All_Side
End Sub
Private Sub Exit_Click()
Dim Try As Integer
Cls
Step = 0
Start_Time = Time
Black_Time = 0
White_Time = 0
If ModemState <> LOGIN Then
Exit Sub
End If
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, LOGOUT, 0, 0)
Try = 0
Resend:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend
Else
Beep
MsgBox "对手已经离开！"
Call Modem_F.Disconnect_Click
Unload Modem_F
Call Begin_Click
Exit Sub
End If
End If
End If
End Sub
Private Sub Finish_Click()
Dim Try As Integer
Dim W$
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, FINISHED, 0, 0)
Try = 0
Resend:
Call Modem_F.Send_Msg(Msg_No)
W$ = Modem_F.WaitForValue("R_O", 10)
If InStr(1, W$, "NO") Then
MsgBox ("对手不同意结束比赛！")
Exit Sub
End If
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend
Else
Beep
MsgBox "对手已经离开！"
Call Modem_F.Disconnect_Click
Unload Modem_F
Call Begin_Click
Exit Sub
End If
End If
End If
PlayState = FINISHED
Count_Area.Enabled = True
End Sub
Private Sub Form_Load()
Begin_Flag = 0
Open_F = 0
Count1 = 0
C1 = 0
ModemState = UNCONNECTED
SocketState = UNCONNECTED
Dim i, j As Integer
Show_String(0) = "Welcome!!!"
Show_String(1) = "elcome!!!W"
Show_String(2) = "lcome!!!We"
Show_String(3) = "come!!!Wel"
Show_String(4) = "ome!!!Welc"
Show_String(5) = "me!!!Welco"
Show_String(6) = "e!!!Welcom"
Show_String(7) = "!!!Welcome"
Show_String(8) = "!!Welcome!"
Show_String(9) = "!Welcome!!"
Back.Enabled = False
Next_Step.Enabled = False
Priv_Step.Enabled = False
All_Step.Enabled = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim p, g, log_x, log_y As Integer
Dim W As String
Dim float As Double ' a float error
Dim Try As Integer 'The time of Sending Message
MANUAL = 0
Current = False
If Begin_Flag = 0 Then
'Begin button hasn't been pressed
Exit Sub
End If
float = (X - Startx) / Stepx - Int((X - Startx) / Stepx)
If float > 0.5 Then
log_x = Int((X - Startx) / Stepx) + 2
Else
log_x = Int((X - Startx) / Stepx) + 1
End If
float = (Y - Starty) / Stepy - Int((Y - Starty) / Stepy)
If float > 0.5 Then
log_y = Int((Y - Starty) / Stepy) + 2
Else
log_y = Int((Y - Starty) / Stepy) + 1
End If
If (log_x <= 0 Or log_y <= 0 Or log_x >= 20 Or log_y >= 20) Then
Exit Sub
End If
'Illegal input
If Button <> 1 Then
If PlayState <> FINISHED Then
Beep
Exit Sub
Else
Board(log_x, log_y).Color = EMPTYP
Refresh_Board
Exit Sub
End If
End If
'Right button pressed
If (Board(log_x, log_y).Color <> EMPTYP) Then
Beep
Exit Sub
End If
'There are some stone here!
'Modem process begin
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, PLAY, log_x, log_y)
Try = 0
Resend:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend
Else
Beep
MsgBox "对手已经离开！"
Call Modem_F.Disconnect_Click
Unload Modem_F
Call Begin_Click
Exit Sub
End If
End If
Msg_No = Msg_No + 1
S_R = 0
R_R = 1
End If
'Modem Process end
'Winsock process begin
If SocketState = CONNECTED Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Net.Con_msg(Msg_No, PLAY, log_x, log_y)
Try = 0
Resend1:
Call Net.Send_Msg(Msg_No)
Call Net.WaitForValue("R_O", 10)
'wait for "Receive Ok" confirm
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Some error ocurred, Retry for 3times
GoTo Resend1
Else
Beep
MsgBox "对手已经离开！"
Call Net.Disconnect
Unload Net
Call Begin_Click
Exit Sub
End If
End If
Msg_No = Msg_No + 1
S_R = 0
R_R = 1
End If
'Winsock Process end
If Button = 1 Then
MANUAL = 1
End If
If TURN = BLACKP Then
Board(log_x, log_y).Current = True
p = Draw_Point(log_x, log_y, BLACKP)
step_show.Cls
step_show.Print Step
Else
Board(log_x, log_y).Current = True
p = Draw_Point(log_x, log_y, WHITEP)
step_show.Cls
step_show.Print Step
End If
g = Count_All_Gas
Record(Step).Color = TURN
Record(Step).X = log_x
Record(Step).Y = log_y
If g <> 0 Then
Record(Step).Eat = True
Else
Record(Step).Eat = False
End If
Step = Step + 1
'MANUAL = 0
Refresh_Board
Board(log_x, log_y).Current = False
If ModemState <> LOGIN And SocketState <> CONNECTED Then
If MANUAL = 1 Then
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
End If
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim p, lg_x, lg_y As Integer
Dim float As Double
If Begin_Flag = 0 Then
Exit Sub
End If
float = (X - Startx) / Stepx - Int((X - Startx) / Stepx)
If float > 0.5 Then
lg_x = Int((X - Startx) / Stepx) + 2
Else
lg_x = Int((X - Startx) / Stepx) + 1
End If
float = (Y - Starty) / Stepy - Int((Y - Starty) / Stepy)
If float > 0.5 Then
lg_y = Int((Y - Starty) / Stepy) + 2
Else
lg_y = Int((Y - Starty) / Stepy) + 1
End If
If (lg_x > 0 And lg_x < 20) And (lg_y > 0 And lg_y < 20) Then
MousePointer = 2
XY.Cls
XY.Print "x: " & lg_x & "," & "y: " & lg_y
Else
XY.Cls
MousePointer = 0
End If
End Sub
Private Sub Give_Up_Click()
'Modem process begin
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, GIVEUP, 0, 0)
Resend2:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
GoTo Resend2
End If
Msg_No = Msg_No + 1
MsgBox ("您已认输了.")
Call Begin_Click
End If
'Modem Process end
'Socket process begin
If SocketState = CONNECTED Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Net.Con_msg(Msg_No, GIVEUP, 0, 0)
Resend3:
Call Net.Send_Msg(Msg_No)
Call Net.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
GoTo Resend3
End If
Msg_No = Msg_No + 1
MsgBox ("您已认输了.")
Call Begin_Click
End If
'Socket Process end
End Sub
Private Sub Lan_Click(Index As Integer)
Net.Show
End Sub
Private Sub Modem_Click(Index As Integer)
Modem_F.Show
End Sub
Private Sub Next_Step_Click()
Dim p
Priv_Step.Enabled = True
If Step >= Step_Count Then
Next_Step.Enabled = False
Exit Sub
End If
Step = Step + 1
p = Draw_Point(Record(Step).X, Record(Step).Y, Record(Step).Color)
step_show.Cls
step_show.Print Step
p = Count_All_Gas
Refresh_Board
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
'p = Count_All_Gas
'Refresh_Board
End Sub
Private Sub Open_Click(Index As Integer)
On Error GoTo errhandler
Dim temp
Dim i As Integer
temp = 0
COMDIAL.Filter = "WeiQi File|*.go"
COMDIAL.ShowOpen
Open (COMDIAL.FileName) For Input As #READF
Cls
Step = 0
Begin_Flag = 1
TURN = BLACKP
Draw_Board
Ini_Board
Next_Step.Enabled = True
Priv_Step.Enabled = True
All_Step.Enabled = True
TimeB.Visible = False
TimeW.Visible = False
Back.Enabled = False
Open_F = 1
For i = 1 To MAXSTEP
Line Input #READF, temp
If temp = "!" Then
Line Input #READF, Step_Count
Line Input #READF, Black_Name
Line Input #READF, White_Name
Line Input #READF, Add_Message
Players.Black_N.Text = Black_Name
Players.White_N.Text = White_Name
Players.Kibbitz.Text = Add_Message
Players.Show
Close #READF
Exit Sub
End If
Record(i).Color = temp
Line Input #READF, temp
Record(i).X = temp
Line Input #READF, temp
Record(i).Y = temp
Next i
Close #READF
errhandler:
Close #READF
Exit Sub
End Sub
Private Sub Priv_Step_Click()
Dim p
Dim i As Integer
Next_Step.Enabled = True
If Step <= 1 Then
Ini_Board
Draw_Board
Priv_Step.Enabled = False
Exit Sub
End If
Draw_Board
Ini_Board
For i = 1 To Step - 1
p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
step_show.Cls
step_show.Print Step
p = Count_All_Gas
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
Next i
Refresh_Board
Step = Step - 1
End Sub
Private Sub Quit_Click(Index As Integer)
If Net.Enabled = True Then
Unload Net
End If
If Modem_F.Enabled = True Then
Unload Modem_F
End If
Unload Me
End Sub
Private Sub Save_Click(Index As Integer)
On Error GoTo quit
Dim i, j As Integer
COMDIAL.Filter = "WeiQi File|*.go"
COMDIAL.ShowSave
Open (COMDIAL.FileName) For Output As #SAVEF
If Step <= 1 Then
Beep
MsgBox "没有可以保存的对局"
GoTo quit
End If
For i = 1 To Step - 1
Print #SAVEF, Record(i).Color
Print #SAVEF, Record(i).X
Print #SAVEF, Record(i).Y
Next i
Print #SAVEF, "!"
Print #SAVEF, Step - 1
Players.Show
Do
If Players.Visible = False Then
Exit Do
End If
DoEvents
Loop
Print #SAVEF, Black_Name
Print #SAVEF, White_Name
Print #SAVEF, Add_Message
Close #SAVEF
quit:
Exit Sub
End Sub
Private Sub Talking_Click()
If ModemState = LOGIN And S_R = 1 Then
Talk_To_Him.Show
End If
End Sub
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
Select Case h
Case 2:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 16).X = 16
Board(16, 16).Y = 16
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Step = 3
Case 3:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(16, 4).X = 16
Board(16, 4).Y = 4
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Step = 4
Case 4:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Step = 5
Case 5:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(10, 10).Color = BLACKP
Board(10, 10).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(10, 10).X = 10
Board(10, 10).Y = 10
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(10, 10, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 10
Record(5).Y = 10
Step = 6
Case 6:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 10).Color = BLACKP
Board(4, 10).Gas = 0
Board(16, 10).Color = BLACKP
Board(16, 10).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(4, 10).X = 4
Board(4, 10).Y = 10
Board(16, 10).X = 16
Board(16, 10).Y = 10
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(4, 10, BLACKP)
p = Draw_Point(16, 10, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 4
Record(5).Y = 10
Record(6).X = 16
Record(6).Y = 10
Step = 7
Case 7:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 10).Color = BLACKP
Board(4, 10).Gas = 0
Board(16, 10).Color = BLACKP
Board(16, 10).Gas = 0
Board(10, 10).Color = BLACKP
Board(10, 10).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(4, 10).X = 4
Board(4, 10).Y = 10
Board(16, 10).X = 16
Board(16, 10).Y = 10
Board(10, 10).X = 10
Board(10, 10).Y = 10
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(4, 10, BLACKP)
p = Draw_Point(16, 10, BLACKP)
p = Draw_Point(10, 10, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 4
Record(5).Y = 10
Record(6).X = 16
Record(6).Y = 10
Record(7).X = 10
Record(7).Y = 10
Step = 8
Case 8:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 10).Color = BLACKP
Board(4, 10).Gas = 0
Board(16, 10).Color = BLACKP
Board(16, 10).Gas = 0
Board(10, 4).Color = BLACKP
Board(10, 4).Gas = 0
Board(10, 16).Color = BLACKP
Board(10, 16).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(4, 10).X = 4
Board(4, 10).Y = 10
Board(16, 10).X = 16
Board(16, 10).Y = 10
Board(10, 4).X = 10
Board(10, 4).Y = 4
Board(10, 16).X = 10
Board(10, 16).Y = 16
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(4, 10, BLACKP)
p = Draw_Point(16, 10, BLACKP)
p = Draw_Point(10, 4, BLACKP)
p = Draw_Point(10, 16, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 4
Record(5).Y = 10
Record(6).X = 16
Record(6).Y = 10
Record(7).X = 10
Record(7).Y = 4
Record(8).X = 10
Record(8).Y = 16
Step = 9
Case 9:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 10).Color = BLACKP
Board(4, 10).Gas = 0
Board(16, 10).Color = BLACKP
Board(16, 10).Gas = 0
Board(10, 4).Color = BLACKP
Board(10, 4).Gas = 0
Board(10, 16).Color = BLACKP
Board(10, 16).Gas = 0
Board(10, 10).Color = BLACKP
Board(10, 10).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(4, 10).X = 4
Board(4, 10).Y = 10
Board(16, 10).X = 16
Board(16, 10).Y = 10
Board(10, 4).X = 10
Board(10, 4).Y = 4
Board(10, 16).X = 10
Board(10, 16).Y = 16
Board(10, 16).X = 10
Board(10, 16).Y = 10
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(4, 10, BLACKP)
p = Draw_Point(16, 10, BLACKP)
p = Draw_Point(10, 4, BLACKP)
p = Draw_Point(10, 16, BLACKP)
p = Draw_Point(10, 10, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 4
Record(5).Y = 10
Record(6).X = 16
Record(6).Y = 10
Record(7).X = 10
Record(7).Y = 4
Record(8).X = 10
Record(8).Y = 16
Record(9).X = 10
Record(9).Y = 10
Step = 10
End Select
If Side = BLACKP Then
S_R = 0
R_R = 1
Else
S_R = 1
R_R = 0
End If
End Sub
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit
' 注册键安全选项...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' 注册键 ROOT 类型...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode 以 Null 结尾的字符串
Const REG_DWORD = 4 ' 32-位数字
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Caption = "关于 " & App.Title
'lblVersion.Caption = "版本 " & App.Major & "." & App.Minor & "." & App.Revision
'lblTitle.Caption = App.Title
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' 试图从注册表得到系统信息程序路径\名称...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' 试图从注册表得到系统信息程序路径...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' 验证已知 32 位文件版本的存在
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
' 错误 - 文件未找到...
Else
GoTo SysInfoErr
End If
' 错误 - 注册项未找到...
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "此时系统信息无效", vbOKOnly
End Sub
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' 循环指针
Dim rc As Long ' 返回代码
Dim hKey As Long ' 打开的注册键的句柄
Dim hDepth As Long '
Dim KeyValType As Long ' 注册键的数据类型
Dim tmpVal As String ' 注册键的临时存储区
Dim KeyValSize As Long ' 注册键变量的大小
'------------------------------------------------------------
' 在根键 {HKEY_LOCAL_MACHINE...} 下打开注册键
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册键
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 句柄错误...
tmpVal = String$(1024, 0) ' 分配变量空间
KeyValSize = 1024 ' 标记变量大小
'------------------------------------------------------------
' 检索注册键值...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' 获得/创建键值
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 句柄错误
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 添加以 Null 结尾的字符串...
tmpVal = LEFT(tmpVal, KeyValSize - 1) ' Null 找到，从字符串提取
Else ' WinNT 不需要以 Null 结束字符串...
tmpVal = LEFT(tmpVal, KeyValSize) ' Null 未找到， 仅提取字符串
End If
'------------------------------------------------------------
' 为了转换而决定键值类型..
'------------------------------------------------------------
Select Case KeyValType ' 搜索数据类型...
Case REG_SZ ' 字符串型注册键数据类型
KeyVal = tmpVal ' 复制字符串值
Case REG_DWORD ' 双字型注册键数据类型
For i = Len(tmpVal) To 1 Step -1 ' 转换每一位
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' 一个字符一个字符地建立值
Next
KeyVal = Format$("&h" + KeyVal) ' 转换双字型为字符串型
End Select
GetKeyValue = True ' 返回成功
rc = RegCloseKey(hKey) ' 关闭注册键
Exit Function ' 退出
GetKeyError: ' 发生错误后清除...
KeyVal = "" ' 设置返回值为空字符串
GetKeyValue = False ' 返回失败
rc = RegCloseKey(hKey) ' 关闭注册键
End Function
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit
Dim Buffer$
Dim ConnectStatus As Integer
Dim Port As Integer
Const WaitConst = 10
Const WaitConnectConst = 90
Const NotConnected = 1
Const NeedPassword = 2
Const CONNECTED = 3
Dim ParseArray(5)
Const MSCOMM_HANDSHAKE_NONE = 0
Const MSCOMM_HANDSHAKE_XONXOFF = 1
Const MSCOMM_HANDSHAKE_RTS = 2
Const MSCOMM_HANDSHAKE_RTSXONXOFF = 3
Const MSCOMM_EV_SEND = 1
Const MSCOMM_EV_RECEIVE = 2
Const MSCOMM_EV_CTS = 3
Const MSCOMM_EV_DSR = 4
Const MSCOMM_EV_CD = 5
Const MSCOMM_EV_RING = 6
Const MSCOMM_EV_EOF = 7
Const MSCOMM_ER_BREAK = 1001
Const MSCOMM_ER_CTSTO = 1002
Const MSCOMM_ER_DSRTO = 1003
Const MSCOMM_ER_FRAME = 1004
Const MSCOMM_ER_OVERRUN = 1006
Const MSCOMM_ER_CDTO = 1007
Const MSCOMM_ER_RXOVER = 1008
Const MSCOMM_ER_RXPARITY = 1009
Const MSCOMM_ER_TXFULL = 1010
Private Sub Dial_Click()
Dim W As String
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
Modem_Status.Cls
Modem_Status.Print "Checking Modem..."
Pause 2
MyOpenPort (Port)
If IsNumeric(Number.Text) = False Or Len(Number.Text) <= 2 Then
Beep
MsgBox ("Invalid Phone Number")
Exit Sub
End If
Comm1.Output = "AT" + Chr$(13)
g_ErrorCode = 0
W$ = WaitForValue("OK", WaitConst)
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "Modem OK"
Pause 1
Else
Modem_Status.Cls
Modem_Status.Print "Modem Not Responding"
Pause 1
AbortCall
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
Exit Sub
End If
Modem_Status.Cls
Modem_Status.Print "Dialing..."
Comm1.Output = "ATDT" + Number.Text + Chr$(13)
W$ = WaitForValue("CONNECT", WaitConnectConst)
'Wait for CONNECT
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "Connected"
ModemState = CONNECT
HOST = SERVER
Pause 3
Sendlogin
Pause 1
Recievelogin
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
Else
If InStr(W$, "BUSY") Then
Modem_Status.Cls
Modem_Status.Print "Line Busy"
ModemState = BUSY
ElseIf InStr(1, W$, "No Dialtone", 1) Then
Modem_Status.Cls
Modem_Status.Print "No DialTone"
ModemState = NODIALTONE
ElseIf InStr(1, W$, "No Carrier", 1) Then
Modem_Status.Cls
Modem_Status.Print "No Carrier"
ModemState = NOCARRIER
Else
Modem_Status.Cls
Modem_Status.Print "Connect Failed"
ModemState = FAILED
End If
AbortCall
Exit Sub
End If
End Sub
Private Sub Cancel_Click()
AbortCall
Unload Me
End Sub
Private Sub MyOpenPort(p As Integer)
Dim i As Integer
Dim Mss
If Comm1.PortOpen = False Then
Comm1.CommPort = p
If (IsNumeric(Speed.Text)) Then
Comm1.Settings = Speed.Text & ",N,8,1"
Else
Comm1.Settings = "9600,N,8,1"
End If
Comm1.PortOpen = True
End If
End Sub
Private Sub Sendlogin()
If HOST = SERVER Then
If white.Value <> True Then
black.Value = True
Side = BLACKP
S_R = 1
R_R = 0
Comm1.Output = "NA" + My_name.Text + "#B" + "#H" + Handicap.Text + ";" + Chr$(13)
Else
Comm1.Output = "NA" + My_name.Text + "#W" + "#H" + Handicap.Text + ";" + Chr$(13)
Side = WHITEP
S_R = 0
R_R = 1
End If
Else
Comm1.Output = "NA" + My_name.Text + "##" + "#H0;" + Chr$(13)
End If
End Sub
Private Sub Recievelogin()
Dim pos, p1, p2, p3, p4 As Integer
Dim t As String
Buffer = WaitForValue(";", 15)
pos = InStr(Buffer, "NA")
p1 = InStr(Buffer, "#B")
p2 = InStr(Buffer, "#W")
p3 = InStr(Buffer, "##")
p4 = InStr(Buffer, "#H")
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "LOGIN OK"
ModemState = LOGIN
If p1 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p1 - pos - 2)
Else
If p2 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p2 - pos - 2)
Else
If p3 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p3 - pos - 2)
End If
End If
End If
'set handicap
If HOST = SERVER Then
Hand = CInt(Handicap.Text)
End If
If HOST = CLIENT Then
t = Mid$(Buffer, p4 + 2, 1)
Hand = CInt(t)
If p1 Then
white.Value = True
Side = WHITEP
S_R = 0
R_R = 1
Else
black.Value = True
Side = BLACKP
S_R = 1
R_R = 0
End If
End If
Pause 1
Me.WindowState = 1
Call Form1.Begin_Click
Else
Modem_Status.Cls
Modem_Status.Print "LOGIN Failed"
ModemState = FAILED
AbortCall
End If
End Sub
Private Sub AbortCall()
Dim i As Integer
MyOpenPort (Port)
On Error GoTo Err
Comm1.Output = "+++ATH" & Chr$(13)
ModemState = IDLE
Err:
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End Sub
Public Sub Disconnect_Click()
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
Modem_Status.Cls
Modem_Status.Print "Disconnecting..."
Pause 1
AbortCall
Modem_Status.Cls
Modem_Status.Print "Modem Idle"
ModemState = IDLE
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End Sub
Private Sub Form_Load()
MPort.AddItem "COM1"
MPort.AddItem "COM2"
MPort.AddItem "COM3"
MPort.AddItem "COM4"
MPort.Text = "COM1"
Speed.AddItem "2400"
Speed.AddItem "4800"
Speed.AddItem "9600"
Speed.AddItem "14400"
Speed.AddItem "28800"
Speed.Text = "9600"
Handicap.AddItem "0"
Handicap.AddItem "1"
Handicap.AddItem "2"
Handicap.AddItem "3"
Handicap.AddItem "4"
Handicap.AddItem "5"
Handicap.AddItem "6"
Handicap.AddItem "7"
Handicap.AddItem "8"
Handicap.AddItem "9"
Handicap.Text = "0"
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
HOST = -1
Port = 1
End Sub
Private Sub Set_Click()
Dim i As Integer
i = 1
Select Case MPort.Text
Case "COM1":
i = 1
Case "COM2":
i = 2
Case "COM3":
i = 3
Case "COM4":
i = 4
End Select
If IsNumeric(Handicap.Text) Then
GoTo out
Else
MsgBox "Set Handicap please!"
Exit Sub
End If
out:
Port = i
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End Sub
Private Sub Wait_Click()
Dim W$
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
MyOpenPort (Port)
Modem_Status.Cls
Modem_Status.Print "Waiting for call..."
Do
DoEvents
If Comm1.InBufferCount <> 0 Then
g_ErrorCode = 0
W$ = WaitForValue("RING", 30)
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "Modem Ringing..."
Pause 1
Modem_Status.Cls
Modem_Status.Print "Answering..."
Comm1.Output = "ATA" & Chr$(13)
W$ = WaitForValue("CONNECT", WaitConnectConst)
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "Connected"
ModemState = CONNECT
Pause 3
HOST = CLIENT
Recievelogin
Sendlogin
Dial.Enabled = False
Disconnect.Enabled = True
Wait.Enabled = False
Else
Modem_Status.Cls
Modem_Status.Print "Connect Failed"
AbortCall
Modem_Status.Cls
Modem_Status.Print "Modem Idle"
ModemState = IDLE
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End If
Exit Sub
End If
ModemState = IDLE
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
Exit Sub
End If
Loop
End Sub
Public Sub Send_Msg(Msg_No As Integer)
If ModemState = LOGIN Then
Comm1.InBufferCount = 0
If IsNumeric(Msg(Msg_No).X) Then
Comm1.Output = "B" + Str(Msg(Msg_No).No) + "|" _
+ Str(Msg(Msg_No).Color) + "|" _
+ Str(Msg(Msg_No).X) + "|" _
+ Str(Msg(Msg_No).Y) + "|" _
+ Msg(Msg_No).E + "|;" + Chr$(26)
Else
Comm1.Output = "B" + Str(Msg(Msg_No).No) + "|" _
+ Str(Msg(Msg_No).Color) + "|" _
+ (Msg(Msg_No).X) + "|" _
+ Str(Msg(Msg_No).Y) + "|" _
+ Msg(Msg_No).E + "|;" + Chr$(26)
End If
End If
End Sub
Public Sub Con_msg(N As Integer, C As Integer, X As Variant, Y As Variant)
Msg(N).No = N
Msg(N).Color = C
Msg(N).X = X
Msg(N).Y = Y
Msg(N).E = "E"
End Sub
Public Function WaitForValue(Wait$, WaitTime) As String
Dim Receive$, StartTime, EndTime, MyIn$, ErrCode%, there%
Comm1.InputLen = 1
g_ErrorCode = 0
Receive = " "
MyIn$ = ""
StartTime = Timer
EndTime = StartTime + WaitTime
Do
DoEvents
If Comm1.InBufferCount <> 0 Then
MyIn$ = MyIn$ & Comm1.Input
there% = InStr(MyIn$, Wait$)
If there% Then
Exit Do
End If
End If
If Timer >= EndTime Then
g_ErrorCode = 1
Exit Do
End If
Loop
WaitForValue = MyIn$
End Function
Public Function Exist_Msg() As Boolean
If Comm1.InBufferCount Then
Exist_Msg = True
Else
Exist_Msg = False
End If
End Function
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit
Const MaxLen = 100
Dim Be_Host As Boolean
Public Message_Exist As Boolean 'indicate if a message existed
Dim Buffer$
Private Sub Called_Click()
Calling.Enabled = False
Winsock1.LocalPort = 888
Winsock1.Listen
Net_Status.Caption = "正在等待呼叫......"
Called.Enabled = False
Be_Host = True
End Sub
Private Sub Calling_Click()
Called.Enabled = False
If Address.Text <> " " Then
Winsock1.RemoteHost = Address.Text
Winsock1.RemotePort = 888
Net_Status.Caption = "正在呼叫庄家......"
Winsock1.CONNECT
End If
Be_Host = False
End Sub
Private Sub Exit_Click()
If Winsock1.State <> 0 Then
Winsock1.Close
SocketState = UNCONNECTED
End If
Unload Me
End Sub
Private Sub Form_Load()
Handicap.AddItem "0"
Handicap.AddItem "1"
Handicap.AddItem "2"
Handicap.AddItem "3"
Handicap.AddItem "4"
Handicap.AddItem "5"
Handicap.AddItem "6"
Handicap.AddItem "7"
Handicap.AddItem "8"
Handicap.AddItem "9"
Handicap.Text = "0"
Message_Exist = False
End Sub
Private Sub Winsock1_Connect()
Net_Status.Caption = "正常连接！"
SocketState = CONNECTED
Pause 1
Sendlogin
Pause 1
Recievelogin
End Sub
Private Sub Winsock1_ConnectionRequest _
(ByVal requestID As Long)
'测试 State 属性，如果当前连接是打开的话，
'则关闭连接。
If Winsock1.State <> sckClosed Then Winsock1.Close
'将 requestID 参数值传递给 Accept 方法。
Winsock1.Accept requestID
Net_Status.Caption = "正常连接！"
SocketState = CONNECTED
Pause 1
Sendlogin
Pause 1
Recievelogin
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Message_Exist = True
End Sub
Public Sub Send_Msg(Msg_No As Integer)
Dim temp$
If Winsock1.State = sckConnected Then
If Message_Exist = True Then
Winsock1.GetData temp, vbString, MaxLen
Message_Exist = False
End If
If IsNumeric(Msg(Msg_No).X) Then
Winsock1.SendData ("B" + Str(Msg(Msg_No).No) + "|" _
+ Str(Msg(Msg_No).Color) + "|" _
+ Str(Msg(Msg_No).X) + "|" _
+ Str(Msg(Msg_No).Y) + "|" _
+ Msg(Msg_No).E + "|;" + Chr$(26))
Else
Winsock1.SendData ("B" + Str(Msg(Msg_No).No) + "|" _
+ Str(Msg(Msg_No).Color) + "|" _
+ (Msg(Msg_No).X) + "|" _
+ Str(Msg(Msg_No).Y) + "|" _
+ Msg(Msg_No).E + "|;" + Chr$(26))
End If
Else
SocketState = UNCONNECTED
Beep
MsgBox ("对手已经离开！")
End If
End Sub
Public Sub Con_msg(N As Integer, C As Integer, X As Variant, Y As Variant)
Msg(N).No = N
Msg(N).Color = C
Msg(N).X = X
Msg(N).Y = Y
Msg(N).E = "E"
End Sub
Public Function WaitForValue(Wait$, WaitTime) As String
Dim Receive$, StartTime, EndTime, MyIn$, ErrCode%, there%
g_ErrorCode = 0
Receive = " "
MyIn$ = ""
StartTime = Timer
EndTime = StartTime + WaitTime
'If Winsock1.State <> sckConnected Then
'Message_Exist = False
'Exit Function
'End If
Do
DoEvents
If Message_Exist = True Then
Winsock1.GetData MyIn$, vbString, MaxLen
Message_Exist = False
there% = InStr(MyIn$, Wait$)
If there% Then
Exit Do
End If
End If
If Timer >= EndTime Then
g_ErrorCode = 1
Exit Do
End If
Loop
WaitForValue = MyIn$
End Function
Public Function Disconnect()
Winsock1.Close
SocketState = UNCONNECTED
Message_Exist = False
End Function
Private Sub Sendlogin()
If Be_Host = True Then
If White.Value <> True Then
black.Value = True
Side = BLACKP
S_R = 1
R_R = 0
Winsock1.SendData ("NA" + My_name.Text + "#B" + "#H" + Handicap.Text + ";" + Chr$(13))
Else
Winsock1.SendData ("NA" + My_name.Text + "#W" + "#H" + Handicap.Text + ";" + Chr$(13))
Side = WHITEP
S_R = 0
R_R = 1
End If
Else
Winsock1.SendData ("NA" + My_name.Text + "##" + "#H0;" + Chr$(13))
End If
End Sub
Private Sub Recievelogin()
Dim pos, p1, p2, p3, p4 As Integer
Dim t As String
Buffer = WaitForValue(";", 15)
pos = InStr(Buffer, "NA")
p1 = InStr(Buffer, "#B")
p2 = InStr(Buffer, "#W")
p3 = InStr(Buffer, "##")
p4 = InStr(Buffer, "#H")
If g_ErrorCode = 0 Then
Net_Status.Caption = "正常登录！"
SocketState = CONNECTED
If p1 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p1 - pos - 2)
Else
If p2 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p2 - pos - 2)
Else
If p3 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p3 - pos - 2)
End If
End If
End If
'set handicap
If Be_Host = True Then
If (Len(Handicap.Text) <> 0) Then
Hand = CInt(Handicap.Text)
Else
Hand = 0
End If
End If
If Be_Host = False Then
t = Mid$(Buffer, p4 + 2, 1)
If Len(t) <> 0 Then
Hand = CInt(t)
Handicap.Text = Str(Hand)
Else
Hand = 0
End If
If p1 Then
White.Value = True
Side = WHITEP
S_R = 0
R_R = 1
Else
black.Value = True
Side = BLACKP
S_R = 1
R_R = 0
End If
End If
Me.WindowState = 1
Call Form1.Begin_Click
Else
Net_Status.Caption = "登录失败！"
SocketState = UNCONNECTED
Disconnect
End If
End Sub
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Private Sub Cancel_Click()
Black_Name = " "
White_Name = " "
Add_Message = " "
Unload Me
End Sub
Private Sub Form_Load()
If ModemState = LOGIN Then
If Len(Modem_F.My_name.Text) <> 0 And Side = BLACKP Then
Black_N.Text = Modem_F.My_name.Text
End If
If Len(Modem_F.My_name.Text) <> 0 And Side = WHITEP Then
White_N.Text = Modem_F.My_name.Text
End If
If Len(Modem_F.His_Name.Text) <> 0 And Side = WHITEP Then
Black_N.Text = Modem_F.His_Name.Text
End If
If Len(Modem_F.His_Name.Text) <> 0 And Side = BLACKP Then
White_N.Text = Modem_F.His_Name.Text
End If
End If
End Sub
Private Sub OK_Click()
Black_Name = Black_N.Text
White_Name = White_N.Text
Add_Message = Kibbitz.Text
Unload Me
End Sub
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Private Sub Cancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
Topic.AddItem ("Hi!")
Topic.AddItem ("Hello!")
Topic.AddItem ("ByeBye")
Topic.AddItem ("Are you there?")
Topic.AddItem ("Where are you from?")
Topic.AddItem ("I have to leave now,I am sorry.")
Topic.AddItem ("I have to take a dinner.")
Topic.AddItem ("You don't mind a undo?")
Topic.AddItem ("No,I don't mind.")
Topic.AddItem ("Please don't do it!")
Topic.AddItem ("You are a good player.")
End Sub
Private Sub Say_Click()
'Modem process begin
Dim Try As Integer
Try = 0
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, TALK, Topic.Text, 0)
Resend:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If Try >= 2 Then
'Talking failed
Beep
MsgBox ("对手已经离开")
Modem_F.WindowState = 0
Call Modem_F.Disconnect_Click
Unload Me
Exit Sub
End If
If g_ErrorCode = 1 Then
Try = Try + 1
GoTo Resend
End If
Msg_No = Msg_No + 1
End If
Unload Me
'Modem Process end
End Sub
##########################################
模块
Option Explicit
Global Const MAXSTEP = 400 'Max number of steps
Global Const CHECKED = 1
Global Const UNCHECKED = 0
Global Const LEFT = 1
Global Const RIGHT = 2
Global Const UP = 3
Global Const Down = 4
Global Const ERASEP = -1
Global Const EMPTYP = 0
Global Const BLACKP = 1
Global Const WHITEP = 2
Global Const BOLDP = 3
Global TURN As Integer
Global MYCOLOR, HISCOLOR As Integer
Global Step As Integer
Global Msg_No As Integer
Global Hand As Integer
Global Current As Boolean
Global HOST As Integer
Global Const SERVER = 0
Global Const CLIENT = 1
Global Black_Name As String
Global White_Name As String
Global Add_Message As String
Global ModemState As Integer
Global SocketState As Integer
Global PlayState As Integer
Global Const CONNECTED = 1
Global Const UNCONNECTED = 0
Global S_R As Integer 'Send Ready
Global R_R As Integer 'Receive Ready
Global Side As Integer 'Which side I am taking
Global Const IDLE = 0
Global Const BUSY = 1
Global Const NODIALTONE = 2
Global Const NOCARRIER = 3
Global Const CONNECT = 4
Global Const FAILED = 5
Global Const LOGIN = 6
Global Const GIVEUP = -1
Global Const PLAY = 2
Global Const COUNTAREA = 3
Global Const TALK = 4
Global Const FINISHED = -4
Global Const UNDO = -2
Global Const LOGOUT = -3
Global g_ErrorCode As Integer
Global ParseArray(5)
Public Type Stone
Color As Integer
X As Integer
Y As Integer
Eat As Boolean 'Did it eat some stone?
End Type
Public Type MyPoint
Color As Integer
X As Integer
Y As Integer
Status As Integer
Gas As Integer
Current As Boolean
End Type
Public Type Message
No As Integer
Color As Integer
X As Variant
Y As Variant
E As String
End Type
Global Msg(1 To MAXSTEP) As Message
Global Board(1 To 19, 1 To 19) As MyPoint
Global Record(1 To MAXSTEP) As Stone
Public Function Count_Gas(p As MyPoint) As Integer
Dim l, r, u, d As Integer
Dim lx, ly, rx, ry, ux, uy, dx, dy As Integer
Dim lc, ls, lg, rc, rs, rg, uc, us, ug, dc, ds, du, dg As Integer
Dim nogas As Boolean
Dim ltp, rtp, utp, dtp As MyPoint
nogas = No_Gas(p)
lx = Near_Point(LEFT, p).X
ly = Near_Point(LEFT, p).Y
rx = Near_Point(RIGHT, p).X
ry = Near_Point(RIGHT, p).Y
ux = Near_Point(UP, p).X
uy = Near_Point(UP, p).Y
dx = Near_Point(Down, p).X
dy = Near_Point(Down, p).Y
If lx = 0 Then
lc = BOLDP
ls = CHECKED
lg = 0
Else
lc = Board(lx, ly).Color
ls = Board(lx, ly).Status
lg = Board(lx, ly).Gas
End If
If rx = 20 Then
rc = BOLDP
rs = CHECKED
rg = 0
Else
rc = Board(rx, ry).Color
rs = Board(rx, ry).Status
rg = Board(rx, ry).Gas
End If
If uy = 0 Then
uc = BOLDP
us = CHECKED
ug = 0
Else
uc = Board(ux, uy).Color
us = Board(ux, uy).Status
ug = Board(ux, uy).Gas
End If
If dy = 20 Then
dc = BOLDP
ds = CHECKED
dg = 0
Else
dc = Board(dx, dy).Color
ds = Board(dx, dy).Status
dg = Board(dx, dy).Gas
End If
If nogas = False Then
Count_Gas = 1
Board(p.X, p.Y).Gas = 1
Board(p.X, p.Y).Status = CHECKED
If (lx > 0 And lx < 20 And ly > 0 And ly < 20) Then
If Board(lx, ly).Color = p.Color Then
Board(lx, ly).Gas = 1
Board(lx, ly).Status = CHECKED
End If
End If
If (rx > 0 And rx < 20 And ry > 0 And ry < 20) Then
If Board(rx, ry).Color = p.Color Then
Board(rx, ry).Gas = 1
Board(rx, ry).Status = CHECKED
End If
End If
If (ux > 0 And ux < 20 And uy > 0 And uy < 20) Then
If Board(ux, uy).Color = p.Color Then
Board(ux, uy).Gas = 1
Board(ux, uy).Status = CHECKED
End If
End If
If (dx > 0 And dx < 20 And dy > 0 And dy < 20) Then
If Board(dx, dy).Color = p.Color Then
Board(dx, dy).Gas = 1
Board(dx, dy).Status = CHECKED
End If
End If
Exit Function
End If
If nogas = True Then
Board(p.X, p.Y).Status = CHECKED
l = r = u = d = 0
If lc = EMPTYP Then
l = 1
GoTo out
Else
If lc = BOLDP Or lc <> p.Color Then
l = 0
Else
If ls = CHECKED And lg = 1 Then
l = 1
GoTo out
Else
If ls = UNCHECKED Then
l = Count_Gas(Near_Point(LEFT, p))
Else
l = 0
End If
End If
End If
End If
If rc = EMPTYP Then
r = 1
GoTo out
Else
If rc = BOLDP Or rc <> p.Color Then
r = 0
Else
If rs = CHECKED And rg = 1 Then
r = 1
GoTo out
Else
If rs = UNCHECKED Then
r = Count_Gas(Near_Point(RIGHT, p))
Else
r = 0
End If
End If
End If
End If
If uc = EMPTYP Then
u = 1
GoTo out
Else
If uc = BOLDP Or uc <> p.Color Then
u = 0
Else
If us = CHECKED And ug = 1 Then
u = 1
GoTo out
Option Explicit
Const Stepx = 270
Const Stepy = 270
Const StarSize = 20
Const PointSize = 100
Const SAVEF = 1
Const READF = 2
Dim Begin_Flag As Integer
Dim Startx, Starty, F, i As Integer
'F means the times of BACK Button clicked
Dim Start_Time, Black_Time, White_Time As Date
Dim MANUAL As Integer
Dim Count1, C1, Open_F As Integer
Dim Show_String(10) As String
Dim Step_Count
Public Sub Draw_Board()
Dim Intx, Inty As Integer
Startx = ScaleLeft + 1000
Starty = ScaleTop + 1000
DrawMode = 13
DrawWidth = 1
For Intx = 0 To 18
CurrentY = Starty - 0.7 * Stepy
CurrentX = Startx + (Intx - 0.5) * Stepx
Print Intx + 1
Next Intx
For Inty = 0 To 18
CurrentX = Startx - Stepx
CurrentY = Starty + (Inty - 0.5) * Stepy
Print Inty + 1
Next Inty
For Intx = 0 To 18
Line (Startx + Intx * Stepx, Starty)-(Startx + Intx * Stepx, Starty + 18 * Stepy), RGB(255, 255, 0)
Next Intx
For Inty = 0 To 18
Line (Startx, Starty + Inty * Stepy)-(Startx + 18 * Stepy, Starty + Inty * Stepy), RGB(255, 255, 0)
Next Inty
FillColor = QBColor(0)
FillStyle = 1
'draw 9 stars
For Intx = 0 To 18
For Inty = 0 To 18
If (Intx = 3 Or Intx = 9 Or Intx = 15) And (Inty = 3 Or Inty = 9 Or Inty = 15) Then
Circle (Startx + Intx * Stepx, Starty + Inty * Stepy), StarSize
Circle (Startx + Intx * Stepx, Starty + Inty * Stepy), 2 * StarSize
End If
Next Inty
Next Intx
End Sub
Public Function Ini_Board()
Dim i, j As Integer
For i = 1 To 19
For j = 1 To 19
Board(i, j).Color = EMPTYP
Board(i, j).X = i
Board(i, j).Y = j
Board(i, j).Status = UNCHECKED
Board(i, j).Gas = 0
Board(i, j).Current = False
Next j
Next i
End Function
Public Function Refresh_Board()
Dim i, j, t As Integer
Cls
Draw_Board
For i = 1 To 19
For j = 1 To 19
Board(i, j).Status = UNCHECKED
t = Draw_Point(Board(i, j).X, Board(i, j).Y, Board(i, j).Color)
Next j
Next i
End Function
Public Function Draw_Point(X, Y, Color As Integer) As Integer
Dim FILL, LineC
If Color = EMPTYP Or X <= 0 Or Y <= 0 Or X >= 20 Or Y >= 20 Then
Exit Function
End If
'It is not a legal input then exit
If Color = BLACKP Then
FILL = RGB(0, 0, 0)
FillStyle = vbFSSolid
If Board(X, Y).Current = False Then
FillColor = FILL
Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
Else
FillColor = FILL
Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
LineC = RGB(255, 255, 255)
Line ((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
Line ((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
End If
End If
'black point
If Color = WHITEP Then
FILL = RGB(255, 255, 255)
FillStyle = vbFSSolid
If Board(X, Y).Current = False Then
FillColor = FILL
Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
Else
FillColor = FILL
Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
LineC = RGB(0, 0, 0)
Line ((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
Line ((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
End If
End If
'white point
Board(X, Y).Color = Color
Board(X, Y).X = X
Board(X, Y).Y = Y
Board(X, Y).Status = UNCHECKED
Board(X, Y).Gas = 0
End Function
Private Sub About_Click(Index As Integer)
frmAbout.Show
End Sub
Private Sub All_Step_Click()
Dim p
If Step_Count <= 0 Then
Next_Step.Enabled = True
Priv_Step.Enabled = True
Exit Sub
End If
Next_Step.Enabled = False
Priv_Step.Enabled = True
Draw_Board
Ini_Board
MousePointer = 11
For i = 1 To Step_Count
p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
step_show.Cls
step_show.Print Step
p = Count_All_Gas
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
Next i
MousePointer = 1
Refresh_Board
Step = Step_Count
End Sub
Private Sub Back_Click()
Dim p
Static i, F, Save_Turn, Try As Integer
Step = Step - 1
If Step <= 1 Then
Call Begin_Click
Exit Sub
End If
'Modem process begin
If ModemState = LOGIN Then
If S_R = 0 Then
Step = Step + 1
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, UNDO, 0, 0)
Try = 0
Resend:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend
Else
Beep
MsgBox "对手已经离开！"
Call Modem_F.Disconnect_Click
Unload Modem_F
Call Begin_Click
Exit Sub
End If
End If
End If
'Modem process end
'Winsockt process begin
If SocketState = CONNECTED Then
If S_R = 0 Then
Step = Step + 1
Beep
Exit Sub
End If
Call Net.Con_msg(Msg_No, UNDO, 0, 0)
Try = 0
Resend1:
Call Net.Send_Msg(Msg_No)
Call Net.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend1
Else
Beep
MsgBox "对手已经离开！"
Call Net.Disconnect
Unload Net
Call Begin_Click
Exit Sub
End If
End If
End If
'Winsockt process end
Ini_Board
Draw_Board
Save_Turn = TURN
For i = 1 To Step - 1
Board(Record(Step - 1).X, Record(Step - 1).Y).Current = False
p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
step_show.Cls
step_show.Print Step
'If Record(i).Eat Then
p = Count_All_Gas
'End If
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
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
If ModemState = LOGIN Then
TURN = Side
S_R = 0
R_R = 1
Exit Sub
End If
If SocketState = CONNECTED Then
TURN = Side
S_R = 0
R_R = 1
Exit Sub
End If
F = F * -1
If F = 1 Then
' press 2*n times
If Save_Turn = BLACKP Then
TURN = BLACKP
Else
TURN = WHITEP
End If
Else
'press 2*n+1 times
If Save_Turn = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
End If
End Sub
Public Sub Begin_Click()
Dim p As Integer
Cls
Step = 1
Begin_Flag = 1
PlayState = 0
F = 1
Msg_No = 1
TURN = BLACKP
Draw_Board
Ini_Board
XY.Visible = True
TimeB.Visible = True
TimeW.Visible = True
Back.Enabled = True
Next_Step.Enabled = False
Priv_Step.Enabled = False
All_Step.Enabled = False
Start_Time = Time
Black_Time = 0
White_Time = 0
TimeB.Caption = " "
TimeW.Caption = " "
'Initalize some values
If SocketState = CONNECTED And Side = BLACKP Then
Form1.Caption = "网络对弈" + Net.My_name.Text + "执黑对" + Net.His_Name.Text
S_R = 1
R_R = 0
TURN = BLACKP
Set_Hand (Hand)
Back.Enabled = True
Count_Area.Enabled = False
Exit Sub
End If
If SocketState = CONNECTED And Side = WHITEP Then
Form1.Caption = "网络对弈" + Net.My_name.Text + "执白对" + Net.His_Name.Text
S_R = 0
R_R = 1
TURN = WHITEP
Set_Hand (Hand)
Back.Enabled = True
Count_Area.Enabled = False
Exit Sub
End If
If ModemState = LOGIN And Side = BLACKP Then
Form1.Caption = "MODEM 对弈 " + Modem_F.My_name.Text + "执黑对" + Modem_F.His_Name.Text
S_R = 1
R_R = 0
Modem_F.Comm1.InBufferCount = 0
TURN = BLACKP
Set_Hand (Hand)
Back.Enabled = True
Count_Area.Enabled = False
Exit Sub
End If
If ModemState = LOGIN And Side = WHITEP Then
Form1.Caption = "MODEM 对弈 " + Modem_F.My_name.Text + "执白对" + Modem_F.His_Name.Text
S_R = 0
R_R = 1
TURN = WHITEP
Modem_F.Comm1.InBufferCount = 0
Set_Hand (Hand)
Back.Enabled = True
Count_Area.Enabled = False
Exit Sub
End If
Form1.Caption = "打谱"
End Sub
Private Sub Count_Area_Click()
If Begin_Flag <> 1 Then
Exit Sub
End If
Count_All_Side
End Sub
Private Sub Exit_Click()
Dim Try As Integer
Cls
Step = 0
Start_Time = Time
Black_Time = 0
White_Time = 0
If ModemState <> LOGIN Then
Exit Sub
End If
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, LOGOUT, 0, 0)
Try = 0
Resend:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend
Else
Beep
MsgBox "对手已经离开！"
Call Modem_F.Disconnect_Click
Unload Modem_F
Call Begin_Click
Exit Sub
End If
End If
End If
End Sub
Private Sub Finish_Click()
Dim Try As Integer
Dim W$
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, FINISHED, 0, 0)
Try = 0
Resend:
Call Modem_F.Send_Msg(Msg_No)
W$ = Modem_F.WaitForValue("R_O", 10)
If InStr(1, W$, "NO") Then
MsgBox ("对手不同意结束比赛！")
Exit Sub
End If
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend
Else
Beep
MsgBox "对手已经离开！"
Call Modem_F.Disconnect_Click
Unload Modem_F
Call Begin_Click
Exit Sub
End If
End If
End If
PlayState = FINISHED
Count_Area.Enabled = True
End Sub
Private Sub Form_Load()
Begin_Flag = 0
Open_F = 0
Count1 = 0
C1 = 0
ModemState = UNCONNECTED
SocketState = UNCONNECTED
Dim i, j As Integer
Show_String(0) = "Welcome!!!"
Show_String(1) = "elcome!!!W"
Show_String(2) = "lcome!!!We"
Show_String(3) = "come!!!Wel"
Show_String(4) = "ome!!!Welc"
Show_String(5) = "me!!!Welco"
Show_String(6) = "e!!!Welcom"
Show_String(7) = "!!!Welcome"
Show_String(8) = "!!Welcome!"
Show_String(9) = "!Welcome!!"
Back.Enabled = False
Next_Step.Enabled = False
Priv_Step.Enabled = False
All_Step.Enabled = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim p, g, log_x, log_y As Integer
Dim W As String
Dim float As Double ' a float error
Dim Try As Integer 'The time of Sending Message
MANUAL = 0
Current = False
If Begin_Flag = 0 Then
'Begin button hasn't been pressed
Exit Sub
End If
float = (X - Startx) / Stepx - Int((X - Startx) / Stepx)
If float > 0.5 Then
log_x = Int((X - Startx) / Stepx) + 2
Else
log_x = Int((X - Startx) / Stepx) + 1
End If
float = (Y - Starty) / Stepy - Int((Y - Starty) / Stepy)
If float > 0.5 Then
log_y = Int((Y - Starty) / Stepy) + 2
Else
log_y = Int((Y - Starty) / Stepy) + 1
End If
If (log_x <= 0 Or log_y <= 0 Or log_x >= 20 Or log_y >= 20) Then
Exit Sub
End If
'Illegal input
If Button <> 1 Then
If PlayState <> FINISHED Then
Beep
Exit Sub
Else
Board(log_x, log_y).Color = EMPTYP
Refresh_Board
Exit Sub
End If
End If
'Right button pressed
If (Board(log_x, log_y).Color <> EMPTYP) Then
Beep
Exit Sub
End If
'There are some stone here!
'Modem process begin
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, PLAY, log_x, log_y)
Try = 0
Resend:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Retry for 3times
GoTo Resend
Else
Beep
MsgBox "对手已经离开！"
Call Modem_F.Disconnect_Click
Unload Modem_F
Call Begin_Click
Exit Sub
End If
End If
Msg_No = Msg_No + 1
S_R = 0
R_R = 1
End If
'Modem Process end
'Winsock process begin
If SocketState = CONNECTED Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Net.Con_msg(Msg_No, PLAY, log_x, log_y)
Try = 0
Resend1:
Call Net.Send_Msg(Msg_No)
Call Net.WaitForValue("R_O", 10)
'wait for "Receive Ok" confirm
If g_ErrorCode = 1 Then
Try = Try + 1
If Try < 2 Then
'Some error ocurred, Retry for 3times
GoTo Resend1
Else
Beep
MsgBox "对手已经离开！"
Call Net.Disconnect
Unload Net
Call Begin_Click
Exit Sub
End If
End If
Msg_No = Msg_No + 1
S_R = 0
R_R = 1
End If
'Winsock Process end
If Button = 1 Then
MANUAL = 1
End If
If TURN = BLACKP Then
Board(log_x, log_y).Current = True
p = Draw_Point(log_x, log_y, BLACKP)
step_show.Cls
step_show.Print Step
Else
Board(log_x, log_y).Current = True
p = Draw_Point(log_x, log_y, WHITEP)
step_show.Cls
step_show.Print Step
End If
g = Count_All_Gas
Record(Step).Color = TURN
Record(Step).X = log_x
Record(Step).Y = log_y
If g <> 0 Then
Record(Step).Eat = True
Else
Record(Step).Eat = False
End If
Step = Step + 1
'MANUAL = 0
Refresh_Board
Board(log_x, log_y).Current = False
If ModemState <> LOGIN And SocketState <> CONNECTED Then
If MANUAL = 1 Then
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
End If
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim p, lg_x, lg_y As Integer
Dim float As Double
If Begin_Flag = 0 Then
Exit Sub
End If
float = (X - Startx) / Stepx - Int((X - Startx) / Stepx)
If float > 0.5 Then
lg_x = Int((X - Startx) / Stepx) + 2
Else
lg_x = Int((X - Startx) / Stepx) + 1
End If
float = (Y - Starty) / Stepy - Int((Y - Starty) / Stepy)
If float > 0.5 Then
lg_y = Int((Y - Starty) / Stepy) + 2
Else
lg_y = Int((Y - Starty) / Stepy) + 1
End If
If (lg_x > 0 And lg_x < 20) And (lg_y > 0 And lg_y < 20) Then
MousePointer = 2
XY.Cls
XY.Print "x: " & lg_x & "," & "y: " & lg_y
Else
XY.Cls
MousePointer = 0
End If
End Sub
Private Sub Give_Up_Click()
'Modem process begin
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, GIVEUP, 0, 0)
Resend2:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
GoTo Resend2
End If
Msg_No = Msg_No + 1
MsgBox ("您已认输了.")
Call Begin_Click
End If
'Modem Process end
'Socket process begin
If SocketState = CONNECTED Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Net.Con_msg(Msg_No, GIVEUP, 0, 0)
Resend3:
Call Net.Send_Msg(Msg_No)
Call Net.WaitForValue("R_O", 10)
If g_ErrorCode = 1 Then
GoTo Resend3
End If
Msg_No = Msg_No + 1
MsgBox ("您已认输了.")
Call Begin_Click
End If
'Socket Process end
End Sub
Private Sub Lan_Click(Index As Integer)
Net.Show
End Sub
Private Sub Modem_Click(Index As Integer)
Modem_F.Show
End Sub
Private Sub Next_Step_Click()
Dim p
Priv_Step.Enabled = True
If Step >= Step_Count Then
Next_Step.Enabled = False
Exit Sub
End If
Step = Step + 1
p = Draw_Point(Record(Step).X, Record(Step).Y, Record(Step).Color)
step_show.Cls
step_show.Print Step
p = Count_All_Gas
Refresh_Board
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
'p = Count_All_Gas
'Refresh_Board
End Sub
Private Sub Open_Click(Index As Integer)
On Error GoTo errhandler
Dim temp
Dim i As Integer
temp = 0
COMDIAL.Filter = "WeiQi File|*.go"
COMDIAL.ShowOpen
Open (COMDIAL.FileName) For Input As #READF
Cls
Step = 0
Begin_Flag = 1
TURN = BLACKP
Draw_Board
Ini_Board
Next_Step.Enabled = True
Priv_Step.Enabled = True
All_Step.Enabled = True
TimeB.Visible = False
TimeW.Visible = False
Back.Enabled = False
Open_F = 1
For i = 1 To MAXSTEP
Line Input #READF, temp
If temp = "!" Then
Line Input #READF, Step_Count
Line Input #READF, Black_Name
Line Input #READF, White_Name
Line Input #READF, Add_Message
Players.Black_N.Text = Black_Name
Players.White_N.Text = White_Name
Players.Kibbitz.Text = Add_Message
Players.Show
Close #READF
Exit Sub
End If
Record(i).Color = temp
Line Input #READF, temp
Record(i).X = temp
Line Input #READF, temp
Record(i).Y = temp
Next i
Close #READF
errhandler:
Close #READF
Exit Sub
End Sub
Private Sub Priv_Step_Click()
Dim p
Dim i As Integer
Next_Step.Enabled = True
If Step <= 1 Then
Ini_Board
Draw_Board
Priv_Step.Enabled = False
Exit Sub
End If
Draw_Board
Ini_Board
For i = 1 To Step - 1
p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
step_show.Cls
step_show.Print Step
p = Count_All_Gas
If TURN = BLACKP Then
TURN = WHITEP
Else
TURN = BLACKP
End If
Next i
Refresh_Board
Step = Step - 1
End Sub
Private Sub Quit_Click(Index As Integer)
If Net.Enabled = True Then
Unload Net
End If
If Modem_F.Enabled = True Then
Unload Modem_F
End If
Unload Me
End Sub
Private Sub Save_Click(Index As Integer)
On Error GoTo quit
Dim i, j As Integer
COMDIAL.Filter = "WeiQi File|*.go"
COMDIAL.ShowSave
Open (COMDIAL.FileName) For Output As #SAVEF
If Step <= 1 Then
Beep
MsgBox "没有可以保存的对局"
GoTo quit
End If
For i = 1 To Step - 1
Print #SAVEF, Record(i).Color
Print #SAVEF, Record(i).X
Print #SAVEF, Record(i).Y
Next i
Print #SAVEF, "!"
Print #SAVEF, Step - 1
Players.Show
Do
If Players.Visible = False Then
Exit Do
End If
DoEvents
Loop
Print #SAVEF, Black_Name
Print #SAVEF, White_Name
Print #SAVEF, Add_Message
Close #SAVEF
quit:
Exit Sub
End Sub
Private Sub Talking_Click()
If ModemState = LOGIN And S_R = 1 Then
Talk_To_Him.Show
End If
End Sub
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
Select Case h
Case 2:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 16).X = 16
Board(16, 16).Y = 16
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Step = 3
Case 3:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(16, 4).X = 16
Board(16, 4).Y = 4
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Step = 4
Case 4:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Step = 5
Case 5:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(10, 10).Color = BLACKP
Board(10, 10).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(10, 10).X = 10
Board(10, 10).Y = 10
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(10, 10, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 10
Record(5).Y = 10
Step = 6
Case 6:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 10).Color = BLACKP
Board(4, 10).Gas = 0
Board(16, 10).Color = BLACKP
Board(16, 10).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(4, 10).X = 4
Board(4, 10).Y = 10
Board(16, 10).X = 16
Board(16, 10).Y = 10
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(4, 10, BLACKP)
p = Draw_Point(16, 10, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 4
Record(5).Y = 10
Record(6).X = 16
Record(6).Y = 10
Step = 7
Case 7:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 10).Color = BLACKP
Board(4, 10).Gas = 0
Board(16, 10).Color = BLACKP
Board(16, 10).Gas = 0
Board(10, 10).Color = BLACKP
Board(10, 10).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(4, 10).X = 4
Board(4, 10).Y = 10
Board(16, 10).X = 16
Board(16, 10).Y = 10
Board(10, 10).X = 10
Board(10, 10).Y = 10
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(4, 10, BLACKP)
p = Draw_Point(16, 10, BLACKP)
p = Draw_Point(10, 10, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 4
Record(5).Y = 10
Record(6).X = 16
Record(6).Y = 10
Record(7).X = 10
Record(7).Y = 10
Step = 8
Case 8:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 10).Color = BLACKP
Board(4, 10).Gas = 0
Board(16, 10).Color = BLACKP
Board(16, 10).Gas = 0
Board(10, 4).Color = BLACKP
Board(10, 4).Gas = 0
Board(10, 16).Color = BLACKP
Board(10, 16).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(4, 10).X = 4
Board(4, 10).Y = 10
Board(16, 10).X = 16
Board(16, 10).Y = 10
Board(10, 4).X = 10
Board(10, 4).Y = 4
Board(10, 16).X = 10
Board(10, 16).Y = 16
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(4, 10, BLACKP)
p = Draw_Point(16, 10, BLACKP)
p = Draw_Point(10, 4, BLACKP)
p = Draw_Point(10, 16, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 4
Record(5).Y = 10
Record(6).X = 16
Record(6).Y = 10
Record(7).X = 10
Record(7).Y = 4
Record(8).X = 10
Record(8).Y = 16
Step = 9
Case 9:
Board(4, 4).Color = BLACKP
Board(4, 4).Gas = 0
Board(16, 16).Color = BLACKP
Board(16, 16).Gas = 0
Board(16, 4).Color = BLACKP
Board(16, 4).Gas = 0
Board(4, 16).Color = BLACKP
Board(4, 16).Gas = 0
Board(4, 10).Color = BLACKP
Board(4, 10).Gas = 0
Board(16, 10).Color = BLACKP
Board(16, 10).Gas = 0
Board(10, 4).Color = BLACKP
Board(10, 4).Gas = 0
Board(10, 16).Color = BLACKP
Board(10, 16).Gas = 0
Board(10, 10).Color = BLACKP
Board(10, 10).Gas = 0
Board(4, 4).X = 4
Board(4, 4).Y = 4
Board(16, 16).X = 16
Board(16, 16).Y = 16
Board(16, 4).X = 16
Board(16, 4).Y = 4
Board(4, 16).X = 4
Board(4, 16).Y = 16
Board(4, 10).X = 4
Board(4, 10).Y = 10
Board(16, 10).X = 16
Board(16, 10).Y = 10
Board(10, 4).X = 10
Board(10, 4).Y = 4
Board(10, 16).X = 10
Board(10, 16).Y = 16
Board(10, 16).X = 10
Board(10, 16).Y = 10
p = Draw_Point(4, 4, BLACKP)
p = Draw_Point(16, 16, BLACKP)
p = Draw_Point(16, 4, BLACKP)
p = Draw_Point(4, 16, BLACKP)
p = Draw_Point(4, 10, BLACKP)
p = Draw_Point(16, 10, BLACKP)
p = Draw_Point(10, 4, BLACKP)
p = Draw_Point(10, 16, BLACKP)
p = Draw_Point(10, 10, BLACKP)
Record(1).Color = BLACKP
Record(1).X = 4
Record(1).Y = 4
Record(2).Color = BLACKP
Record(2).X = 16
Record(2).Y = 16
Record(3).Color = BLACKP
Record(3).X = 16
Record(3).Y = 4
Record(4).Color = BLACKP
Record(4).X = 4
Record(4).Y = 16
Record(5).Color = BLACKP
Record(5).X = 4
Record(5).Y = 10
Record(6).X = 16
Record(6).Y = 10
Record(7).X = 10
Record(7).Y = 4
Record(8).X = 10
Record(8).Y = 16
Record(9).X = 10
Record(9).Y = 10
Step = 10
End Select
If Side = BLACKP Then
S_R = 0
R_R = 1
Else
S_R = 1
R_R = 0
End If
End Sub
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit
' 注册键安全选项...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' 注册键 ROOT 类型...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode 以 Null 结尾的字符串
Const REG_DWORD = 4 ' 32-位数字
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Caption = "关于 " & App.Title
'lblVersion.Caption = "版本 " & App.Major & "." & App.Minor & "." & App.Revision
'lblTitle.Caption = App.Title
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' 试图从注册表得到系统信息程序路径\名称...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' 试图从注册表得到系统信息程序路径...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' 验证已知 32 位文件版本的存在
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
' 错误 - 文件未找到...
Else
GoTo SysInfoErr
End If
' 错误 - 注册项未找到...
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "此时系统信息无效", vbOKOnly
End Sub
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' 循环指针
Dim rc As Long ' 返回代码
Dim hKey As Long ' 打开的注册键的句柄
Dim hDepth As Long '
Dim KeyValType As Long ' 注册键的数据类型
Dim tmpVal As String ' 注册键的临时存储区
Dim KeyValSize As Long ' 注册键变量的大小
'------------------------------------------------------------
' 在根键 {HKEY_LOCAL_MACHINE...} 下打开注册键
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册键
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 句柄错误...
tmpVal = String$(1024, 0) ' 分配变量空间
KeyValSize = 1024 ' 标记变量大小
'------------------------------------------------------------
' 检索注册键值...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' 获得/创建键值
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 句柄错误
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 添加以 Null 结尾的字符串...
tmpVal = LEFT(tmpVal, KeyValSize - 1) ' Null 找到，从字符串提取
Else ' WinNT 不需要以 Null 结束字符串...
tmpVal = LEFT(tmpVal, KeyValSize) ' Null 未找到， 仅提取字符串
End If
'------------------------------------------------------------
' 为了转换而决定键值类型..
'------------------------------------------------------------
Select Case KeyValType ' 搜索数据类型...
Case REG_SZ ' 字符串型注册键数据类型
KeyVal = tmpVal ' 复制字符串值
Case REG_DWORD ' 双字型注册键数据类型
For i = Len(tmpVal) To 1 Step -1 ' 转换每一位
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' 一个字符一个字符地建立值
Next
KeyVal = Format$("&h" + KeyVal) ' 转换双字型为字符串型
End Select
GetKeyValue = True ' 返回成功
rc = RegCloseKey(hKey) ' 关闭注册键
Exit Function ' 退出
GetKeyError: ' 发生错误后清除...
KeyVal = "" ' 设置返回值为空字符串
GetKeyValue = False ' 返回失败
rc = RegCloseKey(hKey) ' 关闭注册键
End Function
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit
Dim Buffer$
Dim ConnectStatus As Integer
Dim Port As Integer
Const WaitConst = 10
Const WaitConnectConst = 90
Const NotConnected = 1
Const NeedPassword = 2
Const CONNECTED = 3
Dim ParseArray(5)
Const MSCOMM_HANDSHAKE_NONE = 0
Const MSCOMM_HANDSHAKE_XONXOFF = 1
Const MSCOMM_HANDSHAKE_RTS = 2
Const MSCOMM_HANDSHAKE_RTSXONXOFF = 3
Const MSCOMM_EV_SEND = 1
Const MSCOMM_EV_RECEIVE = 2
Const MSCOMM_EV_CTS = 3
Const MSCOMM_EV_DSR = 4
Const MSCOMM_EV_CD = 5
Const MSCOMM_EV_RING = 6
Const MSCOMM_EV_EOF = 7
Const MSCOMM_ER_BREAK = 1001
Const MSCOMM_ER_CTSTO = 1002
Const MSCOMM_ER_DSRTO = 1003
Const MSCOMM_ER_FRAME = 1004
Const MSCOMM_ER_OVERRUN = 1006
Const MSCOMM_ER_CDTO = 1007
Const MSCOMM_ER_RXOVER = 1008
Const MSCOMM_ER_RXPARITY = 1009
Const MSCOMM_ER_TXFULL = 1010
Private Sub Dial_Click()
Dim W As String
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
Modem_Status.Cls
Modem_Status.Print "Checking Modem..."
Pause 2
MyOpenPort (Port)
If IsNumeric(Number.Text) = False Or Len(Number.Text) <= 2 Then
Beep
MsgBox ("Invalid Phone Number")
Exit Sub
End If
Comm1.Output = "AT" + Chr$(13)
g_ErrorCode = 0
W$ = WaitForValue("OK", WaitConst)
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "Modem OK"
Pause 1
Else
Modem_Status.Cls
Modem_Status.Print "Modem Not Responding"
Pause 1
AbortCall
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
Exit Sub
End If
Modem_Status.Cls
Modem_Status.Print "Dialing..."
Comm1.Output = "ATDT" + Number.Text + Chr$(13)
W$ = WaitForValue("CONNECT", WaitConnectConst)
'Wait for CONNECT
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "Connected"
ModemState = CONNECT
HOST = SERVER
Pause 3
Sendlogin
Pause 1
Recievelogin
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
Else
If InStr(W$, "BUSY") Then
Modem_Status.Cls
Modem_Status.Print "Line Busy"
ModemState = BUSY
ElseIf InStr(1, W$, "No Dialtone", 1) Then
Modem_Status.Cls
Modem_Status.Print "No DialTone"
ModemState = NODIALTONE
ElseIf InStr(1, W$, "No Carrier", 1) Then
Modem_Status.Cls
Modem_Status.Print "No Carrier"
ModemState = NOCARRIER
Else
Modem_Status.Cls
Modem_Status.Print "Connect Failed"
ModemState = FAILED
End If
AbortCall
Exit Sub
End If
End Sub
Private Sub Cancel_Click()
AbortCall
Unload Me
End Sub
Private Sub MyOpenPort(p As Integer)
Dim i As Integer
Dim Mss
If Comm1.PortOpen = False Then
Comm1.CommPort = p
If (IsNumeric(Speed.Text)) Then
Comm1.Settings = Speed.Text & ",N,8,1"
Else
Comm1.Settings = "9600,N,8,1"
End If
Comm1.PortOpen = True
End If
End Sub
Private Sub Sendlogin()
If HOST = SERVER Then
If white.Value <> True Then
black.Value = True
Side = BLACKP
S_R = 1
R_R = 0
Comm1.Output = "NA" + My_name.Text + "#B" + "#H" + Handicap.Text + ";" + Chr$(13)
Else
Comm1.Output = "NA" + My_name.Text + "#W" + "#H" + Handicap.Text + ";" + Chr$(13)
Side = WHITEP
S_R = 0
R_R = 1
End If
Else
Comm1.Output = "NA" + My_name.Text + "##" + "#H0;" + Chr$(13)
End If
End Sub
Private Sub Recievelogin()
Dim pos, p1, p2, p3, p4 As Integer
Dim t As String
Buffer = WaitForValue(";", 15)
pos = InStr(Buffer, "NA")
p1 = InStr(Buffer, "#B")
p2 = InStr(Buffer, "#W")
p3 = InStr(Buffer, "##")
p4 = InStr(Buffer, "#H")
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "LOGIN OK"
ModemState = LOGIN
If p1 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p1 - pos - 2)
Else
If p2 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p2 - pos - 2)
Else
If p3 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p3 - pos - 2)
End If
End If
End If
'set handicap
If HOST = SERVER Then
Hand = CInt(Handicap.Text)
End If
If HOST = CLIENT Then
t = Mid$(Buffer, p4 + 2, 1)
Hand = CInt(t)
If p1 Then
white.Value = True
Side = WHITEP
S_R = 0
R_R = 1
Else
black.Value = True
Side = BLACKP
S_R = 1
R_R = 0
End If
End If
Pause 1
Me.WindowState = 1
Call Form1.Begin_Click
Else
Modem_Status.Cls
Modem_Status.Print "LOGIN Failed"
ModemState = FAILED
AbortCall
End If
End Sub
Private Sub AbortCall()
Dim i As Integer
MyOpenPort (Port)
On Error GoTo Err
Comm1.Output = "+++ATH" & Chr$(13)
ModemState = IDLE
Err:
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End Sub
Public Sub Disconnect_Click()
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
Modem_Status.Cls
Modem_Status.Print "Disconnecting..."
Pause 1
AbortCall
Modem_Status.Cls
Modem_Status.Print "Modem Idle"
ModemState = IDLE
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End Sub
Private Sub Form_Load()
MPort.AddItem "COM1"
MPort.AddItem "COM2"
MPort.AddItem "COM3"
MPort.AddItem "COM4"
MPort.Text = "COM1"
Speed.AddItem "2400"
Speed.AddItem "4800"
Speed.AddItem "9600"
Speed.AddItem "14400"
Speed.AddItem "28800"
Speed.Text = "9600"
Handicap.AddItem "0"
Handicap.AddItem "1"
Handicap.AddItem "2"
Handicap.AddItem "3"
Handicap.AddItem "4"
Handicap.AddItem "5"
Handicap.AddItem "6"
Handicap.AddItem "7"
Handicap.AddItem "8"
Handicap.AddItem "9"
Handicap.Text = "0"
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
HOST = -1
Port = 1
End Sub
Private Sub Set_Click()
Dim i As Integer
i = 1
Select Case MPort.Text
Case "COM1":
i = 1
Case "COM2":
i = 2
Case "COM3":
i = 3
Case "COM4":
i = 4
End Select
If IsNumeric(Handicap.Text) Then
GoTo out
Else
MsgBox "Set Handicap please!"
Exit Sub
End If
out:
Port = i
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End Sub
Private Sub Wait_Click()
Dim W$
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
MyOpenPort (Port)
Modem_Status.Cls
Modem_Status.Print "Waiting for call..."
Do
DoEvents
If Comm1.InBufferCount <> 0 Then
g_ErrorCode = 0
W$ = WaitForValue("RING", 30)
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "Modem Ringing..."
Pause 1
Modem_Status.Cls
Modem_Status.Print "Answering..."
Comm1.Output = "ATA" & Chr$(13)
W$ = WaitForValue("CONNECT", WaitConnectConst)
If g_ErrorCode = 0 Then
Modem_Status.Cls
Modem_Status.Print "Connected"
ModemState = CONNECT
Pause 3
HOST = CLIENT
Recievelogin
Sendlogin
Dial.Enabled = False
Disconnect.Enabled = True
Wait.Enabled = False
Else
Modem_Status.Cls
Modem_Status.Print "Connect Failed"
AbortCall
Modem_Status.Cls
Modem_Status.Print "Modem Idle"
ModemState = IDLE
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End If
Exit Sub
End If
ModemState = IDLE
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
Exit Sub
End If
Loop
End Sub
Public Sub Send_Msg(Msg_No As Integer)
If ModemState = LOGIN Then
Comm1.InBufferCount = 0
If IsNumeric(Msg(Msg_No).X) Then
Comm1.Output = "B" + Str(Msg(Msg_No).No) + "|" _
+ Str(Msg(Msg_No).Color) + "|" _
+ Str(Msg(Msg_No).X) + "|" _
+ Str(Msg(Msg_No).Y) + "|" _
+ Msg(Msg_No).E + "|;" + Chr$(26)
Else
Comm1.Output = "B" + Str(Msg(Msg_No).No) + "|" _
+ Str(Msg(Msg_No).Color) + "|" _
+ (Msg(Msg_No).X) + "|" _
+ Str(Msg(Msg_No).Y) + "|" _
+ Msg(Msg_No).E + "|;" + Chr$(26)
End If
End If
End Sub
Public Sub Con_msg(N As Integer, C As Integer, X As Variant, Y As Variant)
Msg(N).No = N
Msg(N).Color = C
Msg(N).X = X
Msg(N).Y = Y
Msg(N).E = "E"
End Sub
Public Function WaitForValue(Wait$, WaitTime) As String
Dim Receive$, StartTime, EndTime, MyIn$, ErrCode%, there%
Comm1.InputLen = 1
g_ErrorCode = 0
Receive = " "
MyIn$ = ""
StartTime = Timer
EndTime = StartTime + WaitTime
Do
DoEvents
If Comm1.InBufferCount <> 0 Then
MyIn$ = MyIn$ & Comm1.Input
there% = InStr(MyIn$, Wait$)
If there% Then
Exit Do
End If
End If
If Timer >= EndTime Then
g_ErrorCode = 1
Exit Do
End If
Loop
WaitForValue = MyIn$
End Function
Public Function Exist_Msg() As Boolean
If Comm1.InBufferCount Then
Exist_Msg = True
Else
Exist_Msg = False
End If
End Function
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit
Const MaxLen = 100
Dim Be_Host As Boolean
Public Message_Exist As Boolean 'indicate if a message existed
Dim Buffer$
Private Sub Called_Click()
Calling.Enabled = False
Winsock1.LocalPort = 888
Winsock1.Listen
Net_Status.Caption = "正在等待呼叫......"
Called.Enabled = False
Be_Host = True
End Sub
Private Sub Calling_Click()
Called.Enabled = False
If Address.Text <> " " Then
Winsock1.RemoteHost = Address.Text
Winsock1.RemotePort = 888
Net_Status.Caption = "正在呼叫庄家......"
Winsock1.CONNECT
End If
Be_Host = False
End Sub
Private Sub Exit_Click()
If Winsock1.State <> 0 Then
Winsock1.Close
SocketState = UNCONNECTED
End If
Unload Me
End Sub
Private Sub Form_Load()
Handicap.AddItem "0"
Handicap.AddItem "1"
Handicap.AddItem "2"
Handicap.AddItem "3"
Handicap.AddItem "4"
Handicap.AddItem "5"
Handicap.AddItem "6"
Handicap.AddItem "7"
Handicap.AddItem "8"
Handicap.AddItem "9"
Handicap.Text = "0"
Message_Exist = False
End Sub
Private Sub Winsock1_Connect()
Net_Status.Caption = "正常连接！"
SocketState = CONNECTED
Pause 1
Sendlogin
Pause 1
Recievelogin
End Sub
Private Sub Winsock1_ConnectionRequest _
(ByVal requestID As Long)
'测试 State 属性，如果当前连接是打开的话，
'则关闭连接。
If Winsock1.State <> sckClosed Then Winsock1.Close
'将 requestID 参数值传递给 Accept 方法。
Winsock1.Accept requestID
Net_Status.Caption = "正常连接！"
SocketState = CONNECTED
Pause 1
Sendlogin
Pause 1
Recievelogin
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Message_Exist = True
End Sub
Public Sub Send_Msg(Msg_No As Integer)
Dim temp$
If Winsock1.State = sckConnected Then
If Message_Exist = True Then
Winsock1.GetData temp, vbString, MaxLen
Message_Exist = False
End If
If IsNumeric(Msg(Msg_No).X) Then
Winsock1.SendData ("B" + Str(Msg(Msg_No).No) + "|" _
+ Str(Msg(Msg_No).Color) + "|" _
+ Str(Msg(Msg_No).X) + "|" _
+ Str(Msg(Msg_No).Y) + "|" _
+ Msg(Msg_No).E + "|;" + Chr$(26))
Else
Winsock1.SendData ("B" + Str(Msg(Msg_No).No) + "|" _
+ Str(Msg(Msg_No).Color) + "|" _
+ (Msg(Msg_No).X) + "|" _
+ Str(Msg(Msg_No).Y) + "|" _
+ Msg(Msg_No).E + "|;" + Chr$(26))
End If
Else
SocketState = UNCONNECTED
Beep
MsgBox ("对手已经离开！")
End If
End Sub
Public Sub Con_msg(N As Integer, C As Integer, X As Variant, Y As Variant)
Msg(N).No = N
Msg(N).Color = C
Msg(N).X = X
Msg(N).Y = Y
Msg(N).E = "E"
End Sub
Public Function WaitForValue(Wait$, WaitTime) As String
Dim Receive$, StartTime, EndTime, MyIn$, ErrCode%, there%
g_ErrorCode = 0
Receive = " "
MyIn$ = ""
StartTime = Timer
EndTime = StartTime + WaitTime
'If Winsock1.State <> sckConnected Then
'Message_Exist = False
'Exit Function
'End If
Do
DoEvents
If Message_Exist = True Then
Winsock1.GetData MyIn$, vbString, MaxLen
Message_Exist = False
there% = InStr(MyIn$, Wait$)
If there% Then
Exit Do
End If
End If
If Timer >= EndTime Then
g_ErrorCode = 1
Exit Do
End If
Loop
WaitForValue = MyIn$
End Function
Public Function Disconnect()
Winsock1.Close
SocketState = UNCONNECTED
Message_Exist = False
End Function
Private Sub Sendlogin()
If Be_Host = True Then
If White.Value <> True Then
black.Value = True
Side = BLACKP
S_R = 1
R_R = 0
Winsock1.SendData ("NA" + My_name.Text + "#B" + "#H" + Handicap.Text + ";" + Chr$(13))
Else
Winsock1.SendData ("NA" + My_name.Text + "#W" + "#H" + Handicap.Text + ";" + Chr$(13))
Side = WHITEP
S_R = 0
R_R = 1
End If
Else
Winsock1.SendData ("NA" + My_name.Text + "##" + "#H0;" + Chr$(13))
End If
End Sub
Private Sub Recievelogin()
Dim pos, p1, p2, p3, p4 As Integer
Dim t As String
Buffer = WaitForValue(";", 15)
pos = InStr(Buffer, "NA")
p1 = InStr(Buffer, "#B")
p2 = InStr(Buffer, "#W")
p3 = InStr(Buffer, "##")
p4 = InStr(Buffer, "#H")
If g_ErrorCode = 0 Then
Net_Status.Caption = "正常登录！"
SocketState = CONNECTED
If p1 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p1 - pos - 2)
Else
If p2 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p2 - pos - 2)
Else
If p3 <> 0 Then
His_Name.Text = Mid$(Buffer, pos + 2, p3 - pos - 2)
End If
End If
End If
'set handicap
If Be_Host = True Then
If (Len(Handicap.Text) <> 0) Then
Hand = CInt(Handicap.Text)
Else
Hand = 0
End If
End If
If Be_Host = False Then
t = Mid$(Buffer, p4 + 2, 1)
If Len(t) <> 0 Then
Hand = CInt(t)
Handicap.Text = Str(Hand)
Else
Hand = 0
End If
If p1 Then
White.Value = True
Side = WHITEP
S_R = 0
R_R = 1
Else
black.Value = True
Side = BLACKP
S_R = 1
R_R = 0
End If
End If
Me.WindowState = 1
Call Form1.Begin_Click
Else
Net_Status.Caption = "登录失败！"
SocketState = UNCONNECTED
Disconnect
End If
End Sub
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Private Sub Cancel_Click()
Black_Name = " "
White_Name = " "
Add_Message = " "
Unload Me
End Sub
Private Sub Form_Load()
If ModemState = LOGIN Then
If Len(Modem_F.My_name.Text) <> 0 And Side = BLACKP Then
Black_N.Text = Modem_F.My_name.Text
End If
If Len(Modem_F.My_name.Text) <> 0 And Side = WHITEP Then
White_N.Text = Modem_F.My_name.Text
End If
If Len(Modem_F.His_Name.Text) <> 0 And Side = WHITEP Then
Black_N.Text = Modem_F.His_Name.Text
End If
If Len(Modem_F.His_Name.Text) <> 0 And Side = BLACKP Then
White_N.Text = Modem_F.His_Name.Text
End If
End If
End Sub
Private Sub OK_Click()
Black_Name = Black_N.Text
White_Name = White_N.Text
Add_Message = Kibbitz.Text
Unload Me
End Sub
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Private Sub Cancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
Topic.AddItem ("Hi!")
Topic.AddItem ("Hello!")
Topic.AddItem ("ByeBye")
Topic.AddItem ("Are you there?")
Topic.AddItem ("Where are you from?")
Topic.AddItem ("I have to leave now,I am sorry.")
Topic.AddItem ("I have to take a dinner.")
Topic.AddItem ("You don't mind a undo?")
Topic.AddItem ("No,I don't mind.")
Topic.AddItem ("Please don't do it!")
Topic.AddItem ("You are a good player.")
End Sub
Private Sub Say_Click()
'Modem process begin
Dim Try As Integer
Try = 0
If ModemState = LOGIN Then
If S_R <> 1 Then
Beep
Exit Sub
End If
Call Modem_F.Con_msg(Msg_No, TALK, Topic.Text, 0)
Resend:
Call Modem_F.Send_Msg(Msg_No)
Call Modem_F.WaitForValue("R_O", 10)
If Try >= 2 Then
'Talking failed
Beep
MsgBox ("对手已经离开")
Modem_F.WindowState = 0
Call Modem_F.Disconnect_Click
Unload Me
Exit Sub
End If
If g_ErrorCode = 1 Then
Try = Try + 1
GoTo Resend
End If
Msg_No = Msg_No + 1
End If
Unload Me
'Modem Process end
End Sub
##########################################
模块
Option Explicit
Global Const MAXSTEP = 400 'Max number of steps
Global Const CHECKED = 1
Global Const UNCHECKED = 0
Global Const LEFT = 1
Global Const RIGHT = 2
Global Const UP = 3
Global Const Down = 4
Global Const ERASEP = -1
Global Const EMPTYP = 0
Global Const BLACKP = 1
Global Const WHITEP = 2
Global Const BOLDP = 3
Global TURN As Integer
Global MYCOLOR, HISCOLOR As Integer
Global Step As Integer
Global Msg_No As Integer
Global Hand As Integer
Global Current As Boolean
Global HOST As Integer
Global Const SERVER = 0
Global Const CLIENT = 1
Global Black_Name As String
Global White_Name As String
Global Add_Message As String
Global ModemState As Integer
Global SocketState As Integer
Global PlayState As Integer
Global Const CONNECTED = 1
Global Const UNCONNECTED = 0
Global S_R As Integer 'Send Ready
Global R_R As Integer 'Receive Ready
Global Side As Integer 'Which side I am taking
Global Const IDLE = 0
Global Const BUSY = 1
Global Const NODIALTONE = 2
Global Const NOCARRIER = 3
Global Const CONNECT = 4
Global Const FAILED = 5
Global Const LOGIN = 6
Global Const GIVEUP = -1
Global Const PLAY = 2
Global Const COUNTAREA = 3
Global Const TALK = 4
Global Const FINISHED = -4
Global Const UNDO = -2
Global Const LOGOUT = -3
Global g_ErrorCode As Integer
Global ParseArray(5)
Public Type Stone
Color As Integer
X As Integer
Y As Integer
Eat As Boolean 'Did it eat some stone?
End Type
Public Type MyPoint
Color As Integer
X As Integer
Y As Integer
Status As Integer
Gas As Integer
Current As Boolean
End Type
Public Type Message
No As Integer
Color As Integer
X As Variant
Y As Variant
E As String
End Type
Global Msg(1 To MAXSTEP) As Message
Global Board(1 To 19, 1 To 19) As MyPoint
Global Record(1 To MAXSTEP) As Stone
Public Function Count_Gas(p As MyPoint) As Integer
Dim l, r, u, d As Integer
Dim lx, ly, rx, ry, ux, uy, dx, dy As Integer
Dim lc, ls, lg, rc, rs, rg, uc, us, ug, dc, ds, du, dg As Integer
Dim nogas As Boolean
Dim ltp, rtp, utp, dtp As MyPoint
nogas = No_Gas(p)
lx = Near_Point(LEFT, p).X
ly = Near_Point(LEFT, p).Y
rx = Near_Point(RIGHT, p).X
ry = Near_Point(RIGHT, p).Y
ux = Near_Point(UP, p).X
uy = Near_Point(UP, p).Y
dx = Near_Point(Down, p).X
dy = Near_Point(Down, p).Y
If lx = 0 Then
lc = BOLDP
ls = CHECKED
lg = 0
Else
lc = Board(lx, ly).Color
ls = Board(lx, ly).Status
lg = Board(lx, ly).Gas
End If
If rx = 20 Then
rc = BOLDP
rs = CHECKED
rg = 0
Else
rc = Board(rx, ry).Color
rs = Board(rx, ry).Status
rg = Board(rx, ry).Gas
End If
If uy = 0 Then
uc = BOLDP
us = CHECKED
ug = 0
Else
uc = Board(ux, uy).Color
us = Board(ux, uy).Status
ug = Board(ux, uy).Gas
End If
If dy = 20 Then
dc = BOLDP
ds = CHECKED
dg = 0
Else
dc = Board(dx, dy).Color
ds = Board(dx, dy).Status
dg = Board(dx, dy).Gas
End If
If nogas = False Then
Count_Gas = 1
Board(p.X, p.Y).Gas = 1
Board(p.X, p.Y).Status = CHECKED
If (lx > 0 And lx < 20 And ly > 0 And ly < 20) Then
If Board(lx, ly).Color = p.Color Then
Board(lx, ly).Gas = 1
Board(lx, ly).Status = CHECKED
End If
End If
If (rx > 0 And rx < 20 And ry > 0 And ry < 20) Then
If Board(rx, ry).Color = p.Color Then
Board(rx, ry).Gas = 1
Board(rx, ry).Status = CHECKED
End If
End If
If (ux > 0 And ux < 20 And uy > 0 And uy < 20) Then
If Board(ux, uy).Color = p.Color Then
Board(ux, uy).Gas = 1
Board(ux, uy).Status = CHECKED
End If
End If
If (dx > 0 And dx < 20 And dy > 0 And dy < 20) Then
If Board(dx, dy).Color = p.Color Then
Board(dx, dy).Gas = 1
Board(dx, dy).Status = CHECKED
End If
End If
Exit Function
End If
If nogas = True Then
Board(p.X, p.Y).Status = CHECKED
l = r = u = d = 0
If lc = EMPTYP Then
l = 1
GoTo out
Else
If lc = BOLDP Or lc <> p.Color Then
l = 0
Else
If ls = CHECKED And lg = 1 Then
l = 1
GoTo out
Else
If ls = UNCHECKED Then
l = Count_Gas(Near_Point(LEFT, p))
Else
l = 0
End If
End If
End If
End If
If rc = EMPTYP Then
r = 1
GoTo out
Else
If rc = BOLDP Or rc <> p.Color Then
r = 0
Else
If rs = CHECKED And rg = 1 Then
r = 1
GoTo out
Else
If rs = UNCHECKED Then
r = Count_Gas(Near_Point(RIGHT, p))
Else
r = 0
End If
End If
End If
End If
If uc = EMPTYP Then
u = 1
GoTo out
Else
If uc = BOLDP Or uc <> p.Color Then
u = 0
Else
If us = CHECKED And ug = 1 Then
u = 1
GoTo out
everyask 2001-09-03
- 打赏
- 举报
up
escapism 2001-09-02
- 打赏
- 举报
五子棋的AI你不妨自己找本人工智能的书看看
因为五子棋可以用生成搏弈树寻找最优下发的方法
这和8后问题的解决办法相差不大
若是生成围棋的搏弈树可能会在速度和系统资源上造成巨大开销
围棋可能不是用搏弈树的方法来做的（我猜的）
以国际象棋的AI（IBM深蓝）来看好像是预先储存了大量的资料以对应不同的情况
之所以拿深蓝来和人作对弈是因为深蓝可以考虑向后的多步
这又和人工智能中的搏弈问题的解决方法是一致的
所以你可以多了解些人工智能方面的资料
我有人工智能的书（这门功课刚考完不久，师太关了好多人可想而知人工智能有多可怕）可是没有电子版的
没法给你
你可以自己去买，书店应该会有的（似乎看到过）
因为五子棋可以用生成搏弈树寻找最优下发的方法
这和8后问题的解决办法相差不大
若是生成围棋的搏弈树可能会在速度和系统资源上造成巨大开销
围棋可能不是用搏弈树的方法来做的（我猜的）
以国际象棋的AI（IBM深蓝）来看好像是预先储存了大量的资料以对应不同的情况
之所以拿深蓝来和人作对弈是因为深蓝可以考虑向后的多步
这又和人工智能中的搏弈问题的解决方法是一致的
所以你可以多了解些人工智能方面的资料
我有人工智能的书（这门功课刚考完不久，师太关了好多人可想而知人工智能有多可怕）可是没有电子版的
没法给你
你可以自己去买，书店应该会有的（似乎看到过）
lanren_me 2001-09-02
- 打赏
- 举报
学习
everyask 2001-09-01
- 打赏
- 举报
blow_jj(纪俊) ：
http://www.edgewww.com/vb/code9.php3
上不去啊！
如果你能上去，能否帮忙发个邮件？
地址：everyask@263.net
谢谢了！！
escapism(后门吹雪) ：
我的要求不高：有根据定式或厚势走棋的功能就可以了。
http://www.edgewww.com/vb/code9.php3
上不去啊！
如果你能上去，能否帮忙发个邮件？
地址：everyask@263.net
谢谢了！！
escapism(后门吹雪) ：
我的要求不高：有根据定式或厚势走棋的功能就可以了。
woowindice 2001-09-01
- 打赏
- 举报
up
escapism 2001-08-31
- 打赏
- 举报
围棋的人工智能很难实现，需要有大量的棋谱作为资料
而五子棋则不同，做最优下法选择猜测5步以上也用不了多少cpu时间
所以五子棋对弈常有人工智能，如果你能做出带人工智能的围棋对弈软件
你也可以去参加应氏杯了
而五子棋则不同，做最优下法选择猜测5步以上也用不了多少cpu时间
所以五子棋对弈常有人工智能，如果你能做出带人工智能的围棋对弈软件
你也可以去参加应氏杯了
纪俊 2001-08-31
- 打赏
- 举报
http://www.edgewww.com/vb/code9.php3
这里有:)
这里有:)
everyask 2001-08-31
- 打赏
- 举报
楼上提供的站点不错啊！挺有意思的。
不过我下了几个都不带人工智能啊！
其中有一个是随机走棋，还有一个竟然是直线走棋。
哪一个有点人工智能呢？比如可以根据定式走棋等。
谢谢了！！
不过我下了几个都不带人工智能啊！
其中有一个是随机走棋，还有一个竟然是直线走棋。
哪一个有点人工智能呢？比如可以根据定式走棋等。
谢谢了！！
everyask 2001-08-31
- 打赏
- 举报
谢谢！
可惜不是人机对弈程序，而且无源码。
能否再帮忙找找呢？
可惜不是人机对弈程序，而且无源码。
能否再帮忙找找呢？
bkyman 2001-08-31
- 打赏
- 举报
好像人家都不公开源码的，有一个地址：
http://member.netease.com/~kerry98/gofield/wqrj.htm
http://member.netease.com/~kerry98/gofield/wqrj.htm
