📄 xq.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form xq
BorderStyle = 3 'Fixed Dialog
Caption = "黑白棋"
ClientHeight = 5760
ClientLeft = 855
ClientTop = 810
ClientWidth = 5100
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5760
ScaleWidth = 5100
Begin VB.PictureBox qp
AutoRedraw = -1 'True
BackColor = &H0080C0FF&
Height = 5100
Left = 0
ScaleHeight = 5040
ScaleWidth = 5040
TabIndex = 1
Top = 660
Width = 5100
Begin MSComDlg.CommonDialog CommonDialog1
Left = 960
Top = 2040
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 4560
Top = 4560
End
End
Begin VB.PictureBox Picture1
BackColor = &H00FFFFFF&
Height = 615
Left = 0
ScaleHeight = 555
ScaleWidth = 5040
TabIndex = 0
Top = 0
Width = 5100
Begin VB.Label xqwz
Alignment = 2 'Center
BackColor = &H00FFFFFF&
Caption = "1,1"
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000C000&
Height = 255
Left = 4200
TabIndex = 6
Top = 0
Visible = 0 'False
Width = 855
End
Begin VB.Label xzld
BackColor = &H00FFFF00&
Caption = "现在该 棋下"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1680
TabIndex = 4
Top = 0
Visible = 0 'False
Width = 2295
End
Begin VB.Label bqxy
BackColor = &H00FFFFFF&
Caption = "白棋现有 2 子"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 0
TabIndex = 3
Top = 80
Visible = 0 'False
Width = 1575
End
Begin VB.Label timenow
Alignment = 2 'Center
BackColor = &H00FFFFFF&
Caption = "00:00"
BeginProperty Font
Name = "System"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 4200
TabIndex = 2
Top = 240
Width = 855
End
Begin VB.Label hqxy
BackColor = &H00FFFFFF&
Caption = "黑棋现有 2 子"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 0
TabIndex = 5
Top = 330
Visible = 0 'False
Width = 1575
End
End
Begin VB.Menu game
Caption = "游 戏&F"
Begin VB.Menu MNrj
Caption = "人机大战"
Shortcut = {F2}
End
Begin VB.Menu mnRR
Caption = "人人对抗"
Enabled = 0 'False
Shortcut = {F3}
End
Begin VB.Menu mnFP
Caption = "复 盘"
Enabled = 0 'False
Shortcut = {F4}
End
Begin VB.Menu STEP
Caption = "-"
End
Begin VB.Menu mnExit
Caption = "退 出&X"
End
End
Begin VB.Menu hlp
Caption = "帮 助&H"
Begin VB.Menu rules
Caption = "游戏规则"
Shortcut = {F1}
End
Begin VB.Menu mnAbout
Caption = "关 于&A"
End
End
Begin VB.Menu fqyz
Caption = "放弃一子&C"
End
End
Attribute VB_Name = "xq"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'下载网址：http://vb.cn99.com
Dim passedtime As Integer
Dim zt As Byte
Dim qizi(16, 16) As Integer
Dim qizio(16, 16) As Integer
Private Type xqsave
X As Integer
Y As Integer
End Type
Dim xqpd(256) As Integer
Dim kyxq(16, 16) As Boolean
Dim xqsave(512) As xqsave
Dim ws%, bs%, zq As Long
Private Sub Form_Load()
Show
If App.PrevInstance Then End
drawnewqp
initqizi
End Sub
Sub drawnewqp()
Dim cx, cy, i
qp.ScaleHeight = 1000 ' 设置高度的单位值。
qp.ScaleWidth = 1000 ' 设置宽度的单位值。
qp.DrawWidth = 3 ' 设置 DrawWidth。
qp.Line (-1, -1)-(1000, 1000), QBColor(11), B
qp.DrawWidth = 1
i = QBColor(11)
For cy = 1 To 15
qp.Line (62.5 * cy, 0)-(62.5 * cy, 1000), i
qp.Line (0, 62.5 * cy)-(1000, 62.5 * cy), i
Next
End Sub
Private Sub fqyz_Click()
Dim b, t, i%, o%
'pdkyxq 1
If zt = 1 Then
For i = 1 To 16
For o = 1 To 16
If dfpd(i%, o%, 1) Then
t = -1
GoTo 12
End If
Next
Next
12 If t Then
b = MsgBox("您至少还可以在" + Str(i%) + "," + Str(o%) + "落子,确认放弃吗？", vbYesNo)
If b = 7 Then Exit Sub
zq = zq + 1
xqsave(zq).X = 0
xqsave(zq).Y = 0
zq = zq + 1
dfxq
hq
pdkyxq 1
Else
zq = zq + 1
xqsave(zq).X = 0
xqsave(zq).Y = 0
zq = zq + 1
dfxq
hq
pdkyxq 1
End If
End If
End Sub
Private Sub mnAbout_Click()
msg$ = msg$ + " 黑白棋 v1.0 for Win 95" + Chr(13) + Chr(13)
msg$ = msg$ + "程序设计：陈 硕 E-Mail : chenshuo@163.net" + Chr(13)
msg$ = msg$ + "个人主页：duzhe.yeah.net Last updated on 7/27" + Chr(13)
'msg$ = msg$ + "" + Chr(13)
'msg$ = msg$ + "" + Chr(13)
'msg$ = msg$ + "" + Chr(13)
'msg$ = msg$ + "" + Chr(13)
MsgBox msg, , "关于"
End Sub
Private Sub mnExit_Click()
End
End Sub
Private Sub MNrj_Click()
If zt = 0 Then
passedtime = 0
Timer1.Enabled = True
bqxy.Visible = True
hqxy.Visible = True
xzld.Visible = True
xqwz.Visible = True
xzld.Caption = " 人机大战"
pd 1, 1, 1
hq
pdkyxq (1)
zt = 1
Else
b = MsgBox("这盘棋尚未下完，重新开始吗？", vbYesNo + 32, "新局")
If b = 6 Then
passedtime = 0
Timer1.Enabled = True
initqizi
pd 1, 1, 1
hq2
pdkyxq (1)
End If
End If
'zqrj
End Sub
Private Sub qp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X / 62.5 = Int(X / 62.5) Or Y / 62.5 = Int(Y / 62.5) Then qp.MousePointer = 12: Exit Sub
If kyxq(Int((X) / 62.5) + 1, Int((Y) / 62.5) + 1) = -1 Then qp.MousePointer = 2 Else qp.MousePointer = 12
xqwz.Caption = (Int((X) / 62.5) + 1) & "," & (Int((Y) / 62.5) + 1)
End Sub
Private Sub qp_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'MsgBox X, , Y
Dim cy%, cx%
If zt = 1 And Button = 1 Then
If X / 62.5 = Int(X / 62.5) Or Y / 62.5 = Int(Y / 62.5) Then Exit Sub
cx = Int(X / 62.5) + 1
cy = Int(Y / 62.5) + 1
If dfpd(cx, cy, 1) And qizi(cx, cy) = 0 Then
qizi(cx, cy) = 1
pd cx, cy, 1
hq
zq = zq + 1
xqsave(zq).X = cx
xqsave(zq).Y = cy
zq = zq + 1
dfxq
hq
pdkyxq 1
End If
'MsgBox dfpd(Int(X / 62.5) + 1, Int(Y / 62.5) + 1, 1)
End If
End Sub
Private Sub rules_Click()
msg$ = msg$ + " 黑白棋是一种益智游戏，但在棋盘上下棋非常麻烦，因为要不停地将黑白" + Chr(13)
msg$ = msg$ + "两棋互换(日本人想出了一个好办法：将棋子正反面涂为异色)，于是我用basic" + Chr(13)
msg$ = msg$ + "写了这么一个小程序，以方便大家。" + Chr(13)
msg$ = msg$ + " 游戏规则非常简单：在一个棋盘上先放上四枚棋子，黑白双方轮流下棋，" + Chr(13)
msg$ = msg$ + "每一子须下在棋盘的空白处且能“吃掉”对方至少一子，否则自己不能下而" + Chr(13)
msg$ = msg$ + "由对方继续下；“吃掉”对方的棋子是指：以落点为中心，向左看去经过几" + Chr(13)
msg$ = msg$ + "个对方的棋子后又有自己的棋子(中间不能有空格)，则这几个对方的棋子就" + Chr(13)
msg$ = msg$ + "被换成我方的棋子，即被吃掉了，对方被换掉几子便是吃了几子。此种“看" + Chr(13)
msg$ = msg$ + "法”应同时应用于向右、向上、向下等八个方向。" + Chr(13)
msg$ = msg$ + " 以下面一个棋盘的局部为例，“.”为空位、“o”为白棋、“x”为黑棋：" + Chr(13)
msg$ = msg$ + " 若白棋在d4下子，棋盘变为图二，白棋吃掉黑棋4子。" + Chr(13)
msg$ = msg$ + "" + Chr(13)
msg$ = msg$ + "图一: 图二:" + Chr(13)
msg$ = msg$ + " 1 2 3 4 5 1 2 3 4 5" + Chr(13)
msg$ = msg$ + "a o . . o . a o . . o ." + Chr(13)
msg$ = msg$ + "b . x x . . b . o x x ." + Chr(13)
msg$ = msg$ + "c . . x x . c . . o . ." + Chr(13)
msg$ = msg$ + "d o x x . . d o o o o ." + Chr(13)
msg$ = msg$ + "e . . . . . e . . . . ." + Chr(13)
msg$ = msg$ + "判断胜负:" + Chr(13)
msg$ = msg$ + " 若棋盘下满了，则棋子多的一方胜利；若中途一方棋子被全部吃完，" + Chr(13)
msg$ = msg$ + "对方胜利。" + Chr(13)
MsgBox msg$, , "黑白棋规则"
End Sub
Private Sub Timer1_Timer()
passedtime = passedtime + 1
timenow.Caption = Right("00" & (passedtime \ 60), 2) & ":" & Right("00" & (passedtime Mod 60), 2)
End Sub
Sub pd(X%, Y%, c%)
If X% = 0 Or Y% = 0 Then GoTo 30
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -