3dmaze.frm

用vb实现的3d迷宫游戏的代码

          Y = Y - 2 * HexDeltaY(DeltaIndex1, DeltaIndex2)
          StackHead = StackHead - 1
          DeltaIndex1 = DeltaIndex1 + 1
        End If
      End If
      If ((PassageFound) Or ((StackHead = -1) And (DeltaIndex1 >= 6))) Then
        SearchComplete = True
      Else
        SearchComplete = False
      End If
    Loop
    If PassageFound Then
      StackHead = StackHead + 1
      Stack(StackHead).Index1 = DeltaIndex1
      Stack(StackHead).Index2 = DeltaIndex2
      Page(YNext, XNext) = 2
      Page((Y + YNext) \ 2, (X + XNext) \ 2) = 2
      X = XNext
      Y = YNext
    End If
  Loop While StackHead <> -1
  Page(0, 3) = 1
  Page(MaxY, MaxX - 3) = 2
End Sub

Private Sub HexSelectMaze(Seed As String, Page() As Byte, MaxX As Integer, MaxY As Integer, Stack() As StackRec, NumRoomsInMaze As Integer, NumColumns As Integer, NumRows As Integer, SecondsForMazeSelection As Double)
  Dim Adjacency As Integer
  Dim Counter0 As Byte
  Dim Counter1 As Byte
  Dim Counter2 As Byte
  Dim Counter3 As Byte
  Dim Counter4 As Byte
  Dim Counter5 As Byte
  Dim Counter6 As Byte
  Dim Counter7 As Byte
  Dim ElapsedTime As Double
  Dim MinAdjacency As Integer
  Dim NumRoomsInSolution As Integer
  Dim NumRoomsInSolutionAtMin As Integer
  Dim RN(7) As Integer
  Dim RNIndex1 As Integer
  Dim RNIndex2 As Integer
  Dim SeedByte(7) As Byte
  Dim SeedByteAtMin(7) As Byte
  Dim SeedLength As Integer
  Dim StartTime As Double

  SeedLength = Len(Seed)
  If SeedLength > 8 Then SeedLength = 8
  RNIndex1 = 0
  For RNIndex2 = 1 To SeedLength
    RN(RNIndex1) = Asc(Mid$(Seed, RNIndex2, 1)) Mod 10
    RNIndex1 = RNIndex1 + 1
  Next RNIndex2
  RNIndex2 = 7
  Do While (RNIndex1 > 0)
    RNIndex1 = RNIndex1 - 1
    RN(RNIndex2) = RN(RNIndex1)
    RNIndex2 = RNIndex2 - 1
  Loop
  Do While (RNIndex2 >= 0)
    RN(RNIndex2) = 8
    RNIndex2 = RNIndex2 - 1
  Loop
  Counter0 = RN(0)
  Counter1 = RN(1)
  Counter2 = RN(2)
  Counter3 = RN(3)
  Counter4 = RN(4)
  Counter5 = RN(5)
  Counter6 = RN(6)
  Counter7 = RN(7)
  Call Hash(Counter0, Counter1, Counter2, Counter3, Counter4, Counter5, Counter6, Counter7)
  MinAdjacency = 4 * NumRoomsInMaze + 1
  NumRoomsInSolutionAtMin = 0
  SeedByteAtMin(0) = Counter0
  SeedByteAtMin(1) = Counter1
  SeedByteAtMin(2) = Counter2
  SeedByteAtMin(3) = Counter3
  SeedByteAtMin(4) = Counter4
  SeedByteAtMin(5) = Counter5
  SeedByteAtMin(6) = Counter6
  SeedByteAtMin(7) = Counter7
  StartTime = Timer
  Do
    SeedByte(0) = Counter0
    SeedByte(1) = Counter1
    SeedByte(2) = Counter2
    SeedByte(3) = Counter3
    SeedByte(4) = Counter4
    SeedByte(5) = Counter5
    SeedByte(6) = Counter6
    SeedByte(7) = Counter7
    Call HexGenerateMaze(Page(), MaxX, MaxY, Stack(), NumColumns, NumRows, SeedByte())
    Call HexSolveMaze(Stack(), Page(), NumRoomsInSolution, Adjacency, MaxX, MaxY)
    If 3 * NumRoomsInSolution >= NumRoomsInMaze Then
      If Adjacency < MinAdjacency Then
        MinAdjacency = Adjacency
        NumRoomsInSolutionAtMin = NumRoomsInSolution
        SeedByteAtMin(0) = SeedByte(0)
        SeedByteAtMin(1) = SeedByte(1)
        SeedByteAtMin(2) = SeedByte(2)
        SeedByteAtMin(3) = SeedByte(3)
        SeedByteAtMin(4) = SeedByte(4)
        SeedByteAtMin(5) = SeedByte(5)
        SeedByteAtMin(6) = SeedByte(6)
        SeedByteAtMin(7) = SeedByte(7)
      Else
        If Adjacency = MinAdjacency Then
          If NumRoomsInSolution > NumRoomsInSolutionAtMin Then
            NumRoomsInSolutionAtMin = NumRoomsInSolution
            SeedByteAtMin(0) = SeedByte(0)
            SeedByteAtMin(1) = SeedByte(1)
            SeedByteAtMin(2) = SeedByte(2)
            SeedByteAtMin(3) = SeedByte(3)
            SeedByteAtMin(4) = SeedByte(4)
            SeedByteAtMin(5) = SeedByte(5)
            SeedByteAtMin(6) = SeedByte(6)
            SeedByteAtMin(7) = SeedByte(7)
          End If
        End If
      End If
    End If
    Call Increment(Counter0, Counter1, Counter2, Counter3, Counter4, Counter5, Counter6, Counter7)
    ElapsedTime = Timer - StartTime
  Loop While ((ElapsedTime >= 0#) And (ElapsedTime < SecondsForMazeSelection))
  Call HexGenerateMaze(Page(), MaxX, MaxY, Stack(), NumColumns, NumRows, SeedByteAtMin())
  Call HexSolveMaze(Stack(), Page(), NumRoomsInSolution, Adjacency, MaxX, MaxY)
End Sub

Private Sub HexOutputMaze()
  Dim ObjectNum As Byte
  Dim Radians As Double
  Dim RadiansPerDegree As Double
  Dim SingleRectangle(3) As VertexRec
  Dim SingleTriangle(2) As VertexRec
  Dim TemDouble1 As Double
  Dim TemDouble2 As Double
  Dim TemDouble3 As Double
  Dim TemDouble4 As Double
  Dim Triangle(3, 2) As VertexRec
  Dim VertexNum As Byte
  Dim XMod8 As Byte
  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

  Select Case State
    Case 0
      Text1.Text = ""
      ScaleMode = 1
      If (Resize) Then
        TemDouble1 = ScaleWidth - VScroll1.Width
        TemDouble2 = MinWallLengthInInches
        TemDouble2 = 1440# * TemDouble2
        TemDouble3 = RelativeWidthOfWall
        NumColumns = Int(2# * (TemDouble1 / TemDouble2 - 2# - TemDouble3 / Sqrt3) / 3# + 1#)
        If NumColumns Mod 2 = 0 Then NumColumns = NumColumns - 1
        If NumColumns < 3 Then NumColumns = 3
        TemDouble1 = ScaleHeight - Text1.Height
        TemDouble2 = ScaleWidth - VScroll1.Width
        ScaleMode = 3
        TemDouble3 = NumColumns
        TemDouble4 = RelativeWidthOfWall
        NumRows = Int(((TemDouble1 / TemDouble2) * (3# * (TemDouble3 - 1#) / 2# + 2# + TemDouble4 / Sqrt3) - TemDouble4) / Sqrt3)
        If NumRows < 2 Then NumRows = 2
        Tilt = 90 - VScroll1.Value
        MaxX = 8 * (NumColumns \ 2) + 6
        MaxY = 4 * NumRows
        NumRoomsInMaze = NumRows * NumColumns - (NumColumns \ 2)
        ReDim ComputerPage(MaxY, MaxX)
        ReDim UserPage(MaxY, MaxX)
        ReDim Stack(NumRoomsInMaze)
        Call HexSelectMaze(Seed, ComputerPage(), MaxX, MaxY, Stack(), NumRoomsInMaze, NumColumns, NumRows, SecondsForMazeSelection)
        For UserX = 0 To MaxX
          For UserY = 0 To MaxY
            If ComputerPage(UserY, UserX) = 0 Then
              UserPage(UserY, UserX) = 0
            Else
              UserPage(UserY, UserX) = 2
            End If
          Next UserY
        Next UserX
        UserX = 3
        UserXRelative = 1#
        UserY = 2
        UserYRelative = Sqrt3 / 2#
        UserPage(UserY, UserX) = 1
        Resize = False
      End If
      If (Paint) Then
        ScaleMode = 3
        Cls
        RadiansPerDegree = Atn(1#) / 45#
        Radians = Tilt * RadiansPerDegree
        SinTilt = Sin(Radians)
        CosTilt = Cos(Radians)
        TemDouble1 = NumColumns
        XMax = 3# * (TemDouble1 - 1#) / 2# + 2# + RelativeWidthOfWall / Sqrt3
        TemDouble1 = ScaleWidth - VScroll1.Width
        PixelsPerX = (TemDouble1 - 1#) / (XMax * (XMax / (XMax - RelativeHeightOfWall)))
        XOffset = (XMax / 2#) * (RelativeHeightOfWall / (XMax - RelativeHeightOfWall))
        TemDouble1 = NumRows
        YMax = TemDouble1 * Sqrt3 + RelativeWidthOfWall
        TemDouble1 = ScaleHeight - Text1.Height
        PixelsPerZ = (TemDouble1 - 1#) / Sqr(YMax * YMax + RelativeHeightOfWall * RelativeHeightOfWall)
        If YMax > XMax Then
          RelDistOfUserFromScreen = YMax
        Else
          RelDistOfUserFromScreen = XMax
        End If
        Paint = False
      End If
      If State = 0 Then
        State = 1
        DoEvents
        If State < 5 Then
          Timer1.Enabled = True
        End If
      End If
    Case 1
      BaseTriangle(0, 0).X = 0#
      BaseTriangle(0, 0).Y = RelativeWidthOfWall + Sqrt3 / 2#
      BaseTriangle(0, 1).X = 0#
      BaseTriangle(0, 1).Y = Sqrt3 / 2#
      BaseTriangle(0, 2).X = RelativeWidthOfWall * Sqrt3 / 2#
      BaseTriangle(0, 2).Y = (RelativeWidthOfWall + Sqrt3) / 2#
      BaseTriangle(1, 0).X = (1# - RelativeWidthOfWall / Sqrt3) / 2#
      BaseTriangle(1, 0).Y = RelativeWidthOfWall / 2#
      BaseTriangle(1, 1).X = 0.5 + RelativeWidthOfWall / Sqrt3
      BaseTriangle(1, 1).Y = 0#
      BaseTriangle(1, 2).X = BaseTriangle(1, 1).X
      BaseTriangle(1, 2).Y = RelativeWidthOfWall
      BaseTriangle(2, 0).X = 1.5
      BaseTriangle(2, 0).Y = RelativeWidthOfWall
      BaseTriangle(2, 1).X = 1.5
      BaseTriangle(2, 1).Y = 0#
      BaseTriangle(2, 2).X = 1.5 * (1# + RelativeWidthOfWall / Sqrt3)
      BaseTriangle(2, 2).Y = RelativeWidthOfWall / 2#
      BaseTriangle(3, 0).X = 2# - RelativeWidthOfWall / (2# * Sqrt3)
      BaseTriangle(3, 0).Y = BaseTriangle(0, 2).Y
      BaseTriangle(3, 1).X = 2# + RelativeWidthOfWall / Sqrt3
      BaseTriangle(3, 1).Y = BaseTriangle(0, 1).Y
      BaseTriangle(3, 2).X = BaseTriangle(3, 1).X
      BaseTriangle(3, 2).Y = BaseTriangle(0, 0).Y
      BaseRectangle(0, 0).X = BaseTriangle(0, 2).X
      BaseRectangle(0, 0).Y = BaseTriangle(0, 2).Y
      BaseRectangle(0, 1).X = BaseTriangle(1, 1).X
      BaseRectangle(0, 1).Y = Sqrt3
      BaseRectangle(0, 2).X = BaseTriangle(1, 0).X
      BaseRectangle(0, 2).Y = Sqrt3 + RelativeWidthOfWall / 2#
      BaseRectangle(0, 3).X = BaseTriangle(0, 0).X
      BaseRectangle(0, 3).Y = BaseTriangle(0, 0).Y
      BaseRectangle(1, 0).X = BaseTriangle(0, 1).X
      BaseRectangle(1, 0).Y = BaseTriangle(0, 1).Y
      BaseRectangle(1, 1).X = BaseTriangle(1, 0).X
      BaseRectangle(1, 1).Y = BaseTriangle(1, 0).Y
      BaseRectangle(1, 2).X = BaseTriangle(1, 2).X
      BaseRectangle(1, 2).Y = BaseTriangle(1, 2).Y
      BaseRectangle(1, 3).X = BaseTriangle(0, 2).X
      BaseRectangle(1, 3).Y = BaseTriangle(0, 2).Y
      BaseRectangle(2, 0).X = BaseTriangle(1, 1).X
      BaseRectangle(2, 0).Y = BaseTriangle(1, 1).Y
      BaseRectangle(2, 1).X = BaseTriangle(2, 1).X
      BaseRectangle(2, 1).Y = BaseTriangle(2, 1).Y
      BaseRectangle(2, 2).X = BaseTriangle(2, 0).X
      BaseRectangle(2, 2).Y = BaseTriangle(2, 0).Y
      BaseRectangle(2, 3).X = BaseTriangle(1, 2).X
      BaseRectangle(2, 3).Y = BaseTriangle(1, 2).Y
      BaseRectangle(3, 0).X = BaseTriangle(2, 2).X
      BaseRectangle(3, 0).Y = BaseTriangle(2, 2).Y
      BaseRectangle(3, 1).X = BaseTriangle(3, 1).X
      BaseRectangle(3, 1).Y = BaseTriangle(3, 1).Y
      BaseRectangle(3, 2).X = BaseTriangle(3, 0).X
      BaseRectangle(3, 2).Y = BaseTriangle(3, 0).Y
      BaseRectangle(3, 3).X = BaseTriangle(2, 0).X
      BaseRectangle(3, 3).Y = BaseTriangle(2, 0).Y
      BaseRectangle(4, 0).X = BaseTriangle(3, 1).X
      BaseRectangle(4, 0).Y = BaseTriangle(3, 1).Y
      BaseRectangle(4, 1).X = BaseTriangle(3, 1).X + (BaseTriangle(2, 1).X - BaseTriangle(1, 1).X)
      BaseRectangle(4, 1).Y = BaseTriangle(3, 1).Y
      BaseRectangle(4, 2).X = BaseRectangle(4, 1).X
      BaseRectangle(4, 2).Y = BaseTriangle(3, 2).Y
      BaseRectangle(4, 3).X = BaseTriangle(3, 2).X
      BaseRectangle(4, 3).Y = BaseTriangle(3, 2).Y
      BaseRectangle(5, 0).X = BaseRectangle(0, 1).X + (BaseTriangle(2, 1).X - BaseTriangle(1, 1).X)
      BaseRectangle(5, 0).Y = BaseRectangle(0, 1).Y
      BaseRectangle(5, 1).X = BaseTriangle(3, 0).X
      BaseRectangle(5, 1).Y = BaseTriangle(3, 0).Y
      BaseRectangle(5, 2).X = BaseTriangle(3, 2).X
      BaseRectangle(5, 2).Y = BaseTriangle(3, 2).Y
      BaseRectangle(5, 3).X = BaseRectangle(0, 2).X + (BaseTriangle(2, 2).X - BaseTriangle(1, 0).X)
      BaseRectangle(5, 3).Y = BaseRectangle(0, 2).Y
      Rectangle(0, 0).X = BaseTriangle(1, 1).X
      Rectangle(0, 0).Y = BaseTriangle(1, 1).Y
      Rectangle(0, 1).X = XMax - BaseTriangle(1, 1).X
      Rectangle(0, 1).Y = BaseTriangle(1, 1).Y
      Rectangle(0, 2).X = XMax - BaseTriangle(1, 2).X
      Rectangle(0, 2).Y = BaseTriangle(1, 2).Y
      Rectangle(0, 3).X = BaseTriangle(1, 2).X
      Rectangle(0, 3).Y = BaseTriangle(1, 2).Y
      Rectangle(1, 0).X = BaseTriangle(0, 1).X
      Rectangle(1, 0).Y = BaseTriangle(0, 1).Y
      Rectangle(1, 1).X = XMax - BaseTriangle(0, 1).X
      Rectangle(1, 1).Y = BaseTriangle(0, 1).Y
      Rectangle(1, 2).X = XMax - BaseTriangle(1, 2).X
      Rectangle(1, 2).Y = BaseTriangle(1, 2).Y
      Rectangle(1, 3).X = BaseTriangle(1, 2).X
      Rectangle(1, 3).Y = BaseTriangle(1, 2).Y
      Rectangle(2, 0).X = BaseTriangle(0, 1).X
      Rectangle(2, 0).Y = BaseTriangle(0, 1).Y
      Rectangle(2, 1).X = XMax - BaseTriangle(0, 1).X
      Rectangle(2, 1).Y = BaseTriangle(0, 1).Y
      Rectangle(2, 2).X = XMax - BaseTriangle(0, 0).X
      Rectangle(2, 2).Y = BaseTriangle(0, 0).Y
      Rectangle(2, 3).X = BaseTriangle(0, 0).X
      Rectangle(2, 3).Y = BaseTriangle(0, 0).Y
      Rectangle(3, 0).X = BaseTriangle(0, 0).X
      Rectangle(3, 0).Y = BaseTriangle(0, 0).Y
      Rectangle(3, 1).X = XMax - BaseTriangle(0, 0).X
      Rectangle(3, 1).Y = BaseTriangle(0, 0).Y
      Rectangle(3, 2).X = XMax - BaseRectangle(0, 1).X
      Rectangle(3, 2).Y = BaseRectangle(0, 1).Y
      Rectangle(3, 3).X = BaseRectangle(0, 1).X
      Rectangle(3, 3).Y = BaseRectangle(0, 1).Y
      Y = 0
      State = 2
      DoEvents
      If State < 5 Then
        Timer1.Enabled = True
      End If
    Case 2
      If UsePalette Then
        OldPaletteHandle = SelectPalette(frm3DMaze.hDC, PaletteHandle, 0)
        NumRealized = RealizePalette(frm3DMaze.hDC)
      End If
      If (Y <= MaxY - 1) Then
        If Y > 0 Then