VB6.0制作迷宫程序

首先根据自己的需要和喜好，去素材网站下载ico图标，当然这些图标VB6.0不一定能够直接用。

开始--打开ArtIcons Pro软件。

打开的ArtIcons Pro软件界面如图所示：

“文件”--“打开”，d出打开对话框，选择所需修改的图标，单击“打开”按钮打开图标，在软件中显示出来。

在软件右侧，单击鼠标右键，选择“新图像”命令。

在打开的“新图像格式对话框”中按照VB6.0所需的ico图标格式进行设置：

大小选择48X48，颜色选择256色，其它默认，单击“确定按钮进行确认。”

此时按照刚刚制定的格式，生成了一个新图像：

"文件"--“导出”--“当前图像”，命名后保存。生成一个新图标如图所示：

随便打开一个VB6.0工程，将刚刚生成的图标加入到Form1的ico属性中：

在“文件”菜单下选择生成exe命令，在d出的生成工程对话框中按确定按钮，生成了一个心形图标，非常美观。想要生成自己喜欢的图标都可以参照以上方法。

'API函数，判断两个矩形是否相交(包括边界重合)

Private Declare Function IntersectRect Lib "user32" (lpDestRECT As RECT, lpSrc1RECT As RECT, lpSrc2RECT As RECT) As Long

Private Type RECT

X1 As Long

Y1 As Long

X2 As Long

Y2 As Long

End Type

Dim xyStart As RECT '定义小人开始所在区域

Dim xyEnd As RECT '定义小人走出迷宫所在区域，用来判断是否成功

Dim spRECT(12) As RECT '我这里只有13个shape画的墙，用来记录所有墙覆盖的区域

Dim menRECT As RECT '小人覆盖的区域

Const bu As Long = 10 '定义小人移动的步长

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

Dim temp As RECT

Select Case KeyCode

Case vbKeyUp

menRECT.Y1 = menRECT.Y1 - bu

menRECT.Y2 = menRECT.Y2 - bu

If zq(menRECT) Then spMen.top = spMen.top - bu

Case vbKeyDown

menRECT.Y1 = menRECT.Y1 + bu

menRECT.Y2 = menRECT.Y2 + bu

If zq(menRECT) Then spMen.top = spMen.top + bu

Case vbKeyLeft

menRECT.X1 = menRECT.X1 - bu

menRECT.X2 = menRECT.X2 - bu

If zq(menRECT) Then spMen.left = spMen.left - bu

Case vbKeyRight

menRECT.X1 = menRECT.X1 + bu

menRECT.X2 = menRECT.X2 + bu

If zq(menRECT) Then spMen.left = spMen.left + bu

End Select

menRECT.X1 = spMen.left

menRECT.Y1 = spMen.top

menRECT.X2 = spMen.left + spMen.Width

menRECT.Y2 = spMen.top + spMen.Height

If IntersectRect(temp, menRECT, xyEnd) >0 Then

MsgBox "抵达终点了"

End If

End Sub

Private Sub Form_Load()

xyStart.X1 = 0'开始的位置你自己定义

xyStart.Y1 = 0

xyStart.X2 = 360

xyStart.Y2 = 360

xyEnd.X1 = Me.ScaleWidth - 360'结束的位置你自己定义

xyEnd.Y1 = 0

xyEnd.X2 = Me.ScaleWidth

xyEnd.Y2 = 360

Me.AutoRedraw = True

Line (xyStart.X1, xyStart.Y1)-(xyStart.X2, xyStart.Y2), vbYellow, BF '开始的地方画方框标记

Line (xyEnd.X1, xyEnd.Y1)-(xyEnd.X2, xyEnd.Y2), vbGreen, BF '结束的地方画方框标记

spMen.Shape = 3 'spmen是SHAPE控件表示人，用圆形表示

spMen.Width = 255: spMen.Height = 255 '人物大小

spMen.top = (xyStart.Y2 - xyStart.Y1 - spMen.Height) / 2 '让小人在开始位置居中

spMen.left = (xyStart.X2 - xyStart.X1 - spMen.Width) / 2

menRECT.X1 = spMen.left'记录开始小人的区域

menRECT.Y1 = spMen.top

menRECT.X2 = spMen.left + spMen.Width

menRECT.Y2 = spMen.top + spMen.Height

For i = 0 To 12 '记录开始时所有墙的区域

spRECT(i).X1 = sp(i).left

spRECT(i).Y1 = sp(i).top

spRECT(i).X2 = sp(i).left + sp(i).Width

spRECT(i).Y2 = sp(i).top + sp(i).Height

Next

End Sub

Private Function zq(Men As RECT) As Boolean

'判断是否撞墙并且没有出窗体的界限，超出界限返回假

zq = True

Dim temp As RECT

For i = 0 To 12

If IntersectRect(temp, Men, spRECT(i)) >0 Then

zq = False

Exit Function

End If

Next

If Men.X1 <0 Then zq = False: Exit Function

If Men.X2 >Me.ScaleWidth Then zq = False: Exit Function

If Men.Y1 <0 Then zq = False: Exit Function

If Men.Y2 >Me.ScaleHeight Then zq = False: Exit Function

End Function

---