生成迷宫的程序 - 石陆软件屋

以下是代码，是我在百度看的，很厉害的哦。

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迷宫

[阅读字体大小: 大中小]

[本日志由 admin 于 2013-11-01 10:43 PM 编辑]

引用通告地址 (0)：
复制引用地址

http://www.cnng.net/blog/trackback.asp?tbID=11
复制引用地址

http://www.cnng.net/blog/trackback.asp?tbID=11&CP=GBK