生成迷宫的程序

最新推荐文章于 2021-05-23 11:49:54 发布

miaozk2006

最新推荐文章于 2021-05-23 11:49:54 发布

阅读量117

点赞数

本文链接：https://blog.csdn.net/miaozk2006/article/details/82416467

版权

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控件注册 - 利用资源文件将dll、ocx打包进exe文件

※做VB的，经常注册和反注册OCX控件和DLL链