3dmaze.frm

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

    End If
  Else
    X0 = Triangle(0).X
    Y0 = Triangle(0).Y
    X1 = Triangle(2).X
    Y1 = Triangle(2).Y
    X2 = Triangle(2).X
    Y2 = Triangle(2).Y
    X3 = Triangle(0).X
    Y3 = Triangle(0).Y
    Call DisplayQuadrilateral(XMax#, XOffset#, YMax#, X0, Y0, RelativeHeightOfWall, X1, Y1, RelativeHeightOfWall, X2, Y2, 0#, X3, Y3, 0#, PixelsPerX#, PixelsPerZ#, CosTilt#, SinTilt#, RelDistOfUserFromScreen#, FaceColor%)
    X0 = Triangle(0).X
    Y0 = Triangle(0).Y
    X1 = Triangle(1).X
    Y1 = Triangle(1).Y
    X2 = Triangle(2).X
    Y2 = Triangle(2).Y
    Call DisplayTriangle(XMax#, XOffset#, YMax#, X0, Y0, RelativeHeightOfWall, X1, Y1, RelativeHeightOfWall, X2, Y2, RelativeHeightOfWall, PixelsPerX#, PixelsPerZ#, CosTilt#, SinTilt#, RelDistOfUserFromScreen#, TopColor)
  End If
End Sub

Private Sub OutputRectangle(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, FaceColor As Integer)
  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
  X0 = Rectangle(3).X
  Y0 = Rectangle(3).Y
  X1 = Rectangle(2).X
  Y1 = Rectangle(2).Y
  X2 = Rectangle(2).X
  Y2 = Rectangle(2).Y
  X3 = Rectangle(3).X
  Y3 = Rectangle(3).Y
  Call DisplayQuadrilateral(XMax, XOffset, YMax, X0, Y0, RelativeHeightOfWall, X1, Y1, RelativeHeightOfWall, X2, Y2, 0#, X3, Y3, 0#, PixelsPerX, PixelsPerZ, CosTilt, SinTilt, RelDistOfUserFromScreen, FaceColor)
  X0 = Rectangle(0).X
  Y0 = Rectangle(0).Y
  X1 = Rectangle(1).X
  Y1 = Rectangle(1).Y
  X2 = Rectangle(2).X
  Y2 = Rectangle(2).Y
  X3 = Rectangle(3).X
  Y3 = Rectangle(3).Y
  Call DisplayQuadrilateral(XMax, XOffset, YMax, X0, Y0, RelativeHeightOfWall, X1, Y1, RelativeHeightOfWall, X2, Y2, RelativeHeightOfWall, X3, Y3, RelativeHeightOfWall, PixelsPerX, PixelsPerZ, CosTilt, SinTilt, RelDistOfUserFromScreen, TopColor)
End Sub

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

Private Sub HexDisplaySolution(MaxY As Integer, Page() As Byte, 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 DeltaIndex As Byte
  Dim OldPaletteHandle As Long
  Dim PathFound As Integer
  Dim X As Integer
  Dim XNext As Integer
  Dim XPrevious As Integer
  Dim XRelative As Double
  Dim XRelativeNext As Double
  Dim Y As Integer
  Dim YNext As Integer
  Dim YPrevious As Integer
  Dim YRelative As Double
  Dim YRelativeNext As Double
  If UsePalette Then
    OldPaletteHandle = SelectPalette(frm3DMaze.hDC, PaletteHandle, 0)
    NumRealized = RealizePalette(frm3DMaze.hDC)
  End If
  XRelative = 1#
  YRelative = Sqrt3 / 2#
  CurrentColor = SolutionColor
  Call DrawLine(1#, 0#, XRelative, YRelative, XMax, XOffset, YMax, CosTilt, SinTilt, PixelsPerX, PixelsPerZ, RelDistOfUserFromScreen)
  XPrevious = 3
  YPrevious = -2
  X = 3
  Y = 2
  Do
    PathFound = False
    DeltaIndex = 0
    Do While (Not PathFound)
      XNext = X + HexDeltaX(DeltaIndex, 0)
      YNext = Y + HexDeltaY(DeltaIndex, 0)
      If Page(YNext, XNext) = 1 Then
        XNext = XNext + HexDeltaX(DeltaIndex, 0)
        YNext = YNext + HexDeltaY(DeltaIndex, 0)
        If (XNext <> XPrevious) Or (YNext <> YPrevious) Then
          PathFound = True
        Else
          DeltaIndex = DeltaIndex + 1
        End If
      Else
        DeltaIndex = DeltaIndex + 1
      End If
    Loop
    If YNext < MaxY Then
      Select Case YNext - Y
        Case -4
          XRelativeNext = XRelative
          YRelativeNext = YRelative - Sqrt3
        Case -2
          If XNext > X Then
            XRelativeNext = XRelative + 3# / 2#
            YRelativeNext = YRelative - Sqrt3 / 2#
          Else
            XRelativeNext = XRelative - 3# / 2#
            YRelativeNext = YRelative - Sqrt3 / 2#
          End If
        Case 2
          If XNext > X Then
            XRelativeNext = XRelative + 3# / 2#
            YRelativeNext = YRelative + Sqrt3 / 2#
          Else
            XRelativeNext = XRelative - 3# / 2#
            YRelativeNext = YRelative + Sqrt3 / 2#
          End If
        Case Else
          XRelativeNext = XRelative
          YRelativeNext = YRelative + Sqrt3
      End Select
      Call DrawLine(XRelative, YRelative, XRelativeNext, YRelativeNext, XMax, XOffset, YMax, CosTilt, SinTilt, PixelsPerX, PixelsPerZ, RelDistOfUserFromScreen)
    Else
      Call DrawLine(XRelative, YRelative, XRelative, YMax, XMax, XOffset, YMax, CosTilt, SinTilt, PixelsPerX, PixelsPerZ, RelDistOfUserFromScreen)
    End If
    XPrevious = X
    YPrevious = Y
    X = XNext
    Y = YNext
    XRelative = XRelativeNext
    YRelative = YRelativeNext
  Loop While YNext < MaxY
  If UsePalette Then
    NumRealized = SelectPalette(frm3DMaze.hDC, OldPaletteHandle, 0)
  End If
End Sub

Private Sub HexDisplayUserMoves(MaxX As Integer, MaxY As Integer, Page() As Byte, 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 DeltaIndex As Byte
  Dim EvenRow As Boolean
  Dim OldPaletteHandle As Long
  Dim X As Integer
  Dim XNext As Integer
  Dim XNextNext As Integer
  Dim XRelative As Double
  Dim XRelativeNext As Double
  Dim Y As Integer
  Dim YNext As Integer
  Dim YNextNext As Integer
  Dim YRelative As Double
  Dim YRelativeNext As Double
  If UsePalette Then
    OldPaletteHandle = SelectPalette(frm3DMaze.hDC, PaletteHandle, 0)
    NumRealized = RealizePalette(frm3DMaze.hDC)
  End If
  Y = 2
  YRelative = Sqrt3 / 2#
  EvenRow = False
  Do While (Y < MaxY)
    If EvenRow Then
      X = 7
      XRelative = 2.5
    Else
      X = 3
      XRelative = 1#
    End If
    Do While (X < MaxX)
      If ((Page(Y, X) = 1) Or (Page(Y, X) = 3)) Then
        For DeltaIndex = 0 To 5
          XNext = X + HexDeltaX(DeltaIndex, 0)
          YNext = Y + HexDeltaY(DeltaIndex, 0)
          If Page(YNext, XNext) <> 0 Then
            If YNext = 0 Then
              CurrentColor = AdvanceColor
              Call DrawLine(1#, 0#, XRelative, YRelative, XMax, XOffset, YMax, CosTilt, SinTilt, PixelsPerX, PixelsPerZ, RelDistOfUserFromScreen)