扫雷的VB编程

Private Sub Form_Load()Init_FormEnd Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)Dim x1 As Integer, y1 As Integerx1 = Fix((x - x0) / a): y1 = Fix((y - y0) / a)If (x - x0) >((Col_Num + 1) * a) Or (y - y0) >((Col_Num + 1) * a) Then Exit SubIf x <x0 Or y <y0 Then Exit SubIf x <x0 + x1 * a + 2 Or _x >x0 + x1 * a + a - 4 Or _y <y0 + y1 * a + 2 Or _y >y0 + y1 * a + a - 4 _Then Exit SubIf Button = 1 ThenIf Map(x1, y1) = 0 ThenCall fan(x1, y1)ElseIf Map(x1, y1) = 1 ThenCall loseEnd IfElseIf Button = 2 ThenCall draw_flg(x1, y1)End IfDim n As Integern = 0Dim i As Integer, j As IntegerFor i = 0 To Col_NumFor j = 0 To Row_NumIf Map(i, j) = -2 Then n = n + 1Next jNext iIf n = (Col_Num + 1) * (Row_Num + 1) - Ant_Num ThenBeepCurrentX = (Col_Num / 2) * a + x0CurrentY = (Row_Num / 2) * a + y0Call sub1a = Form1.FontSizeForm1.FontSize = 80'Form1.ForeColor = vbBlackPrint "you win"Form1.FontSize = aEnd IfEnd Sub

Sub fan(x As Integer, y As Integer)Dim i As Integer, j As IntegerDim n As IntegerFor i = -1 To 1For j = -1 To 1If j * i = 0 And Map(x + i, y + j) = 0 ThenMap(x + i, y + j) = -2n = Counts(x + i, y + j)Form1.Line (x0 + (i + x) * a + 2, y0 + (j + y) * a + 2)-Step(a - 4, a - 4), Form1.BackColor, BF

If n <>0 ThenCurrentX = (x + i) * a + 2 + x0CurrentY = (y + j) * a + 2 + y0Select Case nCase Is = 1Form1.ForeColor = vbWhiteCase Is = 2Form1.ForeColor = vbYellowCase Is >2Form1.ForeColor = vbRedEnd SelectPrint nElseIf n = 0 Then

Call fan(x + i, y + j)End IfEnd IfNext jNext iEnd Sub

Function Counts(x As Integer, y As Integer) As IntegerDim i As Integer, j As IntegerFor i = -1 To 1For j = -1 To 1If Map(x + i, y + j) = 1 Then Counts = Counts + 1NextNextEnd FunctionSub lose()Dim i As Integer, j As IntegerFor i = 0 To Row_NumFor j = 0 To Col_NumIf Map(j, i) = 1 ThenForm1.FillColor = vbBlackForm1.FillStyle = 0Form1.Circle (x0 + j * a + a / 2, y0 + i * a + a / 2), a / 3, vbBlack, , , 0.8Form1.Line (x0 + j * a, y0 + i * a)-Step(a, a), vbWhiteForm1.Line (x0 + j * a + a, y0 + i * a)-Step(-a, a), vbWhite

ElseIf Map(j, i) = 0 ThenForm1.Line (x0 + j * a + 2, y0 + i * a + 2)-Step(a - 4, a - 4), Form1.BackColor, BFCurrentX = j * a + x0CurrentY = i * a + y0Print Counts(j, i)End IfNext j

Next iBeepa = Form1.FontSizeForm1.FontSize = 80'Form1.ForeColor = vbBlackPrint "you lose"Form1.FontSize = aEnd SubSub draw_flg(x As Integer, y As Integer)CurrentX = x * a + x0 + 2CurrentY = y * a + y0 + 2Print "?"End Sub

Public Sub Init_Form()

Form1.ClsForm1.ScaleMode = 3Form1.Width = 8000Form1.Height = 6000Form1.BackColor = vbGreenForm1.AutoRedraw = Trueform1.caption="一个简单扫雷游戏 "Col_Num = 10 '获取列数Row_Num = 10 '获取行数a = 20 '单元宽(高)度Ant_Num = 40 '雷的数量ReDim Map(-1 To Col_Num + 1, -1 To Row_Num + 1)Dim i As Integer, j As IntegerFor i = -1 To Row_Num + 1

For j = -1 To Col_Num + 1Form1.Line (x0 + j * a, y0 + i * a)-Step(a, a), 0, BForm1.Line (x0 + j * a + 2, y0 + i * a + 2)-Step(a - 4, a - 4), vbRed, BFMap(j, i) = 0 '初始化位置标记为空格0If i = -1 Or i = Row_Num + 1 Or j = -1 Or j = Row_Num + 1 ThenForm1.Line (x0 + j * a + 1, y0 + i * a + 1)-Step(a - 2, a - 2), RGB(100, 120, 100), BF '画四周墙体Map(j, i) = -1 '四周位置标记为墙体：-1End IfNext j

Next iDim x As Integer, y As IntegerFor i = 1 To Ant_Num1000Randomizex = Rnd * Col_Numy = Rnd * Row_NumDoEventsIf Map(x, y) <>0 Then GoTo 1000Map(x, y) = 1NextEnd Sub

Sub sub1()

Dim i As Integer, j As IntegerFor i = 0 To Row_NumFor j = 0 To Col_NumIf Map(j, i) = 1 ThenForm1.FillColor = vbBlackForm1.FillStyle = 0Form1.Circle (x0 + j * a + a / 2, y0 + i * a + a / 2), a / 3, vbBlack, , , 0.8ElseIf Map(j, i) = 0 ThenForm1.Line (x0 + j * a + 2, y0 + i * a + 2)-Step(a - 4, a - 4), Form1.BackColor, BFCurrentX = j * a + x0CurrentY = i * a + y0Print Counts(j, i)End IfNext j

Next iEnd Sub

先说一个 扫雷的吧，，没办法给你源程序，

就给你说制作过程吧，

打开VB6.0

在窗体的上半部分，用pictureBOX控件画一定的区域用来模仿WINDOWS那样的，里面显示雷数，时间，以及开始，，并且命名为picture1

在画好后，在picture1里 放4个控件，text1,text2,commandbutton(按钮),timer1.并且给这4个控件属性定义属性值：text1和text2的BackColor属性为黑色，ForeColor为红色，FONT属性改为小二号。text1 的text属性为10,text2的text属性为0

按钮控件的名称属性改为C1，Caption属性改为开始。FONT属性改为小二号

Timer1 属性 Enabled 为 False, Interval为1000

再Picture1的下面再用Picturebox控件画一定的区域做为雷区。将这个控件的名称属性改为P ，AutoRedraw属性改为True

然后再把控件P（雷区）里 放一个按钮(数组)控件，其属性：名称改为C，Caption为空

（怎么建数组控件？就是在该控件上点右键选择复制，在空白区选择粘贴，系统会提示你是否建立数组控件，你选是就OK了） 它变成数组控件后，两个控件名称一样都是C 但是会有一个C（0）和C（1） 你把（1）的删除就行了，在C（0）控件的属性style改为1，

做完以上的，，只需要把以下代码复制到代码区即刻运行

'一个简单扫雷游戏

Option Explicit

Dim Map() As Integer

Dim Row_Num, Col_Num As Integer '范围，一个正方形的边长

Dim Ant_Num As Long '白蚁数量

Const x0 = 30 '方框左上角坐标

Const y0 = 30

Const 小快宽度 = 9

Dim a As Integer '各个小块的边长

Private Sub Command1_Click()

'重设按钮

Init_Form

End Sub

Private Sub Form_Load()

Init_Form

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim x1 As Integer, y1 As Integer

x1 = Fix((x - x0) / a): y1 = Fix((y - y0) / a)

If (x - x0) >((Col_Num + 1) * a) Or (y - y0) >((Col_Num + 1) * a) Then Exit Sub

If x <x0 Or y <y0 Then Exit Sub

If x <x0 + x1 * a + 2 Or _

x >x0 + x1 * a + a - 4 Or _

y <y0 + y1 * a + 2 Or _

y >y0 + y1 * a + a - 4 _

Then Exit Sub

If Button = 1 Then

If Map(x1, y1) = 0 Then

Call fan(x1, y1)

ElseIf Map(x1, y1) = 1 Then

Call lose

End If

ElseIf Button = 2 Then

Call draw_flg(x1, y1)

End If

Dim n As Integer

n = 0

Dim i As Integer, j As Integer

For i = 0 To Col_Num

For j = 0 To Row_Num

If Map(i, j) = -2 Then n = n + 1

Next j

Next i

If n = (Col_Num + 1) * (Row_Num + 1) - Ant_Num Then

Beep

CurrentX = (Col_Num / 2) * a + x0

CurrentY = (Row_Num / 2) * a + y0

Call sub1

a = Form1.FontSize

Form1.FontSize = 80

'Form1.ForeColor = vbBlack

Print "you win"

Form1.FontSize = a

End If

End Sub

Sub fan(x As Integer, y As Integer)

Dim i As Integer, j As Integer

Dim n As Integer

For i = -1 To 1

For j = -1 To 1

If j * i = 0 And Map(x + i, y + j) = 0 Then

Map(x + i, y + j) = -2

n = Counts(x + i, y + j)

Form1.Line (x0 + (i + x) * a + 2, y0 + (j + y) * a + 2)-Step(a - 4, a - 4), Form1.BackColor, BF

If n <>0 Then

CurrentX = (x + i) * a + 2 + x0

CurrentY = (y + j) * a + 2 + y0

Select Case n

Case Is = 1

Form1.ForeColor = vbWhite

Case Is = 2

Form1.ForeColor = vbYellow

Case Is >2

Form1.ForeColor = vbRed

End Select

Print n

ElseIf n = 0 Then

Call fan(x + i, y + j)

End If

End If

Next j

Next i

End Sub

Function Counts(x As Integer, y As Integer) As Integer

Dim i As Integer, j As Integer

For i = -1 To 1

For j = -1 To 1

If Map(x + i, y + j) = 1 Then Counts = Counts + 1

Next

Next

End Function

Sub lose()

Dim i As Integer, j As Integer

For i = 0 To Row_Num

For j = 0 To Col_Num

If Map(j, i) = 1 Then

Form1.FillColor = vbBlack

Form1.FillStyle = 0

Form1.Circle (x0 + j * a + a / 2, y0 + i * a + a / 2), a / 3, vbBlack, , , 0.8

Form1.Line (x0 + j * a, y0 + i * a)-Step(a, a), vbWhite

Form1.Line (x0 + j * a + a, y0 + i * a)-Step(-a, a), vbWhite

ElseIf Map(j, i) = 0 Then

Form1.Line (x0 + j * a + 2, y0 + i * a + 2)-Step(a - 4, a - 4), Form1.BackColor, BF

CurrentX = j * a + x0

CurrentY = i * a + y0

Print Counts(j, i)

End If

Next j

Next i

Beep

a = Form1.FontSize

Form1.FontSize = 80

'Form1.ForeColor = vbBlack

Print "you lose"

Form1.FontSize = a

End Sub

Sub draw_flg(x As Integer, y As Integer)

CurrentX = x * a + x0 + 2

CurrentY = y * a + y0 + 2

Print "?"

End Sub

Public Sub Init_Form()

Form1.Cls

Form1.ScaleMode = 3

Form1.Width = 8000

Form1.Height = 6000

Form1.BackColor = vbGreen

Form1.AutoRedraw = True

Form1.Caption = "一个简单扫雷游戏 作者 zfc"

Col_Num = 10 '获取列数

Row_Num = 10 '获取行数

a = 20 '单元宽(高)度

Ant_Num = 40 '雷的数量

ReDim Map(-1 To Col_Num + 1, -1 To Row_Num + 1)

Dim i As Integer, j As Integer

For i = -1 To Row_Num + 1

For j = -1 To Col_Num + 1

Form1.Line (x0 + j * a, y0 + i * a)-Step(a, a), 0, B

Form1.Line (x0 + j * a + 2, y0 + i * a + 2)-Step(a - 4, a - 4), vbRed, BF

Map(j, i) = 0 '初始化位置标记为空格0

If i = -1 Or i = Row_Num + 1 Or j = -1 Or j = Row_Num + 1 Then

Form1.Line (x0 + j * a + 1, y0 + i * a + 1)-Step(a - 2, a - 2), RGB(100, 120, 100), BF '画四周墙体

Map(j, i) = -1 '四周位置标记为墙体：-1

End If

Next j

Next i

Dim x As Integer, y As Integer

For i = 1 To Ant_Num

1000

Randomize

x = Rnd * Col_Num

y = Rnd * Row_Num

DoEvents

If Map(x, y) <>0 Then GoTo 1000

Map(x, y) = 1

Next

End Sub

Sub sub1()

Dim i As Integer, j As Integer

For i = 0 To Row_Num

For j = 0 To Col_Num

If Map(j, i) = 1 Then

Form1.FillColor = vbBlack

Form1.FillStyle = 0

Form1.Circle (x0 + j * a + a / 2, y0 + i * a + a / 2), a / 3, vbBlack, , , 0.8

ElseIf Map(j, i) = 0 Then

Form1.Line (x0 + j * a + 2, y0 + i * a + 2)-Step(a - 4, a - 4), Form1.BackColor, BF

CurrentX = j * a + x0

CurrentY = i * a + y0

Print Counts(j, i)

End If

Next j

Next i

End Sub

---