锐客网

  1. 首页 > 睿知 > it技术 > >

vb.net扫雷游戏代码 vb 扫雷

IT技术picture

你能够用VB编一个扫雷游戏不？'---------------------------------------------------------------------
'
'扫雷程序源代码 (这个程序只完成了主要的部份,其他细节我想你能完成了.)
'
'
'扫雷程序最难的部份是在于如何自动打开空白区了
'我以前是用“堆栈”的方式进行判断来打开的,
'就是把要判断的坐标压入用集合模拟的堆栈区,然后再逐一弹出进行判断.
'用这种方式一是要用到集合来做堆栈,二是编程烦琐
'我想了很长时间,终于想到另外一种方法,也就是现在用的这种方法
'我暂时称它为"扫描"方法吧,因为它正是用的扫描原理来打开空白区的
'"扫描"方法一是速度快,没有用到集合,另外就是编程方便,易于读懂程序.
'我个人对这种方法比较喜欢的,我觉得它是一个很新的思路(呵呵 别笑我笨啊)
'
'你可以任意复制或修改以下代码以满足你的需要,但请注明其出处
'任何问题可以和我联系呀!Email: ZMSPU@163.COM
'
'CopyRight (C) 2003 ZMSPU小小数点敬赠
'-----------------------------------------------------------------------
'标志说明
'0 ～9 未打开的
'-1 ～ -9 已打开的
'10雷
'11已打开的空（未判断）
'12已打开的空（已判断）
'13标记过的
'14问号
'
Dim What(1 To 30, 1 To 16) As Long'点
Dim Save(1 To 30, 1 To 16) As Long'存
Dim mX As Long
Dim mY As Long'坐标
Dim mTime As Long
Dim MineFlag As Long'标记雷
Dim OpenFlag As Long'已打开的
Dim NowWidth As Long
Dim NowHeight As Long
Dim TotMine As Long'总雷数
Private Sub Command1_Click()
Timer1.Enabled = True
Label2 = "00:00"
Label1 = TotMine
Label3 = "加油哦，祝你好运?。。?
Picture1.Enabled = True
For X = 0 To NowWidth - 1
For Y = 0 To NowHeight - 1
Picture1.PaintPicture image1(9).Picture, X, Y
Next
Next
ClearStart NowWidth, NowHeight, TotMine
WriteNumber NowWidth, NowHeight
End Sub
Private Sub Command2_Click()
If Command2.Caption = "显示源代码" Then
Command2.Caption = "隐藏源代码"
Frame2.Visible = True
Else
Command2.Caption = "显示源代码"
Frame2.Visible = False
End If
End Sub
Private Sub Form_Load()
Dim X As Long
Dim Y As Long
Show
NowHeight = 16
NowWidth = 30
TotMine = 40
Picture1.Height = (image1(0).Height) * NowHeight
Picture1.Width = (image1(0).Width) * NowWidth
Picture1.ScaleMode = 3
Picture1.ScaleHeight = NowHeight
Picture1.ScaleWidth = NowWidth
For X = 0 To NowWidth - 1
For Y = 0 To NowHeight - 1
Picture1.PaintPicture image1(9).Picture, X, Y
Next
Next
ClearStart NowWidth, NowHeight, TotMine
WriteNumber NowWidth, NowHeight
Exit Sub
'--------------------------
For X = 1 To NowWidth
For Y = 1 To NowHeight
If What(X, Y) = 10 Then
Picture1.PaintPicture image1(13).Picture, X - 1, Y - 1
ElseIf What(X, Y) = 1 And What(X, Y) = 9 Then
Picture1.PaintPicture image1(What(X, Y)).Picture, X - 1, Y - 1
Else
Picture1.PaintPicture image1(9).Picture, X - 1, Y - 1
End If
Next
Next
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Dim T As Long
Dim X1 As Long
Dim Y1 As Long
Dim x2 As Single
Dim y2 As Single
mX = Int(X)
mY = Int(Y)
If Button = vbLeftButton Then
'左键按下
If What(mX1, mY1) = 0 And What(mX1, mY1) = 10 Then
Picture1.PaintPicture image1(14).Picture, mX, mY
End If
ElseIf Button = vbRightButton Then
'右键按下
'只有是打开的才处理
If What(mX1, mY1) = -9 And What(mX1, mY1) = -1 Then
T = 0
'计算标记的雷
For X1 = mX To mX2
For Y1 = mY To mY2
If X1 = mX1 And Y1 = mY1 Then
Else
If X1 = 1 And X1 = NowWidth Then
If Y1 = 1 And Y1 = NowHeight Then
If What(X1, Y1) = 13 Then
T = T1
End If
End If
End If
End If
Next
Next
'如果标记数大于等于雷数则不处理
If T = -(What(mX1, mY1)) Then Exit Sub
'如果标记数等于雷数则打开
If T = -What(mX1, mY1) Then
For X1 = mX To mX2
For Y1 = mY To mY2
If X1 = mX1 And Y1 = mY1 Then
Else
If X1 = 1 And X1 = NowWidth Then
If Y1 = 1 And Y1 = NowHeight Then
x2 = X1: y2 = Y1
Picture1_MouseUp vbLeftButton, 0, x2, y2
End If
End If
End If
Next
Next
Exit Sub
End If
'如果标记数小于雷数则按下余下的
For X1 = mX To mX2
For Y1 = mY To mY2
If X1 = mX1 And Y1 = mY1 Then
Else
If X1 = 1 And X1 = NowWidth Then
If Y1 = 1 And Y1 = NowHeight Then
If What(X1, Y1) = 0 And What(X1, Y1) = 10 Then
'Picture1.PaintPicture image1(14).Picture, X1 - 1, Y1 -
1
'Picture1.PaintPicture image1(9).Picture, X1 - 1, Y1 - 1
End If
End If
End If
End If
Next
Next
End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single)
If Button = vbLeftButton Then
'左击
If What(mX1, mY1) = 10 Then
'点到雷
Timer1.Enabled = False
Picture1.PaintPicture image1(13).Picture, mX, mY
Picture1.Enabled = False
Label3 = "哇！你点到雷了呀！重来吧?。。?
EndGame
Timer1 = False
Picture1.Enabled = False
Exit Sub
ElseIf What(mX1, mY1) = 1 And What(mX1, mY1) = 9 Then
'点到数字
OpenFlag = OpenFlag1
Picture1.PaintPicture image1(What(mX1, mY1)).Picture, mX, mY
What(mX1, mY1) = -What(mX1, mY1)
ElseIf What(mX1, mY1) = 0 Then
'点到空
Picture1.PaintPicture image1(0).Picture, mX, mY
What(mX1, mY1) = 11
OpenBlank mX1, mY1
End If
If MineFlagOpenFlag = NowHeight * NowWidth Then
Label3 = "恭喜恭喜！你过关了！"
Timer1.Enabled = False
Picture1.Enabled = False
End If
ElseIf Button = vbRightButton Then
'右击
If What(mX1, mY1) = 0 And What(mX1, mY1) = 10 Then
'未标记过的进行标记
Save(mX1, mY1) = What(mX1, mY1)
What(mX1, mY1) = 13
Picture1.PaintPicture image1(10).Picture, mX, mY
MineFlag = MineFlag1
Label1 = TotMine - MineFlag
ElseIf What(mX1, mY1) = 13 Then
'已经标记过则改为?
What(mX1, mY1) = 14
MineFlag = MineFlag - 1
Label1 = TotMine - MineFlag
Picture1.PaintPicture image1(11).Picture, mX, mY
ElseIf What(mX1, mY1) = 14 Then
'标记过?号的则
What(mX1, mY1) = Save(mX1, mY1)
Picture1.PaintPicture image1(9).Picture, mX, mY
End If
End If
End Sub
Private Sub ClearStart(ByVal mWidth As Long, ByVal mHeight As Long, ByVal
MineNumber As Long)
'预置雷位置
Randomize
mTime = 0
MineFlag = 0
OpenFlag = 0
'清空数组
Erase What
For T = 1 To MineNumber
aa:
'任意取一个坐标(X,Y)
X = Rnd * (mWidth - 1)
Y = Rnd * (mHeight - 1)
'如果已经取过该坐标则重新再取
If What(X1, Y1) = 10 Then GoTo aa
'将当前坐标标记为有雷
What(X1, Y1) = 10
Save(X1, Y1) = 10
Next
End Sub
Private Sub WriteNumber(ByVal mWidth As Long, ByVal mHeight As Long)
'写入信息
Dim X As Long
Dim Y As Long
Dim StartX As Long
Dim StartY As Long
Dim EndX As Long
Dim EndY As Long
Dim T As Long
Dim TT
Dim mNumber As Long
For X = 1 To mWidth
'从当前列的上一列开始
StartX = X - 1
If StartX = 0 Then StartX = 1
'在当前列的下一列结束
EndX = X1
If EndXmWidth Then EndX = mWidth
For Y = 1 To mHeight
'如果当前位置不是雷则开始计算
If What(X, Y)10 Then
'从当前行的上一行开始
StartY = Y - 1
If StartY = 0 Then StartY = 1
'在当前行的下一行结束
EndY = Y1
If EndYmHeight Then EndY = mHeight
'累加器置0
mNumber = 0
'计算四周有多少颗雷
For T = StartX To EndX
For TT = StartY To EndY
If TT = Y And T = X Then
'如果是当前位置则不计入
Else
'如果是雷则计入
If What(T, TT) = 10 Then mNumber = mNumber1
End If
Next
Next
If mNumber = 0 Then
'如果没有雷在其四周则打开当前位置
What(X, Y) = 0
Save(X, Y) = 0
Else
'写入雷数
What(X, Y) = mNumber
Save(X, Y) = mNumber
End If
End If
Next
Next
End Sub
Private Sub Timer1_Timer()
Dim sTime As String
Dim mM As Long
Dim mS As Long
Dim sM As String
Dim sS As String
mTime = mTime1
mM = Int(mTime / 60)
mS = mTime - mM
sS = mS
sM = mM
If mM10 Then sM = "0"mM
If mS10 Then sS = "0"mS
Label2 = sM":"sS
End Sub
Private Sub OpenBlank(ByVal zmX As Long, ByVal zmY As Long)
Dim Continue As Boolean
Dim mX As Long
Dim mY As Long
OpenFlag = OpenFlag1
Do While True
Continue = False
For mY = 1 To NowHeight
For mX = 1 To NowWidth
If What(mX, mY) = 11 Then
'如果存在未判断的空
Continue = True
'把它周围的8个点打开
'先打开左面的点
If mX - 1 = 1 Then
If What(mX - 1, mY) = 0 Then
What(mX - 1, mY) = 11
Picture1.PaintPicture image1(0).Picture, mX - 2, mY - 1
OpenFlag = OpenFlag1
ElseIf What(mX - 1, mY) = 1 And What(mX - 1, mY) = 9 Then
Picture1.PaintPicture image1(What(mX - 1, mY)).Picture, mX
- 2, mY - 1
What(mX - 1, mY) = -What(mX - 1, mY)
OpenFlag = OpenFlag1
End If
End If
'打开左上的点
If mX - 1 = 1 And mY - 1 = 1 Then
If What(mX - 1, mY - 1) = 0 Then
What(mX - 1, mY - 1) = 11
Picture1.PaintPicture image1(0).Picture, mX - 2, mY - 2
OpenFlag = OpenFlag1
ElseIf What(mX - 1, mY - 1) = 1 And What(mX - 1, mY - 1)
= 9 Then
Picture1.PaintPicture image1(What(mX - 1, mY -
1)).Picture, mX - 2, mY - 2
What(mX - 1, mY - 1) = -What(mX - 1, mY - 1)
OpenFlag = OpenFlag1
End If
End If
'再打开上面的点
If mY - 1 = 1 Then
If What(mX, mY - 1) = 0 Then
What(mX, mY - 1) = 11
Picture1.PaintPicture image1(0).Picture, mX - 1, mY - 2
OpenFlag = OpenFlag1
ElseIf What(mX, mY - 1) = 1 And What(mX, mY - 1) = 9 Then
Picture1.PaintPicture image1(What(mX, mY - 1)).Picture, mX
- 1, mY - 2
What(mX, mY - 1) = -What(mX, mY - 1)
OpenFlag = OpenFlag1
End If
End If
'打开右上的点
If mY - 1 = 1 And mX1 = NowWidth Then
If What(mX1, mY - 1) = 0 Then
What(mX1, mY - 1) = 11
Picture1.PaintPicture image1(0).Picture, mX, mY - 2
OpenFlag = OpenFlag1
ElseIf What(mX1, mY - 1) = 1 And What(mX1, mY - 1)
= 9 Then
Picture1.PaintPicture image1(What(mX1, mY -
1)).Picture, mX, mY - 2
What(mX1, mY - 1) = -What(mX1, mY - 1)
OpenFlag = OpenFlag1
End If
End If
'再打开右面的点
If mX1 = NowWidth Then
If What(mX1, mY) = 0 Then
What(mX1, mY) = 11
Picture1.PaintPicture image1(0).Picture, mX, mY - 1
OpenFlag = OpenFlag1
ElseIf What(mX1, mY) = 1 And What(mX1, mY) = 9 Then
Picture1.PaintPicture image1(What(mX1, mY)).Picture, mX,
mY - 1
What(mX1, mY) = -What(mX1, mY)
OpenFlag = OpenFlag1
End If
End If
'再打开右下的点
If mY1 = NowHeight And mX1 = NowWidth Then
If What(mX1, mY1) = 0 Then
What(mX1, mY1) = 11
Picture1.PaintPicture image1(0).Picture, mX, mY
OpenFlag = OpenFlag1
ElseIf What(mX1, mY1) = 1 And What(mX1, mY1)
= 9 Then
Picture1.PaintPicture image1(What(mX1, mY
1)).Picture, mX, mY
What(mX1, mY1) = -What(mX1, mY1)
OpenFlag = OpenFlag1
End If
End If
'打开下面的点
If mY1 = NowHeight Then
If What(mX, mY1) = 0 Then
What(mX, mY1) = 11
Picture1.PaintPicture image1(0).Picture, mX - 1, mY
OpenFlag = OpenFlag1
ElseIf What(mX, mY1) = 1 And What(mX, mY1) = 9 Then
Picture1.PaintPicture image1(What(mX, mY1)).Picture, mX
- 1, mY
What(mX, mY1) = -What(mX, mY1)
OpenFlag = OpenFlag1
End If
End If
'最后打开左下的点
If mY1 = NowHeight And mX - 1 = 1 Then
If What(mX - 1, mY1) = 0 Then
What(mX - 1, mY1) = 11
Picture1.PaintPicture image1(0).Picture, mX - 2, mY
OpenFlag = OpenFlag1
ElseIf What(mX - 1, mY1) = 1 And What(mX - 1, mY1)
= 9 Then
Picture1.PaintPicture image1(What(mX - 1, mY
1)).Picture, mX - 2, mY
What(mX - 1, mY1) = -What(mX - 1, mY1)
OpenFlag = OpenFlag1
End If
End If
'四点判断完后将本点标记为已判断过
What(mX, mY) = 12
End If
Next
Next
If Continue = False Then Exit Do
Loop
End Sub
Private Sub EndGame()
Dim X As Long
Dim Y As Long
For Y = 1 To NowHeight
For X = 1 To NowWidth
If What(X, Y) = 10 Then
Picture1.PaintPicture image1(13).Picture, X - 1, Y - 1
Else
If What(X, Y) = 13 Then
If Save(X, Y)10 Then
Picture1.PaintPicture image1(12).Picture, X - 1, Y - 1
End If
ElseIf What(X, Y) = 14 Then
If Save(X, Y) = 10 Then
Picture1.PaintPicture image1(13).Picture, X - 1, Y - 1
End If
End If
End If
Next
Next
End Sub
vb 我用控件数组做扫雷，一百个按钮 ， 怎么才能实现一个触雷所有含雷按钮都加载雷的图片？语句如下 Private使用MVC思想 。
在所有的操作中，凡是涉及到数值的操作，都不要对控件直接进行操作 。
基本做法如下：
对应着控件，建立一个二维数组，比如，你的100个按钮是按10X10格排列的，则建立一个10X10的数组 。如果它是雷，则为1 ， 如果它不是雷 ， 则为0.
求一个扫雷游戏程序编写代码,一定要是用VB.NET编写的~急!!!!!!!!`扫雷程序最重要的算法应该就是空白区域展开的那段.现在vb.net扫雷游戏代码我想到的有两种方法
一种是递归算法(比较容易),一种是用类似于堆栈的算法,不过现在vb.net扫雷游戏代码我懒的写vb.net扫雷游戏代码了,
把源码贴出来如果大家有兴趣的话可以给予改进.记得给vb.net扫雷游戏代码我发一份哟,谢谢!
(本代码为交流学习而用,大家可以任意转载.)
下载:
谁用VB6.0做一个扫雷，并且写出代码和解释'窗体1
Option Explicit
Private Const vbGray = H848284'灰色
Private Const MLeft As Long = 180'雷区距离左侧(按Twips计算)
Private Const MTop As Long = 825'雷区距离上部
Private Const WAVE_DEFAULT = 432'默认声音
Private Const WAVE_VICTORY = 433'失败声音
Private Const WAVE_LOST = 434'胜利声音
Private Const BMP_GRID_WIDTH = 16'格子的宽
Private Const BMP_GRID_HEIGHT = 16'格子的高
Private Const BMP_NUM_WIDTH = 13'数字的宽
Private Const BMP_NUM_HEIGHT = 23'数字的高
Private Const BMP_NUM_TOP = 16'数字距离上边（菜单底）
Private Const BMP_NUM_MINE_LEFT = 17'计数器距离左侧
Private Const BMP_NUM_TIME_RIGHT = BMP_NUM_WIDTH * 320'计时器左侧距离窗体右侧
Private Const BMP_FACE_WIDTH = 24'表情的宽
Private Const BMP_FACE_HEIGHT = 24'表情的高
Private Const BMP_FACE_TOP = 16'表情距离上边（菜单底）
Private CanPeeper As Boolean'作弊啊
'初级9/9/10
'中级16/16/40
'高级30/16/99
'Private NoMine As Boolean
Private Sub InithDC()
Dim I As Long
Dim hBmp As StdPicture
'从资源读取游戏图片
For I = 0 To 2
'不用PictureBox
Set hBmp = LoadResPicture(IIf(MnuCheck(1).Checked, 410, 411)I * 10, vbResBitmap)
Let hBmpDC(I) = CreateCompatibleDC(Me.hdc)
Call SelectObject(hBmpDC(I), hBmp.Handle)
Set hBmp = Nothing
Next
End Sub
'开始
Public Sub GameStart()
'NoMine = False
Let Me.Width = MLeft(MWidth * 168GetMePixelWidth - Me.ScaleWidth) * Screen.TwipsPerPixelX '调整窗体宽度
Let Me.Height = MTop(MHeight * 168GetMePixelHeight - Me.ScaleHeight) * Screen.TwipsPerPixelY '调整窗体高度270 OR 390'19/26'495/510
Let IsFirstHit = False '没有埋雷'没有处理第一个雷
Let IsGameWin = False '没有赢
Let IsGameOver = False '没有输
Let Timer1.Enabled = False '定时器，需要鼠标激活
Let Time_Count = 0 '记时器清零
Let NowFace = 4 'Call CheckFace(4)
ReDim N(MWidth - 1, MHeight - 1)
Let Show_Count = MWidth * MHeight '倒计数字 ， 剩余未揭开的格子
Let Mine_Count = Mines '剩余未标记的地雷
Call Form_Paint
Call SetMines
End Sub
'Download by
Private Sub SetMines() 'Optional ByVal X As Long, Optional ByVal Y As Long
'初始化地雷
Dim I As Long ', J As Long
Dim A As Long, B As Long
Dim K As Long, L As Long
Call Math.Randomize '初始化随机数生成器 。
For I = 0 To Mines - 1
Let A = Int(MWidth * Rnd) 'Int((upperbound - lowerbound1) * Rndlowerbound)
Let B = Int(MHeight * Rnd)
If Not N(A, B).IsMine Then'不能重复，不能是按下的位置'Not (A = X And b = Y) And
'If I = 1 Then
'If NoMine = False Then
'Let A = X: b = Y'第一个按下去总是雷 - -#
'End If
'End If
Let N(A, B).IsMine = True
'统计每个格子周围的地雷数目
Addtion A, B, 1
Else
Let I = I - 1 '再来
End If
Next I
'NoMine = False
'显示每个格子 '作弊1
'Dim J As Long
'作弊2
'For I = 0 To 8
'For J = 0 To 8
'If N(I, J).IsMine Then
'N(I, J).State = 1
''SetImage I, J, 15 - N(I, J).Number
''N(I, J).IsShow = True
'End If
'Next
'Next
End Sub
Private Sub Addtion(ByVal X As Long, ByVal Y As Long, ByVal One As Long)
Dim I As Long, J As Long
For I = -1 To 1
For J = -1 To 1
If InRange(XI, YJ) And Not (I = 0 And J = 0) Then '在地图的范围内
Let N(XI, YJ).Number = N(XI, YJ).NumberOne
End If
Next
Next
End Sub
'雷区
Private Sub SetImage(ByVal X As Long, ByVal Y As Long, Optional ByVal ImgID As Long)
'每个图片宽16，高16，ImgID=0~15
Call BitBlt(Me.hdc, MLeft / Screen.TwipsPerPixelXX * BMP_GRID_WIDTH, MTop / Screen.TwipsPerPixelYY * BMP_GRID_HEIGHT, BMP_GRID_WIDTH, BMP_GRID_HEIGHT, hBmpDC(0), 0, ImgID * BMP_GRID_HEIGHT, vbSrcCopy)
End Sub
'剩余地雷和时间
Private Sub SetNumber(ByVal X As Long, ByVal Y As Long, ByVal NumID As Long, Optional ByVal nWhat As Boolean = True)
'每个数字宽13，高23，NumID=0~11
Call BitBlt(Me.hdc, X * BMP_NUM_WIDTHIIf(nWhat, BMP_NUM_MINE_LEFT, GetMePixelWidth - BMP_NUM_TIME_RIGHT), Y * BMP_NUM_HEIGHTBMP_NUM_TOP, BMP_NUM_WIDTH, BMP_NUM_HEIGHT, hBmpDC(1), 0, BMP_NUM_HEIGHT * NumID, vbSrcCopy)
End Sub
'表情
Private Sub SetFace(Optional ByVal FaceID As Long = 4)
'每个笑脸宽24，高24，NumID=0~4
Call BitBlt(Me.hdc, GetMePixelWidth / 2 - BMP_FACE_WIDTH / 2 - 1, BMP_FACE_TOP, BMP_FACE_WIDTH, BMP_FACE_HEIGHT, hBmpDC(2), 0, BMP_FACE_HEIGHT * FaceID, vbSrcCopy)
End Sub
这些只是主窗体部分代码，还有几个模块和窗体、相关文档，写不下你自己看附件
VB.NET扫雷地雷是在一个控件中画出来好还是每个方格用一个控件好呢？谢谢！画出来比较好，用鼠标当前坐标位置进行计算选择的方格位置，如果一个方格用一个控件 ， 会很浪费资源 。
【vb.net扫雷游戏代码 vb 扫雷】vb.net扫雷游戏代码的介绍就聊到这里吧 ， 感谢你花时间阅读本站内容，更多关于vb 扫雷、vb.net扫雷游戏代码的信息别忘了在本站进行查找喔 。

    推荐阅读


    上一篇：jquery创建map对象，js创建map对象

    下一篇：如何申请FTP服务器？ ftp怎么申请服务器