迷宫答案 — 编程爱好者社区

主题：迷宫答案

zq265 [专家分：60] 发布于 2004-03-05 17:55:00

这里有一个用VB编的比较长，只好分开发了
Option Explicit

Private Type CornerRec
  X As Long
  Y As Long
End Type

Private Type VertexRec
  X As Double
  Y As Double
End Type

Private Type StackRec
  Index1 As Byte
  Index2 As Integer
End Type

Private Type PALETTEENTRY
  peRed As Byte
  peGreen As Byte
  peBlue As Byte
  peFlags As Byte
End Type

Private Type LOGPALETTE
  palVersion As Integer
  palNumEntries As Integer
  palPalEntry(16) As PALETTEENTRY
End Type

Private Declare Function CreatePalette Lib "GDI32" (LogicalPalette As LOGPALETTE) As Long
Private Declare Function CreatePen Lib "GDI32" (ByVal PenStyle As Long, ByVal Width As Long, ByVal Color As Long) As Long
Private Declare Function CreatePolygonRgn Lib "GDI32" (lpPoints As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function CreateSolidBrush Lib "GDI32" (ByVal rgbColor As Long) As Long
Private Declare Function DeleteObject Lib "GDI32" (ByVal hndobj As Long) As Long
Private Declare Function FillRgn Lib "GDI32" (ByVal hDC As Long, ByVal hRegion As Long, ByVal hBrush As Long) As Long
Private Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal Index As Long) As Long
Private Declare Function LineTo Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function MoveToEx Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal NullPtr As Long) As Long
Private Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal PaletteHandle As Long, ByVal Background As Long) As Long
Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal ObjectHandle As Long) As Long

Const PLANES = 14
Const BITSPIXEL = 12
Const PC_NOCOLLAPSE = 4
Const COLORS = 24
Const PS_SOLID = 0

Const NumColors = 16
Const TopColor = 12: ' all but last 3 colors are gray
Const RectangleSENWColor = 10
Const TriangleSSENNWColor = 9
Const TriangleSENWColor = 8
Const RectangleWEColor = 7
Const FloorColor = 6
Const TriangleSWNEColor = 5
Const RectangleSWNEColor = 4
Const TriangleSSWNNEColor = 3
Const BackoutColor = 13
Const AdvanceColor = 14
Const SolutionColor = 15

Const RelativeWidthOfWall = 0.25: ' relative to side of hexagon or square
Const RelativeHeightOfWall = 2#: ' relative to side of hexagon or square
Const MinWallLengthInInches = 0.25

Const SecondsForMazeSelection = 0.25

Dim AlreadyPainting As Boolean
Dim BaseRectangle(5, 3) As VertexRec
Dim BaseTriangle(3, 2) As VertexRec
Dim ComputerPage() As Byte
Dim CosTilt As Double
Dim CurrentColor As Integer
Dim HexDeltaX(5, 719) As Integer
Dim HexDeltaY(5, 719) As Integer
Dim MaxX As Integer
Dim MaxY As Integer
Dim Minimized As Boolean
Dim NumColumns As Integer
Dim NumRealized As Long
Dim NumRoomsInMaze As Integer
Dim NumRows As Integer
Dim OldPaletteHandle As Long
Dim Paint As Boolean
Dim PaletteHandle As Long
Dim PixelsPerX As Double
Dim PixelsPerZ As Double
Dim Rectangle(5, 3) As VertexRec
Dim RedGreenBlue(16) As Long
Dim RelDistOfUserFromScreen As Double
Dim Resize As Boolean
Dim Seed As String
Dim SinTilt As Double
Dim SolutionDisplayed As Boolean
Dim SqrDeltaX(3, 23) As Integer
Dim SqrDeltaY(3, 23) As Integer
Dim Sqrt3 As Double
Dim Stack() As StackRec
Dim State As Byte
Dim SubstitutionHigh(99) As Byte
Dim SubstitutionLow(99) As Byte
Dim Tilt As Double
Dim UsePalette As Boolean
Dim UserHasSolved As Boolean
Dim UserPage() As Byte
Dim UserX As Integer
Dim UserXRelative As Double
Dim UserY As Integer
Dim UserYRelative As Double
Dim X As Integer
Dim XMax As Double
Dim XOffset As Double
Dim Y As Integer
Dim YMax As Double
Dim YMod4 As Byte
Dim YOffset As Double

本帖地址： http://bbs.pfan.cn/post/28954.html

回复列表（共22个回复）

11 楼

enrui [专家分：0] 发布于 2004-06-14 12:52:00

[em18]可是我想知道用PASCAL编出来是怎样的啊?

12 楼

轩辕 [专家分：0] 发布于 2004-10-04 19:15:00

Private Sub OutputLeftRight(XMax As Double, XOffset As Double, YMax As Double, Rectangle() As VertexRec, PixelsPerX As Double, PixelsPerZ As Double, CosTilt As Double, SinTilt As Double, RelDistOfUserFromScreen As Double)
  Dim X0 As Double
  Dim X1 As Double
  Dim X2 As Double
  Dim X3 As Double
  Dim Y0 As Double
  Dim Y1 As Double
  Dim Y2 As Double
  Dim Y3 As Double
  If 2# * Rectangle(0).X > XMax Then
    X0 = Rectangle(0).X
    Y0 = Rectangle(0).Y
    X1 = Rectangle(3).X
    Y1 = Rectangle(3).Y
    X2 = Rectangle(3).X
    Y2 = Rectangle(3).Y
    X3 = Rectangle(0).X
    Y3 = Rectangle(0).Y
    Call DisplayQuadrilateral(XMax, XOffset, YMax, X0, Y0, RelativeHeightOfWall, X1, Y1, RelativeHeightOfWall, X2, Y2, 0#, X3, Y3, 0#, PixelsPerX, PixelsPerZ, CosTilt, SinTilt, RelDistOfUserFromScreen, RectangleSENWColor)
  End If
  If 2# * Rectangle(1).X < XMax Then
    X0 = Rectangle(2).X
    Y0 = Rectangle(2).Y
    X1 = Rectangle(1).X
    Y1 = Rectangle(1).Y
    X2 = Rectangle(1).X
    Y2 = Rectangle(1).Y
    X3 = Rectangle(2).X
    Y3 = Rectangle(2).Y
    Call DisplayQuadrilateral(XMax, XOffset, YMax, X0, Y0, RelativeHeightOfWall, X1, Y1, RelativeHeightOfWall, X2, Y2, 0#, X3, Y3, 0#, PixelsPerX, PixelsPerZ, CosTilt, SinTilt, RelDistOfUserFromScreen, RectangleSWNEColor)
  End If
End Sub

Private Sub DrawLine(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, XMax As Double, XOffset As Double, YMax As Double, CosTilt As Double, SinTilt As Double, PixelsPerX As Double, PixelsPerZ As Double, RelDistOfUserFromScreen As Double)
  Dim LineX1 As Long
  Dim LineX2 As Long
  Dim LineY1 As Long
  Dim LineY2 As Long
  Dim Pen As Long
  Dim PreviousPen As Long
  Dim rc As Long
  Dim tem As CornerRec
  Call GetCorner(X1, Y1, RelativeHeightOfWall, PixelsPerX, PixelsPerZ, CosTilt, SinTilt, RelDistOfUserFromScreen, XMax, XOffset, YMax, tem)
  LineX1 = tem.X
  LineY1 = tem.Y
  Call GetCorner(X2, Y2, RelativeHeightOfWall, PixelsPerX, PixelsPerZ, CosTilt, SinTilt, RelDistOfUserFromScreen, XMax, XOffset, YMax, tem)
  LineX2 = tem.X
  LineY2 = tem.Y
  If UsePalette Then
    Pen = CreatePen(PS_SOLID, 2, 16777216 + CurrentColor)
    If Pen Then
      PreviousPen = SelectObject(frm3DMaze.hDC, Pen)
      rc = MoveToEx(frm3DMaze.hDC, LineX1, LineY1, 0)
      rc = LineTo(frm3DMaze.hDC, LineX2, LineY2)
      rc = SelectObject(frm3DMaze.hDC, PreviousPen)
      rc = DeleteObject(Pen)
    End If
  Else
    Pen = CreatePen(PS_SOLID, 2, RedGreenBlue(CurrentColor))
    If Pen Then
      PreviousPen = SelectObject(frm3DMaze.hDC, Pen)
      rc = MoveToEx(frm3DMaze.hDC, LineX1, LineY1, 0)
      rc = LineTo(frm3DMaze.hDC, LineX2, LineY2)
      rc = SelectObject(frm3DMaze.hDC, PreviousPen)
      rc = DeleteObject(Pen)
    End If
  End If
End Sub

Private Sub Hash(Counter0 As Byte, Counter1 As Byte, Counter2 As Byte, Counter3 As Byte, Counter4 As Byte, Counter5 As Byte, Counter6 As Byte, Counter7 As Byte)
  Dim Iteration As Byte
  Dim Seed0 As Byte
  Dim Seed1 As Byte
  Dim Seed2 As Byte
  Dim Seed3 As Byte
  Dim Seed4 As Byte
  Dim Seed5 As Byte
  Dim Seed6 As Byte
  Dim Seed7 As Byte
  Dim SubstitutionIndex As Byte
  Dim Tem0 As Byte
  Dim Tem1 As Byte
  Dim Tem2 As Byte
  Seed0 = Counter0
  Seed1 = Counter1
  Seed2 = Counter2
  Seed3 = Counter3
  Seed4 = Counter4
  Seed5 = Counter5
  Seed6 = Counter6
  Seed7 = Counter7
  For Iteration = 1 To 8
    SubstitutionIndex = 10 * Seed1 + Seed0
    Tem0 = SubstitutionLow(SubstitutionIndex)
    Tem1 = SubstitutionHigh(SubstitutionIndex)
    SubstitutionIndex = 10 * Seed3 + Seed2
    Seed0 = SubstitutionLow(SubstitutionIndex)
    Tem2 = SubstitutionHigh(SubstitutionIndex)
    SubstitutionIndex = 10 * Seed5 + Seed4
    Seed2 = SubstitutionLow(SubstitutionIndex)
    Seed1 = SubstitutionHigh(SubstitutionIndex)
    SubstitutionIndex = 10 * Seed7 + Seed6
    Seed5 = SubstitutionLow(SubstitutionIndex)
    Seed7 = SubstitutionHigh(SubstitutionIndex)
    Seed3 = Tem0
    Seed6 = Tem1
    Seed4 = Tem2
  Next Iteration
  Counter0 = Seed0
  Counter1 = Seed1
  Counter2 = Seed2
  Counter3 = Seed3
  Counter4 = Seed4
  Counter5 = Seed5
  Counter6 = Seed6
  Counter7 = Seed7
End Sub

Private Sub Increment(Counter0 As Byte, Counter1 As Byte, Counter2 As Byte, Counter3 As Byte, Counter4 As Byte, Counter5 As Byte, Counter6 As Byte, Counter7 As Byte)
  Dim tem As Byte
  tem = Counter0 + 1
  If tem <= 9 Then
    Counter0 = tem
  Else
    Counter0 = 0
    tem = Counter1 + 1
    If tem <= 9 Then
      Counter1 = tem
    Else
      Counter1 = 0
      tem = Counter2 + 1
      If tem <= 9 Then
        Counter2 = tem
      Else
        Counter2 = 0
        tem = Counter3 + 1
        If tem <= 9 Then
          Counter3 = tem
        Else
          Counter3 = 0
          tem = Counter4 + 1
          If tem <= 9 Then
            Counter4 = tem
          Else
            Counter4 = 0
            tem = Counter5 + 1
            If tem <= 9 Then
              Counter5 = tem
            Else
              Counter5 = 0
              tem = Counter6 + 1
              If tem <= 9 Then
                Counter6 = tem
              Else
                Counter6 = 0
                tem = Counter7 + 1
                If tem <= 9 Then
                  Counter7 = tem
                Else
                  Counter7 = 0
                End If
              End If
            End If
          End If
        End If
      End If
    End If
  End If
End Sub

13 楼

0oo000o00o [专家分：0] 发布于 2005-01-31 15:26:00

。。。。。看着郁闷

14 楼

hbn245 [专家分：0] 发布于 2005-02-04 14:56:00

先说明一下，这里学编程？？？？？

15 楼

风花雪月☆雨 [专家分：460] 发布于 2005-09-04 08:36:00

我崩溃了

16 楼

zhaoren [专家分：420] 发布于 2005-09-04 11:31:00

再来一个
我就死了~[em54][em23]

17 楼

stuart920106 [专家分：730] 发布于 2005-09-04 15:14:00

我…………………………我…………………………我………………………………………………#￥###%^##%^@#&^%*&%*&(()#$%@%

18 楼

mo19880630 [专家分：420] 发布于 2005-09-05 12:31:00

似乎是用BASIC语言编的!!!!

[img]http://sports.sohu.com/upload/wallpapers/shaq_yao1024x768.jpg[/img]

19 楼

花花美男子 [专家分：260] 发布于 2005-09-05 18:46:00

太长了，看都累得死人

20 楼

欧阳淼 [专家分：280] 发布于 2005-09-05 19:38:00

似乎在PASCAL里，if语句不用加End If呀！[em10]

我来回复

您尚未登录，请登录后再回复。点此登录或注册

主题：迷宫答案

回复列表（共22个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

主题：迷宫答案

回复列表 （共22个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

回复列表（共22个回复）