game.frm

treasure游戏源程序

      End If
    Next nCharIndex
    If nLastSlash > 0 Then
      If Mid(strFileName, nLastSlash + 1, nFileNameLength - nLastSlash) <> "VB32.EXE" Then
        strResult = Left(strFileName, nLastSlash)
      End If
    End If
  End If
  GetProgramPath = strResult
End Function

Private Sub GameUpdate()
  Dim Response As Long
  txtMoves.Text = nMoves
  If (Not bEuclidean) Then
    If nXCoordinate < 0 Then
      nYCoordinate = nWidth(1) - 1 - nYCoordinate
      nZCoordinate = nWidth(2) - 1 - nZCoordinate
      nTCoordinate = nWidth(3) - 1 - nTCoordinate
      nXCoordinate = nWidth(0) - 1
    Else
      If nXCoordinate >= nWidth(0) Then
        nYCoordinate = nWidth(1) - 1 - nYCoordinate
        nZCoordinate = nWidth(2) - 1 - nZCoordinate
        nTCoordinate = nWidth(3) - 1 - nTCoordinate
        nXCoordinate = 0
      End If
    End If
    If nYCoordinate < 0 Then
      nXCoordinate = nWidth(0) - 1 - nXCoordinate
      nZCoordinate = nWidth(2) - 1 - nZCoordinate
      nTCoordinate = nWidth(3) - 1 - nTCoordinate
      nYCoordinate = nWidth(1) - 1
    Else
      If nYCoordinate >= nWidth(1) Then
        nXCoordinate = nWidth(0) - 1 - nXCoordinate
        nZCoordinate = nWidth(2) - 1 - nZCoordinate
        nTCoordinate = nWidth(3) - 1 - nTCoordinate
        nYCoordinate = 0
      End If
    End If
    If nZCoordinate < 0 Then
      nXCoordinate = nWidth(0) - 1 - nXCoordinate
      nYCoordinate = nWidth(1) - 1 - nYCoordinate
      nTCoordinate = nWidth(3) - 1 - nTCoordinate
      nZCoordinate = nWidth(2) - 1
    Else
      If nZCoordinate >= nWidth(2) Then
        nXCoordinate = nWidth(0) - 1 - nXCoordinate
        nYCoordinate = nWidth(1) - 1 - nYCoordinate
        nTCoordinate = nWidth(3) - 1 - nTCoordinate
        nZCoordinate = 0
      End If
    End If
    If nTCoordinate < 0 Then
      nXCoordinate = nWidth(0) - 1 - nXCoordinate
      nYCoordinate = nWidth(1) - 1 - nYCoordinate
      nZCoordinate = nWidth(2) - 1 - nZCoordinate
      nTCoordinate = nWidth(3) - 1
    Else
      If nTCoordinate >= nWidth(3) Then
        nXCoordinate = nWidth(0) - 1 - nXCoordinate
        nYCoordinate = nWidth(1) - 1 - nYCoordinate
        nZCoordinate = nWidth(2) - 1 - nZCoordinate
        nTCoordinate = 0
      End If
    End If
  End If
  nRoom1 = nCell(nXCoordinate, nYCoordinate, nZCoordinate, nTCoordinate)
  If ((nRoom1 <> 0) And (strWayOut = "") And (Int(100# * Rnd) = 0)) Then
    nRoom2 = 0
    Do While nRoom2 <= 0
      nXCoordinate = Int(CDbl(nWidth(0)) * Rnd)
      nYCoordinate = Int(CDbl(nWidth(1)) * Rnd)
      nZCoordinate = Int(CDbl(nWidth(2)) * Rnd)
      nTCoordinate = Int(CDbl(nWidth(3)) * Rnd)
      nRoom2 = nCell(nXCoordinate, nYCoordinate, nZCoordinate, nTCoordinate)
    Loop
    If nRoom2 <> nRoom1 Then
      nRoom1 = nRoom2
      Response = MsgBox("A flock of bats grabs you,  flies you through the caverns,  and drops you.", vbOKOnly, "Yeowwww!")
    End If
  End If
  strWayOut = ""
  nTreasuresRecovered = 0
  nTreasure1 = 0
  bTreasureCarried = False
  Do While (nTreasure1 < nTreasures) And (Not bTreasureCarried)
    If nTreasureRoom(nTreasure1) < 0 Then
      bTreasureCarried = True
    Else
      nTreasure1 = nTreasure1 + 1
    End If
  Loop
  If bTreasureCarried Then
    If Int(CDbl(2 * nRooms) * Rnd) = 0 Then
      nRoom2 = 0
      Do While nRoom2 <= 0
        nDimension1 = 0
        Do While nDimension1 < nDimensions
          nCoordinate(nDimension1) = Int(CDbl(nWidth(nDimension1)) * Rnd)
          nDimension1 = nDimension1 + 1
        Loop
        nRoom2 = nCell(nCoordinate(0), nCoordinate(1), nCoordinate(2), nCoordinate(3))
        If nRoom1 = nRoom2 Then
          nRoom2 = -1
        End If
      Loop
      nTreasure1 = 0
      Do While nTreasure1 < nTreasures
        If nTreasureRoom(nTreasure1) < 0 Then
          nTreasureRoom(nTreasure1) = nRoom2
        End If
        nTreasure1 = nTreasure1 + 1
      Loop
      bTreasureCarried = False
      Response = MsgBox("As he leaves,  he says,  'Arggh!  I'll hide me booty better this time.'", vbOKOnly, "A pirate jumps out of the shadows and takes your treasure.")
    End If
  End If
  nTreasure1 = 0
  nTreasure2 = 0
  strTreasures = ""
  lstInventory.Clear
  nTreasuresCarried = 0
  Do While nTreasure1 < nTreasures
    If nTreasureRoom(nTreasure1) = 0 Then
      nTreasuresRecovered = nTreasuresRecovered + 1
      If nRoom1 = 0 Then
        strTreasures = strTreasures & "  There's " & strTreasure(nTreasure1) & " here. "
      End If
    Else
      If nTreasureRoom(nTreasure1) = nRoom1 Then
        strTreasures = strTreasures & "  There's " & strTreasure(nTreasure1) & " here. "
        If nGuardRoom(nTreasure1) = nRoom1 Then
          strLine = Left(strGuard(nTreasure1), 1)
          If ((strLine = "a") Or (strLine = "e") Or (strLine = "i") Or (strLine = "o") Or (strLine = "u")) Then
            strTreasures = strTreasures & "  It's guarded by an " & strGuard(nTreasure1) & "."
          Else
            strTreasures = strTreasures & "  It's guarded by a " & strGuard(nTreasure1) & "."
          End If
        End If
      Else
        If nTreasureRoom(nTreasure1) = -1 Then
          bTreasureCarried = True
          nTreasuresCarried = nTreasuresCarried + 1
          nTreasure2 = nTreasure2 + 1
          lstInventory.AddItem strTreasure(nTreasure1)
        End If
      End If
    End If
    If nWeaponRoom(nTreasure1) = nRoom1 Then
      strLine = Left(strWeapon(nTreasure1), 1)
      If ((strLine = "a") Or (strLine = "e") Or (strLine = "i") Or (strLine = "o") Or (strLine = "u")) Then
        strTreasures = strTreasures & " There's an " & strWeapon(nTreasure1) & " here."
      Else
        strTreasures = strTreasures & " There's a " & strWeapon(nTreasure1) & " here."
      End If
    Else
      If nWeaponRoom(nTreasure1) = -1 Then
        nTreasure2 = nTreasure2 + 1
        lstInventory.AddItem strWeapon(nTreasure1)
      End If
    End If
    nTreasure1 = nTreasure1 + 1
  Loop
  txtTreasuresRecovered.Text = nTreasuresRecovered
  txtNumTreasures.Text = nTreasures
  If (Not bVisited(nRoom1)) Then
    nVisited = nVisited + 1
    bVisited(nRoom1) = True
  End If
  txtRoomsVisited.Text = nVisited
  txtNumRooms.Text = nRooms
  dblScore = 25# * CDbl(nVisited) / CDbl(nRooms) + 75# * CDbl(nTreasuresRecovered) / CDbl(nTreasures) + 45# * CDbl(nTreasuresCarried) / CDbl(nTreasures)
  If nVisited > 5 * nRooms Then
    dblScore = dblScore - CDbl(nVisited) / (5# * CDbl(nRooms))
    If dblScore < 0# Then
      dblScore = 0#
    End If
  End If
  nScore = Int(dblScore)
  txtScore.Text = nScore
  txtMaxScore.Text = 100
  txtLocation.Text = strDescription(nRoom1) & strTreasures
  If strTreasures = "" Then
    pbCarry.Enabled = False
  Else
    pbCarry.Enabled = True
  End If
  If ((nRoom1 = 0) And (bTreasureCarried)) Then
    pbDrop.Enabled = True
  Else
    pbDrop.Enabled = False
  End If
  If bConnected(nRoom1, 0, 0) Then
    pbNorth.Enabled = True
  Else
    pbNorth.Enabled = False
  End If
  If bConnected(nRoom1, 0, 1) Then
    pbSouth.Enabled = True
  Else
    pbSouth.Enabled = False
  End If
  If bConnected(nRoom1, 1, 0) Then
    pbEast.Enabled = True
  Else
    pbEast.Enabled = False
  End If
  If bConnected(nRoom1, 1, 1) Then
    pbWest.Enabled = True
  Else
    pbWest.Enabled = False
  End If
  If bConnected(nRoom1, 2, 0) Then
    pbUp.Enabled = True
  Else
    pbUp.Enabled = False
  End If
  If bConnected(nRoom1, 2, 1) Then
    pbDown.Enabled = True
  Else
    pbDown.Enabled = False
  End If
  If bConnected(nRoom1, 3, 0) Then
    pbForward.Enabled = True
  Else
    pbForward.Enabled = False
  End If
  If bConnected(nRoom1, 3, 1) Then
    pbBackward.Enabled = True
  Else
    pbBackward.Enabled = False
  End If
End Sub

Private Sub Form_Load()
  Dim strLine As String
  Dim strProgramPath As String
Dim LocText As String
Dim filz As String
Dim desc2 As String

    LocText = LCase(App.Path)
    If Right$(App.Path, 1) <> "\" Then LocText = LocText + "\"  'handles the root
    filz = LocText + "treasure.dat"
    desc2 = LocText + "descript.dat"

  MousePointer = 11
  strWayOut = ""
  Randomize nGame
  strProgramPath = GetProgramPath()
  Open filz For Input As 1
  Input #1, nTreasures
  ReDim strTreasure(nTreasures)
  ReDim strGuard(nTreasures)
  ReDim nGuardRoom(nTreasures)
  ReDim nTreasureRoom(nTreasures)
  ReDim nWeaponRoom(nTreasures)
  ReDim strWeapon(nTreasures)
  nTreasure1 = 0
  Do While nTreasure1 < nTreasures
    Line Input #1, strTreasure(nTreasure1)
    Line Input #1, strGuard(nTreasure1)
    Line Input #1, strWeapon(nTreasure1)
    nTreasure1 = nTreasure1 + 1
  Loop
  Close 1
  Open desc2 For Input As 1
  Input #1, nRooms
  ReDim strDescription(nRooms)
  ReDim bVisited(nRooms)
  ReDim bConnected(nRooms, 4, 2)
  ReDim bRoomUsed(nRooms)
  nRoom1 = 0
  Do While nRoom1 < nRooms
    Line Input #1, strLine
    strDescription(nRoom1) = "You're in " & strLine
    bVisited(nRoom1) = False
    nDimension1 = 0
    Do While nDimension1 < nDimensions
      nDirection1 = 0
      Do While nDirection1 < 2
        bConnected(nRoom1, nDimension1, nDirection1) = False
        nDirection1 = nDirection1 + 1
      Loop
      nDimension1 = nDimension1 + 1
    Loop
    nRoom1 = nRoom1 + 1
  Loop
  Close 1
  nMaxWidth = 1 + Int(CDbl(2 * nRooms) ^ (1# / CDbl(nDimensions)))
  bWidthsFound = False
  Do While Not bWidthsFound
    nDimension1 = 0
    nVolume = 1
    Do While nDimension1 < nDimensions
      nWidth(nDimension1) = nMaxWidth - Int(2# * Rnd)
      nVolume = nVolume * nWidth(nDimension1)
      nDimension1 = nDimension1 + 1
    Loop
    If nVolume > nRooms Then
      bWidthsFound = True
    End If
  Loop
  nDimension1 = nDimensions
  Do While nDimension1 < 4
    nWidth(nDimension1) = 1
    nDimension1 = nDimension1 + 1
  Loop
  nRoom1 = 1
  Do While nRoom1 < nRooms
    nRoom2 = 1 + Int(CDbl(nRooms - 1) * Rnd)
    strLine = strDescription(nRoom1)
    strDescription(nRoom1) = strDescription(nRoom2)
    strDescription(nRoom2) = strLine
    nRoom1 = nRoom1 + 1
  Loop
  nXCoordinate = 0
  Do While nXCoordinate < nWidth(0)
    nYCoordinate = 0
    Do While nYCoordinate < nWidth(1)
      nZCoordinate = 0
      Do While nZCoordinate < nWidth(2)
        nTCoordinate = 0
        Do While nTCoordinate < nWidth(3)
          nCell(nXCoordinate, nYCoordinate, nZCoordinate, nTCoordinate) = -1
          nTCoordinate = nTCoordinate + 1
        Loop
        nZCoordinate = nZCoordinate + 1
      Loop
      nYCoordinate = nYCoordinate + 1
    Loop
    nXCoordinate = nXCoordinate + 1
  Loop
  nXCoordinate = 0
  nYCoordinate = 0
  nZCoordinate = 0
  nTCoordinate = 0
  nCoordinate(0) = nXCoordinate
  nCoordinate(1) = nYCoordinate
  nCoordinate(2) = nZCoordinate
  nCoordinate(3) = nTCoordinate
  nRoom1 = 0
  nRoom2 = 0
  nCell(0, 0, 0, 0) = 0
  Do While nRoom1 < (nRooms - 1)
    bDirectionFound = False
    Do While Not bDirectionFound
      nDirection1 = Int(2# * Rnd)
      nDimension1 = Int(CDbl(nDimensions) * Rnd)
      If bEuclidean Then
        If nCoordinate(nDimension1) + 2 * nDirection1 - 1 >= 0 Then
          If nCoordinate(nDimension1) + 2 * nDirection1 - 1 < nWidth(nDimension1) Then
            bDirectionFound = True
          End If
        End If
      Else
        bDirectionFound = True
      End If