登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

miaozk2006

点滴积累与收藏:关于技术,关于生活

 
 
 

日志

 
 

生成迷宫的程序  

2012-02-01 09:10:24|  分类: 编程-VB |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

Private Sub form_Click()
10     szx = 5000
    szy = 5000
    tr = 20
    L = 50
    mx = szx / L
    my = szy / L
    Dim A(1001, 1001)
    GoTo 110
20     While Not (X = 2 And Y = 1)
30         If A(X - 1, Y) * A(X, Y - 1) * A(X, Y + 1) * A(X + 1, Y) = 0 Then GoTo 70
40         For i = 0 To 3
            XX = X + (i = 0) - (i = 2)
            YY = Y + (i = 1) - (i = 3)
            If A(XX, YY) = s - 1 Then GoTo 60
50         Next
        Return
60         X = XX
        Y = YY
        s = A(X, Y)
        GoTo 90
70         R = Int(Rnd(1) * 4)
        XX = X + (R = 0) - (R = 2)
        YY = Y + (R = 1) - (R = 3)
        If A(XX, YY) <> 0 Then GoTo 70
80         X = XX
        Y = YY
        s = s + 1
        A(X, Y) = s
90     Wend
    Return
110     For i = 0 To mx + 1
        A(i, 0) = -1
        A(i, my + 1) = -1
    Next
    For i = 0 To my + 1
        A(0, i) = -1
        A(mx + 1, i) = -1
    Next
120     X = mx - 1
    Y = my
    s = 1
    A(X, Y) = s
    GoSub 20
130     For Q = my To 1 Step -1
        For P = mx To 1 Step -1
            If A(P, Q) > 0 Then GoTo 160
140             R = Int(Rnd(1) * 4)
            PP = P + (R = 0) - (R = 2)
            QQ = Q + (R = 1) - (R = 3)
            If A(PP, QQ) < 1 Then GoTo 140
150             X = P
            Y = Q
            s = A(PP, QQ) * 2 + 1000
            A(X, Y) = s
            GoSub 20
            F = 1
160         Next P, Q
        If F Then F = 0: GoTo 130
200         Cls
210         For X = 1 To mx
            For Y = 1 To my
220                 T = Abs(A(X, Y) - A(X + 1, Y))
                If T <= 1 Or T - 1000 = A(X, Y) Or T - 1000 = A(X + 1, Y) Then GoTo 230
225                 Line (X * L + tr, Y * L - L + tr)-(X * L + tr, Y * L + tr)
230                 T = Abs(A(X, Y) - A(X, Y + 1))
                If T <= 1 Or T - 1000 = A(X, Y) Or T - 1000 = A(X, Y + 1) Then GoTo 240
235                 Line (X * L - L + tr, Y * L + tr)-(X * L + tr, Y * L + tr)
240             Next Y, X
250             Line (tr, tr)-(tr + szx, tr + szy), , B
            Line (L + tr, tr)-(L + L + tr, tr), &H8000000F
            Line (szx - L + tr, szy + tr)-(szx - L - L + tr, szy + tr), &H8000000F
260             GoTo 1010
400             While Not (X = 2 And Y = 1)
1000                 For i = 1 To 4
                    For j = 1 To 8
                        Print A(j, i); " ";
                    Next
                    Print INKEY$;
                Next
                Return
            Wend
1010 End Sub

 


 

VB部分相关推荐


VB快速读取 TextBox N 行的资料

VB禁止使用 Alt-Tab Ctrl-Alt-Del

生成迷宫的程序

另一方法转换大小写

VB控件注册 - 利用资源文件将dllocx打包进exe文件

VB利用资源文件进行工作

[]vb高效编程(优化)

VB阳历转阴历

VB代码取得硬盘的物理序列号

VB获得磁盘的文件系统

VB的,经常注册和反注册OCX控件和DLL

VB从程序中生成Exe文件

VB6监视/操作剪贴板示例(VB6.0代码)

VB6里自动提交/自动填表的一种相对通用的方案

VB移动没有标题的窗体

VB随机字母的函数

VB删除带子文件夹和文件的文件夹

VB怎样屏蔽 Alt+F4

VB 隐藏进程

vb屏蔽文本框点右键时的弹出菜单

VB手控Combobox的打开或收起

VBINI文件的读写、删除(对中文支持很好)

vb全局热键的写法(占很少的资源)

vb取消文本框的粘贴功能

VB常用文件操作类

VB获取特殊文件夹

VB获取windows各常用目录的函数(模块)

VB生成太极图

VB:常用内部函数大全,你会了几个呢?

vbSendMessage函数

精简VB程序的代码

VB:将数字转换为大写中文

VB:设定 MsgBox 在若干时间之后若无回应则自动关闭

VB:读取及设定NumLock/CapsLock/ScrollLock的值

VB:您知道 Mid$ 函量可以放在 '=' 的左方吗

VB后台获得按键,并执行自己的函数(非钩子及热键)

VB:将短文件名格式转成长文件名

vb中使用Iphlpapi.dll获取网络信息(上)

vb中使用Iphlpapi.dll获取网络信息(下)


更多精彩>>>
  评论这张
 
阅读(787)| 评论(0)

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018