game.frm

treasure游戏源程序

VERSION 5.00
Begin VB.Form frmGame 
   ClientHeight    =   4155
   ClientLeft      =   -75
   ClientTop       =   1755
   ClientWidth     =   7485
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4155
   ScaleWidth      =   7485
   Visible         =   0   'False
   WindowState     =   2  'Maximized
   Begin VB.CommandButton pbDrop 
      Caption         =   "Drop"
      Height          =   300
      Left            =   6048
      TabIndex        =   30
      Top             =   3456
      Width           =   972
   End
   Begin VB.CommandButton pbWayOut 
      Caption         =   "WayOut"
      Height          =   300
      Left            =   4704
      TabIndex        =   29
      Top             =   3648
      Width           =   972
   End
   Begin VB.CommandButton pbCarry 
      Caption         =   "Carry"
      Height          =   300
      Left            =   3456
      TabIndex        =   28
      Top             =   3456
      Width           =   972
   End
   Begin VB.CommandButton pbBackward 
      Caption         =   "Backward"
      Height          =   204
      Left            =   5760
      TabIndex        =   27
      Top             =   2976
      Width           =   972
   End
   Begin VB.CommandButton pbDown 
      Caption         =   "Down"
      Height          =   204
      Left            =   3648
      TabIndex        =   26
      Top             =   2976
      Width           =   972
   End
   Begin VB.CommandButton pbSouth 
      Caption         =   "Sourth"
      Height          =   204
      Left            =   4704
      TabIndex        =   25
      Top             =   2784
      Width           =   972
   End
   Begin VB.CommandButton pbEast 
      Caption         =   "East"
      Height          =   204
      Left            =   5760
      TabIndex        =   24
      Top             =   2592
      Width           =   972
   End
   Begin VB.CommandButton pbWest 
      Caption         =   "West"
      Height          =   204
      Left            =   3648
      TabIndex        =   23
      Top             =   2592
      Width           =   972
   End
   Begin VB.CommandButton pbUp 
      Caption         =   "Up"
      Height          =   204
      Left            =   5760
      TabIndex        =   22
      Top             =   2208
      Width           =   972
   End
   Begin VB.CommandButton pbNorth 
      Caption         =   "North"
      Height          =   204
      Left            =   4704
      TabIndex        =   21
      Top             =   2400
      Width           =   972
   End
   Begin VB.CommandButton pbForward 
      Caption         =   "Forward"
      Height          =   204
      Left            =   3648
      TabIndex        =   20
      Top             =   2208
      Width           =   972
   End
   Begin VB.TextBox txtMaxScore 
      Enabled         =   0   'False
      Height          =   288
      Left            =   6240
      TabIndex        =   17
      Text            =   "100"
      Top             =   1632
      Width           =   588
   End
   Begin VB.TextBox txtNumTreasures 
      Enabled         =   0   'False
      Height          =   288
      Left            =   6240
      TabIndex        =   16
      Text            =   "15"
      Top             =   1248
      Width           =   588
   End
   Begin VB.TextBox txtNumRooms 
      Enabled         =   0   'False
      Height          =   288
      Left            =   6240
      TabIndex        =   15
      Text            =   "100"
      Top             =   864
      Width           =   588
   End
   Begin VB.TextBox txtScore 
      Enabled         =   0   'False
      Height          =   288
      Left            =   5184
      TabIndex        =   13
      Text            =   "0"
      Top             =   1632
      Width           =   588
   End
   Begin VB.TextBox txtTreasuresRecovered 
      Enabled         =   0   'False
      Height          =   288
      Left            =   5184
      TabIndex        =   12
      Text            =   "0"
      Top             =   1248
      Width           =   588
   End
   Begin VB.TextBox txtRoomsVisited 
      Enabled         =   0   'False
      Height          =   288
      Left            =   5184
      TabIndex        =   11
      Text            =   "1"
      Top             =   864
      Width           =   588
   End
   Begin VB.TextBox txtMoves 
      Enabled         =   0   'False
      Height          =   288
      Left            =   5184
      TabIndex        =   10
      Text            =   "0"
      Top             =   480
      Width           =   588
   End
   Begin VB.CommandButton pbAbout 
      Caption         =   "About"
      Height          =   252
      Left            =   6144
      TabIndex        =   5
      Top             =   288
      Width           =   972
   End
   Begin VB.ListBox lstInventory 
      Height          =   1035
      Left            =   120
      TabIndex        =   3
      Top             =   2760
      Width           =   2652
   End
   Begin VB.TextBox txtLocation 
      Height          =   1452
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   840
      Width           =   2652
   End
   Begin VB.Label Label10 
      Caption         =   "of"
      Height          =   204
      Left            =   5952
      TabIndex        =   19
      Top             =   1728
      Width           =   204
   End
   Begin VB.Label Label9 
      Caption         =   "of"
      Height          =   204
      Left            =   5952
      TabIndex        =   18
      Top             =   1344
      Width           =   204
   End
   Begin VB.Label Label8 
      Caption         =   "of"
      Height          =   204
      Left            =   5952
      TabIndex        =   14
      Top             =   960
      Width           =   204
   End
   Begin VB.Label Label7 
      Alignment       =   1  'Right Justify
      Caption         =   "Score"
      Height          =   180
      Left            =   4416
      TabIndex        =   9
      Top             =   1728
      Width           =   612
   End
   Begin VB.Label Label6 
      Alignment       =   1  'Right Justify
      Caption         =   "Treasures recovered"
      Height          =   180
      Left            =   3360
      TabIndex        =   8
      Top             =   1344
      Width           =   1668
   End
   Begin VB.Label Label5 
      Alignment       =   1  'Right Justify
      Caption         =   "Rooms visited"
      Height          =   180
      Left            =   3840
      TabIndex        =   7
      Top             =   960
      Width           =   1188
   End
   Begin VB.Label Label4 
      Alignment       =   1  'Right Justify
      Caption         =   "Moves"
      Height          =   180
      Left            =   4416
      TabIndex        =   6
      Top             =   600
      Width           =   636
   End
   Begin VB.Label Label3 
      Caption         =   "Inventory"
      Height          =   252
      Left            =   120
      TabIndex        =   4
      Top             =   2400
      Width           =   2052
   End
   Begin VB.Label Label2 
      Caption         =   "Location"
      Height          =   252
      Left            =   120
      TabIndex        =   2
      Top             =   480
      Width           =   732
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "Visit all of the rooms and return all of the treasures to the entrance."
      Height          =   252
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   4812
   End
End
Attribute VB_Name = "frmGame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Public bEuclidean As Boolean
Public nDimensions As Long
Public nGame As Long

Private bConnected() As Boolean
Private bDirectionFound As Boolean
Private bDirectionUsed(255, 4, 2) As Boolean
Private bInitialized As Boolean
Private bPathFound As Boolean
Private bRoomUsed() As Boolean
Private bTreasureCarried As Boolean
Private bVisited() As Boolean
Private bWeaponRoomFound As Boolean
Private bWidthsFound As Boolean
Private dblScore As Double
Private nCell(15, 15, 15, 15) As Long
Private nCoordinate(4) As Long
Private nCoordinateNext(4) As Long
Private nDimension1 As Long
Private nDimension2 As Long
Private nDirection1 As Long
Private nDirection2 As Long
Private nDirectionsPossible As Long
Private nDirectionsUsed(255) As Long
Private nGuardRoom() As Long
Private nMaxWidth As Long
Private nMoves As Long
Private nRoom1 As Long
Private nRoom2 As Long
Private nRooms As Long
Private nScore As Long
Private nTCoordinate As Long
Private nTreasure1 As Long
Private nTreasure2 As Long
Private nTreasureRoom() As Long
Private nTreasures As Long
Private nTreasuresCarried As Long
Private nTreasuresRecovered As Long
Private nTrial As Long
Private nVisited As Long
Private nVolume As Long
Private nWayOutDimension(255) As Long
Private nWayOutDirection(255) As Long
Private nWayOutHead As Long
Private nWayOutPtr As Long
Private nWeaponRoom() As Long
Private nWidth(4) As Long
Private nXCoordinate As Long
Private nYCoordinate As Long
Private nZCoordinate As Long
Private strDescription() As String
Private strGuard() As String
Private strLine As String
Private strTreasure() As String
Private strTreasures As String
Private strWayOut As String
Private strWeapon() As String

Private Declare Function GetModuleFileName Lib "KERNEL32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal strFileName As String, ByVal nFileNameLength As Long) As Long

Private Function GetProgramPath() As String
  Dim nCharIndex As Long
  Dim nFileNameLength As Long
  Dim nLastSlash As Long
  Dim nModuleHandle As Long
  Dim strFileName As String
  Dim strResult As String
  strResult = "C:\VB\TREASURE\" 'For development
  nModuleHandle = 0
  nFileNameLength = 256
  strFileName = String(nFileNameLength, 0)
  nFileNameLength = GetModuleFileName(nModuleHandle, strFileName, nFileNameLength)
  If nFileNameLength > 0 Then
    nLastSlash = 0
    For nCharIndex = 1 To nFileNameLength
      If Mid(strFileName, nCharIndex, 1) = "\" Then
        nLastSlash = nCharIndex