你能够用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(mX + 1, mY + 1) = 0 And What(mX + 1, mY + 1) = 10 Then

Picture1.PaintPicture image1(14).Picture, mX, mY

End If

ElseIf Button = vbRightButton Then

'右键按下

'只有是打开的才处理

If What(mX + 1, mY + 1) = -9 And What(mX + 1, mY + 1) = -1 Then

T = 0

'计算标记的雷

For X1 = mX To mX + 2

For Y1 = mY To mY + 2

If X1 = mX + 1 And Y1 = mY + 1 Then

Else

If X1 = 1 And X1 = NowWidth Then

If Y1 = 1 And Y1 = NowHeight Then

If What(X1, Y1) = 13 Then

T = T + 1

End If

End If

End If

End If

Next

Next

'如果标记数大于等于雷数则不处理

If T = -(What(mX + 1, mY + 1)) Then Exit Sub

'如果标记数等于雷数则打开

If T = -What(mX + 1, mY + 1) Then

For X1 = mX To mX + 2

For Y1 = mY To mY + 2

If X1 = mX + 1 And Y1 = mY + 1 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 mX + 2

For Y1 = mY To mY + 2

If X1 = mX + 1 And Y1 = mY + 1 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(mX + 1, mY + 1) = 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(mX + 1, mY + 1) = 1 And What(mX + 1, mY + 1) = 9 Then

'点到数字

OpenFlag = OpenFlag + 1

Picture1.PaintPicture image1(What(mX + 1, mY + 1)).Picture, mX, mY

What(mX + 1, mY + 1) = -What(mX + 1, mY + 1)

ElseIf What(mX + 1, mY + 1) = 0 Then

'点到空

Picture1.PaintPicture image1(0).Picture, mX, mY

What(mX + 1, mY + 1) = 11

OpenBlank mX + 1, mY + 1

End If

If MineFlag + OpenFlag = NowHeight * NowWidth Then

Label3 = "恭喜恭喜！你过关了！"

Timer1.Enabled = False

Picture1.Enabled = False

End If

ElseIf Button = vbRightButton Then

'右击

If What(mX + 1, mY + 1) = 0 And What(mX + 1, mY + 1) = 10 Then

'未标记过的进行标记

Save(mX + 1, mY + 1) = What(mX + 1, mY + 1)

What(mX + 1, mY + 1) = 13

Picture1.PaintPicture image1(10).Picture, mX, mY

MineFlag = MineFlag + 1

Label1 = TotMine - MineFlag

ElseIf What(mX + 1, mY + 1) = 13 Then

'已经标记过则改为?

What(mX + 1, mY + 1) = 14

MineFlag = MineFlag - 1

Label1 = TotMine - MineFlag

Picture1.PaintPicture image1(11).Picture, mX, mY

ElseIf What(mX + 1, mY + 1) = 14 Then

'标记过?号的则

What(mX + 1, mY + 1) = Save(mX + 1, mY + 1)

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(X + 1, Y + 1) = 10 Then GoTo aa

'将当前坐标标记为有雷

What(X + 1, Y + 1) = 10

Save(X + 1, Y + 1) = 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 = X + 1

If EndX mWidth Then EndX = mWidth

For Y = 1 To mHeight

'如果当前位置不是雷则开始计算

If What(X, Y) 10 Then

'从当前行的上一行开始

StartY = Y - 1

If StartY = 0 Then StartY = 1

'在当前行的下一行结束

EndY = Y + 1

If EndY mHeight 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 = mNumber + 1

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 = mTime + 1

mM = Int(mTime / 60)

mS = mTime - mM

sS = mS

sM = mM

If mM 10 Then sM = "0" mM

If mS 10 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 = OpenFlag + 1

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 = OpenFlag + 1

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 = OpenFlag + 1

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 = OpenFlag + 1

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 = OpenFlag + 1

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 = OpenFlag + 1

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 = OpenFlag + 1

End If

End If

'打开右上的点

If mY - 1 = 1 And mX + 1 = NowWidth Then

If What(mX + 1, mY - 1) = 0 Then

What(mX + 1, mY - 1) = 11

Picture1.PaintPicture image1(0).Picture, mX, mY - 2

OpenFlag = OpenFlag + 1

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, mY - 2

What(mX + 1, mY - 1) = -What(mX + 1, mY - 1)

OpenFlag = OpenFlag + 1

End If

End If

'再打开右面的点

If mX + 1 = NowWidth Then

If What(mX + 1, mY) = 0 Then

What(mX + 1, mY) = 11

Picture1.PaintPicture image1(0).Picture, mX, mY - 1

OpenFlag = OpenFlag + 1

ElseIf What(mX + 1, mY) = 1 And What(mX + 1, mY) = 9 Then

Picture1.PaintPicture image1(What(mX + 1, mY)).Picture, mX,

mY - 1

What(mX + 1, mY) = -What(mX + 1, mY)

OpenFlag = OpenFlag + 1

End If

End If

'再打开右下的点

If mY + 1 = NowHeight And mX + 1 = NowWidth Then

If What(mX + 1, mY + 1) = 0 Then

What(mX + 1, mY + 1) = 11

Picture1.PaintPicture image1(0).Picture, mX, mY

OpenFlag = OpenFlag + 1

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, mY

What(mX + 1, mY + 1) = -What(mX + 1, mY + 1)

OpenFlag = OpenFlag + 1

End If

End If

'打开下面的点

If mY + 1 = NowHeight Then

If What(mX, mY + 1) = 0 Then

What(mX, mY + 1) = 11

Picture1.PaintPicture image1(0).Picture, mX - 1, mY

OpenFlag = OpenFlag + 1

ElseIf What(mX, mY + 1) = 1 And What(mX, mY + 1) = 9 Then

Picture1.PaintPicture image1(What(mX, mY + 1)).Picture, mX

- 1, mY

What(mX, mY + 1) = -What(mX, mY + 1)

OpenFlag = OpenFlag + 1

End If

End If

'最后打开左下的点

If mY + 1 = NowHeight And mX - 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

OpenFlag = OpenFlag + 1

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

What(mX - 1, mY + 1) = -What(mX - 1, mY + 1)

OpenFlag = OpenFlag + 1

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.NET编写的~急!!!!!!!!`

扫雷程序最重要的算法应该就是空白区域展开的那段.现在我想到的有两种方法

一种是递归算法(比较容易),一种是用类似于堆栈的算法,不过现在我懒的写了,

把源码贴出来如果大家有兴趣的话可以给予改进.记得给我发一份哟,谢谢!

(本代码为交流学习而用,大家可以任意转载.)

下载:

扫雷中左右键一起按的按键键值是什么(VB.NET)

左键是1

右键是2

中键是4

可以组合相加

左右同时就是3，也可以写做：vbleftbutton+vbrightbutton

VB.NET扫雷地雷是在一个控件中画出来好还是每个方格用一个控件好呢？谢谢！

画出来比较好，用鼠标当前坐标位置进行计算选择的方格位置，如果一个方格用一个控件，会很浪费资源。

网站栏目：用vb点虐 编写扫雷 c#做扫雷
链接地址：http://myzitong.com/article/ddcjdho.html