3dmaze.frm

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

            Else
              If YNext = MaxY Then
                If UserHasSolved Then
                  CurrentColor = AdvanceColor
                  YRelativeNext = YRelative + Sqrt3 / 2#
                  Call DrawLine(XRelative, YRelative, XRelative, YRelativeNext, XMax, XOffset, YMax, CosTilt, SinTilt, PixelsPerX, PixelsPerZ, RelDistOfUserFromScreen)
                End If
              Else
                XNextNext = XNext + HexDeltaX(DeltaIndex, 0)
                If XNextNext > 0 Then
                  If XNextNext < MaxX Then
                    YNextNext = YNext + HexDeltaY(DeltaIndex, 0)
                    If YNextNext > 0 Then
                      If YNextNext < MaxY Then
                        If ((Page(YNextNext, XNextNext) = 1) Or (Page(YNextNext, XNextNext) = 3)) Then
                          If Page(Y, X) = Page(YNextNext, XNextNext) Then
                            If Page(Y, X) = 1 Then
                              CurrentColor = AdvanceColor
                            Else
                              CurrentColor = BackoutColor
                            End If
                          Else
                            CurrentColor = BackoutColor
                          End If
                          Select Case (YNext - Y)
                            Case -2
                              XRelativeNext = XRelative
                              YRelativeNext = YRelative - Sqrt3 / 2#
                            Case -1
                              If XNext > X Then
                                XRelativeNext = XRelative + 3# / 4#
                                YRelativeNext = YRelative - Sqrt3 / 4#
                              Else
                                XRelativeNext = XRelative - 3# / 4#
                                YRelativeNext = YRelative - Sqrt3 / 4#
                              End If
                            Case 1
                              If XNext > X Then
                                XRelativeNext = XRelative + 3# / 4#
                                YRelativeNext = YRelative + Sqrt3 / 4#
                              Else
                                XRelativeNext = XRelative - 3# / 4#
                                YRelativeNext = YRelative + Sqrt3 / 4#
                              End If
                            Case Else
                              XRelativeNext = XRelative
                              YRelativeNext = YRelative + Sqrt3 / 2#
                          End Select
                          Call DrawLine(XRelative, YRelative, XRelativeNext, YRelativeNext, XMax, XOffset, YMax, CosTilt, SinTilt, PixelsPerX, PixelsPerZ, RelDistOfUserFromScreen)
                        End If
                       End If
                    End If
                  End If
                End If
              End If
            End If
          End If
        Next DeltaIndex
      End If
      XRelative = XRelative + 3#
      X = X + 8
    Loop
    EvenRow = Not EvenRow
    YRelative = YRelative + Sqrt3 / 2#
    Y = Y + 2
  Loop
  If UsePalette Then
    NumRealized = SelectPalette(frm3DMaze.hDC, OldPaletteHandle, 0)
  End If
End Sub

Private Sub HexSolveMaze(Stack() As StackRec, Page() As Byte, NumRoomsInSolution As Integer, Adjacency As Integer, MaxX As Integer, MaxY As Integer)
  Dim DeltaIndex As Byte
  Dim PassageFound As Integer
  Dim StackHead As Integer
  Dim X As Integer
  Dim XNext As Integer
  Dim Y As Integer
  Dim YNext As Integer

  NumRoomsInSolution = 1
  Adjacency = 0
  X = 3
  Y = 2
  StackHead = -1
  Page(Y, X) = 1
  Do
    DeltaIndex = 0
    PassageFound = False
    Do
      Do While ((DeltaIndex < 6) And (Not PassageFound))
        XNext = X + HexDeltaX(DeltaIndex, 0)
        YNext = Y + HexDeltaY(DeltaIndex, 0)
        If Page(YNext, XNext) = 2 Then
          PassageFound = True
        Else
          DeltaIndex = DeltaIndex + 1
        End If
      Loop
      If Not PassageFound Then
        DeltaIndex = Stack(StackHead).Index1
        Page(Y, X) = 2
        X = X - HexDeltaX(DeltaIndex, 0)
        Y = Y - HexDeltaY(DeltaIndex, 0)
        Page(Y, X) = 2
        X = X - HexDeltaX(DeltaIndex, 0)
        Y = Y - HexDeltaY(DeltaIndex, 0)
        StackHead = StackHead - 1
        DeltaIndex = DeltaIndex + 1
      End If
    Loop While Not PassageFound
    Page(YNext, XNext) = 1
    XNext = XNext + HexDeltaX(DeltaIndex, 0)
    YNext = YNext + HexDeltaY(DeltaIndex, 0)
    If YNext <= MaxY Then
      StackHead = StackHead + 1
      Stack(StackHead).Index1 = DeltaIndex
      Page(YNext, XNext) = 1
      X = XNext
      Y = YNext
    End If
  Loop While YNext < MaxY
  X = MaxX - 3
  Y = MaxY - 2
  Adjacency = 0
  Do While (StackHead >= 0)
    For DeltaIndex = 0 To 5
      XNext = X + HexDeltaX(DeltaIndex, 0)
      YNext = Y + HexDeltaY(DeltaIndex, 0)
      If Page(YNext, XNext) <> 1 Then
        If Page(YNext, XNext) = 0 Then
          XNext = XNext + HexDeltaX(DeltaIndex, 0)
          YNext = YNext + HexDeltaY(DeltaIndex, 0)
          If XNext < 0 Then
            Adjacency = Adjacency + 1
          Else
            If XNext > MaxX Then
              Adjacency = Adjacency + 1
            Else
              If YNext < 0 Then
                Adjacency = Adjacency + 1
              Else
                If YNext > MaxY Then
                  Adjacency = Adjacency + 1
                Else
                  If Page(YNext, XNext) = 1 Then
                    Adjacency = Adjacency + 1
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
    Next DeltaIndex
    X = X - 2 * HexDeltaX(Stack(StackHead).Index1, 0)
    Y = Y - 2 * HexDeltaY(Stack(StackHead).Index1, 0)
    StackHead = StackHead - 1
    NumRoomsInSolution = NumRoomsInSolution + 1
  Loop
  For DeltaIndex = 0 To 5
    XNext = X + HexDeltaX(DeltaIndex, 0)
    YNext = X + HexDeltaY(DeltaIndex, 0)
    If Page(YNext, XNext) <> 2 Then
      If Page(YNext, XNext) = 0 Then
        XNext = XNext + HexDeltaX(DeltaIndex, 0)
        YNext = YNext + HexDeltaY(DeltaIndex, 0)
        If XNext < 0 Then
          Adjacency = Adjacency + 1
        Else
          If XNext > MaxX Then
            Adjacency = Adjacency + 1
          Else
            If YNext < 0 Then
              Adjacency = Adjacency + 1
            Else
              If YNext > MaxY Then
                Adjacency = Adjacency + 1
              Else
                If Page(YNext, XNext) = 1 Then
                  Adjacency = Adjacency + 1
                End If
              End If
            End If
          End If
        End If
      End If
    End If
  Next DeltaIndex
End Sub

Private Sub HexGenerateMaze(Page() As Byte, MaxX As Integer, MaxY As Integer, Stack() As StackRec, NumColumns As Integer, NumRows As Integer, Seed() As Byte)
  Dim ColumnNum As Integer
  Dim DeltaIndex1 As Integer
  Dim DeltaIndex2 As Integer
  Dim PassageFound As Integer
  Dim RN(7) As Integer
  Dim RNIndex1 As Integer
  Dim RNIndex2 As Integer
  Dim RowNum As Integer
  Dim SearchComplete As Integer
  Dim StackHead As Integer
  Dim TemInt As Integer
  Dim X As Integer
  Dim XMod8 As Byte
  Dim XNext As Integer
  Dim Y As Integer
  Dim YMod4 As Byte
  Dim YNext As Integer

  RN(0) = Seed(0) + 1
  RN(1) = Seed(1) + 1
  RN(2) = Seed(2) + 1
  RN(3) = Seed(3) + 1
  RN(4) = Seed(4) + 1
  RN(5) = Seed(5) + 1
  RN(6) = Seed(6) + 1
  RN(7) = Seed(7) + 1
  YMod4 = 1
  For Y = 0 To MaxY
    If YMod4 = 1 Then
      XMod8 = 1
      For X = 0 To MaxX
        If (((XMod8 = 0) And (Y <> 0) And (Y <> MaxY)) Or (XMod8 = 3) Or (XMod8 = 4) Or (XMod8 = 5)) Then
          Page(Y, X) = 0
        Else
          Page(Y, X) = 2
        End If
        XMod8 = XMod8 + 1
        If XMod8 >= 8 Then XMod8 = 0
      Next X
    Else
      If YMod4 = 0 Or YMod4 = 2 Then
        XMod8 = 1
        For X = 0 To MaxX
          If (XMod8 = 2) Or (XMod8 = 6) Then
            Page(Y, X) = 0
          Else
            Page(Y, X) = 2
          End If
          XMod8 = XMod8 + 1
          If XMod8 >= 8 Then XMod8 = 0
        Next X
      Else
        XMod8 = 1
        For X = 0 To MaxX
          If (XMod8 = 0) Or (XMod8 = 1) Or (XMod8 = 4) Or (XMod8 = 7) Then
            Page(Y, X) = 0
          Else
            Page(Y, X) = 2
          End If
          XMod8 = XMod8 + 1
          If XMod8 >= 8 Then XMod8 = 0
        Next X
      End If
    End If
    YMod4 = YMod4 + 1
    If YMod4 >= 4 Then YMod4 = 0
  Next Y
  ColumnNum = RN(0)
  RNIndex1 = 0
  RNIndex2 = 1
  Do While (RNIndex2 < 8)
    TemInt = RN(RNIndex2)
    RN(RNIndex1) = TemInt
    ColumnNum = ColumnNum + TemInt
    If ColumnNum >= 727 Then ColumnNum = ColumnNum - 727
    RNIndex1 = RNIndex2
    RNIndex2 = RNIndex2 + 1
  Loop
  RN(7) = ColumnNum
  ColumnNum = ColumnNum Mod NumColumns
  X = 4 * ColumnNum + 3
  RowNum = RN(0)
  RNIndex1 = 0
  RNIndex2 = 1
  Do While (RNIndex2 < 8)
    TemInt = RN(RNIndex2)
    RN(RNIndex1) = TemInt
    RowNum = RowNum + TemInt
    If RowNum >= 727 Then RowNum = RowNum - 727
    RNIndex1 = RNIndex2
    RNIndex2 = RNIndex2 + 1
  Loop
  RN(7) = RowNum
  If ColumnNum Mod 2 Then
    RowNum = RowNum Mod (NumRows - 1)
    Y = 4 * RowNum + 4
  Else
    RowNum = RowNum Mod NumRows
    Y = 4 * RowNum + 2
  End If
  Page(Y, X) = 2
  StackHead = -1
  Do
    DeltaIndex1 = 0
    Do
      DeltaIndex2 = RN(0)
      RNIndex1 = 0
      RNIndex2 = 1
      Do While (RNIndex2 < 8)
        TemInt = RN(RNIndex2)
        RN(RNIndex1) = TemInt
        DeltaIndex2 = DeltaIndex2 + TemInt
        If DeltaIndex2 >= 727 Then DeltaIndex2 = DeltaIndex2 - 727
        RNIndex1 = RNIndex2
        RNIndex2 = RNIndex2 + 1
      Loop
      RN(7) = DeltaIndex2
    Loop While DeltaIndex2 >= 720
    PassageFound = False
    SearchComplete = False
    Do While (Not SearchComplete)
      Do While ((DeltaIndex1 < 6) And (Not PassageFound))
        XNext = X + 2 * HexDeltaX(DeltaIndex1, DeltaIndex2)
        If XNext <= 0 Then
          DeltaIndex1 = DeltaIndex1 + 1
        Else
          If XNext > MaxX Then
            DeltaIndex1 = DeltaIndex1 + 1
          Else
            YNext = Y + 2 * HexDeltaY(DeltaIndex1, DeltaIndex2)
            If YNext <= 0 Then
              DeltaIndex1 = DeltaIndex1 + 1
            Else
              If YNext > MaxY Then
                DeltaIndex1 = DeltaIndex1 + 1
              Else
                If Page(YNext, XNext) = 0 Then
                  PassageFound = True
                Else
                  DeltaIndex1 = DeltaIndex1 + 1
                End If
              End If
            End If
          End If
        End If
      Loop
      If Not PassageFound Then
        If StackHead >= 0 Then
          DeltaIndex1 = Stack(StackHead).Index1
          DeltaIndex2 = Stack(StackHead).Index2
          X = X - 2 * HexDeltaX(DeltaIndex1, DeltaIndex2)