xq.frm

此文件为一款非常出色的黑白棋游戏

For i% = 1 To Y% - 1
If qizi(X%, Y% - i%) = 0 Then Exit For
If qizi(X%, Y% - i%) = c% Then
For o% = 1 To i%
 qizi(X%, Y% - o%) = c%
Next
Exit For
End If
Next

For i% = 1 To X% - 1
If qizi(X% - i%, Y%) = 0 Then Exit For
If qizi(X% - i%, Y%) = c% Then
For o% = 1 To i%
 qizi(X% - o%, Y%) = c%
Next
Exit For
End If
Next

For i% = 1 To 16 - Y%
If qizi(X%, Y% + i%) = 0 Then Exit For
If qizi(X%, Y% + i%) = c% Then
For o% = 1 To i%
 qizi(X%, Y% + o%) = c%
Next
Exit For
End If
Next

For i% = 1 To 16 - X%
If qizi(X% + i%, Y%) = 0 Then Exit For
If qizi(X% + i%, Y%) = c% Then
For o% = 1 To i%
 qizi(X% + o%, Y%) = c%
Next
Exit For
End If
Next

For i% = 1 To 15
If X% + i% > 16 Or Y% + i% > 16 Then Exit For
If qizi(X% + i%, Y% + i%) = 0 Then Exit For
If qizi(X% + i%, Y% + i%) = c% Then
For o% = 1 To i%
 qizi(X% + o%, Y% + o%) = c%
Next
Exit For
End If
Next

For i% = 1 To 15
If X% - i% < 1 Or Y% - i% < 1 Then Exit For
If qizi(X% - i%, Y% - i%) = 0 Then Exit For
If qizi(X% - i%, Y% - i%) = c% Then
For o% = 1 To i%
 qizi(X% - o%, Y% - o%) = c%
Next
Exit For
End If
Next

For i% = 1 To 15
If X% + i% > 16 Or Y% - i% < 1 Then Exit For
If qizi(X% + i%, Y% - i%) = 0 Then Exit For
If qizi(X% + i%, Y% - i%) = c% Then
For o% = 1 To i%
 qizi(X% + o%, Y% - o%) = c%
Next
Exit For
End If
Next

For i% = 1 To 15
If X% - i% < 1 Or Y% + i% > 16 Then Exit For
If qizi(X% - i%, Y% + i%) = 0 Then Exit For
If qizi(X% - i%, Y% + i%) = c% Then
For o% = 1 To i%
 qizi(X% - o%, Y% + o%) = c%
Next
Exit For
End If
Next

30
ws% = 0
bs% = 0
For i% = 1 To 16
For o% = 1 To 16
If qizi(i%, o%) = 1 Then ws% = ws% + 1
If qizi(i%, o%) = 2 Then bs% = bs% + 1
Next
Next
If ws% + bs% = 256 Then ended
If ws% = 0 Or bs% = 0 Then ended

End Sub

Sub hq()
Dim X, Y, q As Byte
qp.FillStyle = 0
For Y = 0 To 15
For X = 0 To 15
q = qizi(X + 1, Y + 1)
If q = 1 Then
qp.FillColor = &HFFFFFF * (2 - q)
qp.Circle (X * 62.5 + 31.25, Y * 62.5 + 31.25), 22, qp.FillColor
ElseIf q = 2 Then
qp.FillColor = &HFFFFFF * (2 - q)
qp.Circle (X * 62.5 + 31.25, Y * 62.5 + 31.25), 22, qp.FillColor
End If
Next
Next

bqxy.Caption = "白棋现有" + Str(ws) + " 子"
hqxy.Caption = "黑棋现有" + Str(bs) + " 子"
End Sub

Sub initqizi()
For i = 0 To 16
For o = 0 To 16
qizi(i, o) = 0
Next
Next

qizi(8, 8) = 2
qizi(9, 8) = 1
qizi(8, 9) = 1
qizi(9, 9) = 2
End Sub
Function dfpd(X%, Y%, c%)

Dim q As Byte
If X% < 1 Or Y% < 1 Or X% > 16 Or Y% > 16 Then Beep
'LOCATE 2, 1
'PRINT x%, y%, c%
For i% = 1 To Y% - 1
If qizi(X%, Y% - i%) = 0 Then Exit For
If qizi(X%, Y% - i%) = c% Then
q = q + i% - 1
Exit For
End If
Next

For i% = 1 To X% - 1
If qizi(X% - i%, Y%) = 0 Then Exit For
If qizi(X% - i%, Y%) = c% Then
q = q + i% - 1
Exit For
End If
Next

For i% = 1 To 16 - Y%
If qizi(X%, Y% + i%) = 0 Then Exit For
If qizi(X%, Y% + i%) = c% Then
q = q + i% - 1
Exit For
End If
Next

For i% = 1 To 16 - X%
If qizi(X% + i%, Y%) = 0 Then Exit For
If qizi(X% + i%, Y%) = c% Then
q = q + i% - 1
Exit For
End If
Next

For i% = 1 To 15
If X% + i% > 16 Or Y% + i% > 16 Then Exit For
If qizi(X% + i%, Y% + i%) = 0 Then Exit For
If qizi(X% + i%, Y% + i%) = c% Then
q = q + i% - 1
Exit For
End If
Next

For i% = 1 To 15
If X% - i% < 1 Or Y% - i% < 1 Then Exit For
If qizi(X% - i%, Y% - i%) = 0 Then Exit For
If qizi(X% - i%, Y% - i%) = c% Then
q = q + i% - 1
Exit For
End If
Next

For i% = 1 To 15
If X% + i% > 16 Or Y% - i% < 1 Then Exit For
If qizi(X% + i%, Y% - i%) = 0 Then Exit For
If qizi(X% + i%, Y% - i%) = c% Then
q = q + i% - 1
Exit For
End If
Next

For i% = 1 To 15
If X% - i% < 1 Or Y% + i% > 16 Then Exit For
If qizi(X% - i%, Y% + i%) = 0 Then Exit For
If qizi(X% - i%, Y% + i%) = c% Then
q = q + i% - 1
Exit For
End If
Next

dfpd = q
End Function

Sub pdkyxq(c%)
Dim i%, o%
For i = 1 To 16
For o = 1 To 16
If dfpd(i, o, c%) And qizi(i, o) = 0 Then kyxq(i, o) = -1 Else kyxq(i, o) = 0
Next
Next

End Sub
Sub ended()
Dim t
If zt = 1 Then
hq
If ws > bs Then
t = MsgBox("Congratulations , 重新来一盘？", vbYesNo)
ElseIf ws < bs Then
t = MsgBox("Bad luck , 重新来一盘？", vbYesNo)
Else
t = MsgBox("Not too bad , 重新来一盘？", vbYesNo)
End If
'MsgBox ws, , bs
xq.CommonDialog1.DialogTitle = "保存这盘棋"
xq.CommonDialog1.FileName = App.Path + "\" + "*.bws"
xq.CommonDialog1.ShowSave
fn = xq.CommonDialog1.FileTitle
If LTrim(fn) <> "" Then
If InStr(fn, ".") = 0 Then fn = fn + ".bws"
Open fn For Output As 4
For i = 1 To zq
Print #4, xqsave(i).X; xqsave(i).Y
Next
Close
End If

If t = 7 Then End
initqizi
hq2
pdkyxq 1

End If
End Sub
Sub hq2()
Dim X, Y, q As Byte
qp.FillStyle = 0
For Y = 0 To 15
For X = 0 To 15
q = qizi(X + 1, Y + 1)
If q = 1 Then
qp.FillColor = &HFFFFFF * (2 - q)
qp.Circle (X * 62.5 + 31.25, Y * 62.5 + 31.25), 22, qp.FillColor
ElseIf q = 2 Then
qp.FillColor = &HFFFFFF * (2 - q)
qp.Circle (X * 62.5 + 31.25, Y * 62.5 + 31.25), 22, qp.FillColor
Else
qp.FillColor = &H80C0FF
qp.Circle (X * 62.5 + 31.25, Y * 62.5 + 31.25), 22, qp.FillColor
End If
Next
Next

bqxy.Caption = "白棋现有" + Str(ws) + " 子"
hqxy.Caption = "黑棋现有" + Str(bs) + " 子"

End Sub

Sub dfxq()
Dim a%, b%, dd
If qizi(1, 1) = 0 Then
If dfpd(1, 1, 2) > 0 Then
qizi(1, 1) = 2
a% = 1
b% = 1
 GoTo 12
End If
End If

If qizi(1, 16) = 0 Then
If dfpd(1, 16, 2) > 0 Then
qizi(1, 16) = 2
a% = 1
b% = 16
 GoTo 12
End If
End If

If qizi(16, 1) = 0 Then
If dfpd(16, 1, 2) > 0 Then
qizi(16, 1) = 2
a% = 16
b% = 1
 GoTo 12
End If
End If

If qizi(16, 16) = 0 Then
If dfpd(16, 16, 2) > 0 Then
qizi(16, 16) = 2
a% = 16
b% = 16
 GoTo 12
End If
End If


For i% = 1 To 16

If qizi(i%, 1) = 0 Then
If dfpd(i%, 1, 2) > 0 Then
qizi(i%, 1) = 2
a% = i%
b% = 1
GoTo 12
End If
End If

If qizi(i%, 16) = 0 Then
If dfpd(i%, 16, 2) > 0 Then
qizi(i%, 16) = 2
a% = i%
b% = 16
GoTo 12
End If
End If

If qizi(1, i%) = 0 Then
If dfpd(1, i%, 2) > 0 Then
qizi(1, i%) = 2
a% = 1
b% = i%
GoTo 12
End If
End If

If qizi(16, i%) = 0 Then
If dfpd(16, i%, 2) > 0 Then
qizi(16, i%) = 2
a% = 16
b% = i%
GoTo 12
End If
End If

Next

dd = 0
For i% = 2 To 15
For o% = 2 To 15
If qizi(o%, i%) = 0 Then
If dfpd(o%, i%, 2) > dd Then
dd = dfpd(o%, i%, 2)
a% = o%
b% = i%
End If
End If
Next
Next

If dd = 0 Then Exit Sub
qizi(a%, b%) = 2
12
xqsave(zq).X = a%
xqsave(zq).Y = b%
pd a%, b%, 2
End Sub