home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / autose1g / frmselec.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-06-24  |  7.9 KB  |  262 lines
  1. VERSION 5.00
  2. Object = "{D2D9B7C1-7650-11D1-9481-00A0247B7657}#1.0#0"; "ZLIBOCX2.DLL"
  3. Begin VB.Form frmSelectGame 
  4.    BackColor       =   &H00000000&
  5.    BorderStyle     =   0  'None
  6.    Caption         =   "Form1"
  7.    ClientHeight    =   5835
  8.    ClientLeft      =   555
  9.    ClientTop       =   1275
  10.    ClientWidth     =   9045
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    PaletteMode     =   1  'UseZOrder
  15.    ScaleHeight     =   5835
  16.    ScaleWidth      =   9045
  17.    ShowInTaskbar   =   0   'False
  18.    Begin ZLIBOCX2LibCtl.zlibIF zlibUnzipper 
  19.       Height          =   330
  20.       Left            =   1035
  21.       OleObjectBlob   =   "frmSelectGame.frx":0000
  22.       TabIndex        =   10
  23.       Top             =   4680
  24.       Visible         =   0   'False
  25.       Width           =   1815
  26.    End
  27.    Begin VB.CommandButton cmdCancel 
  28.       Caption         =   "&Cancel"
  29.       Height          =   330
  30.       Left            =   4185
  31.       TabIndex        =   9
  32.       Top             =   3900
  33.       Width           =   1200
  34.    End
  35.    Begin VB.CommandButton cmdStart 
  36.       Caption         =   "&OK"
  37.       Height          =   330
  38.       Left            =   2790
  39.       TabIndex        =   8
  40.       Top             =   3900
  41.       Width           =   1200
  42.    End
  43.    Begin VB.DirListBox dirDir1 
  44.       BackColor       =   &H00000000&
  45.       BeginProperty Font 
  46.          Name            =   "MS Sans Serif"
  47.          Size            =   8.25
  48.          Charset         =   0
  49.          Weight          =   700
  50.          Underline       =   0   'False
  51.          Italic          =   0   'False
  52.          Strikethrough   =   0   'False
  53.       EndProperty
  54.       ForeColor       =   &H0000FF00&
  55.       Height          =   1890
  56.       Left            =   3915
  57.       TabIndex        =   3
  58.       Top             =   1305
  59.       Width           =   2625
  60.    End
  61.    Begin VB.FileListBox filFile1 
  62.       BackColor       =   &H00000000&
  63.       BeginProperty Font 
  64.          Name            =   "MS Sans Serif"
  65.          Size            =   8.25
  66.          Charset         =   0
  67.          Weight          =   700
  68.          Underline       =   0   'False
  69.          Italic          =   0   'False
  70.          Strikethrough   =   0   'False
  71.       EndProperty
  72.       ForeColor       =   &H0000FF00&
  73.       Height          =   2235
  74.       Left            =   1800
  75.       TabIndex        =   2
  76.       Top             =   1305
  77.       Width           =   1965
  78.    End
  79.    Begin VB.DriveListBox drvDrive1 
  80.       BackColor       =   &H00000000&
  81.       BeginProperty Font 
  82.          Name            =   "MS Sans Serif"
  83.          Size            =   8.25
  84.          Charset         =   0
  85.          Weight          =   700
  86.          Underline       =   0   'False
  87.          Italic          =   0   'False
  88.          Strikethrough   =   0   'False
  89.       EndProperty
  90.       ForeColor       =   &H0000FF00&
  91.       Height          =   315
  92.       Left            =   3915
  93.       TabIndex        =   1
  94.       Top             =   3240
  95.       Width           =   2655
  96.    End
  97.    Begin VB.TextBox txtFileName 
  98.       BackColor       =   &H00000000&
  99.       ForeColor       =   &H0000FF00&
  100.       Height          =   300
  101.       Left            =   1800
  102.       TabIndex        =   0
  103.       Top             =   945
  104.       Width           =   1935
  105.    End
  106.    Begin VB.Label Label1 
  107.       BackColor       =   &H00000000&
  108.       Caption         =   "LOAD GAME"
  109.       BeginProperty Font 
  110.          Name            =   "MS Sans Serif"
  111.          Size            =   13.5
  112.          Charset         =   0
  113.          Weight          =   700
  114.          Underline       =   0   'False
  115.          Italic          =   0   'False
  116.          Strikethrough   =   0   'False
  117.       EndProperty
  118.       ForeColor       =   &H0000FF00&
  119.       Height          =   360
  120.       Left            =   3300
  121.       TabIndex        =   7
  122.       Top             =   135
  123.       Width           =   1950
  124.    End
  125.    Begin VB.Label lblDirName2 
  126.       BackColor       =   &H00000000&
  127.       Caption         =   "Directory:"
  128.       BeginProperty Font 
  129.          Name            =   "MS Sans Serif"
  130.          Size            =   9.75
  131.          Charset         =   0
  132.          Weight          =   700
  133.          Underline       =   0   'False
  134.          Italic          =   0   'False
  135.          Strikethrough   =   0   'False
  136.       EndProperty
  137.       ForeColor       =   &H0000FF00&
  138.       Height          =   225
  139.       Left            =   3960
  140.       TabIndex        =   6
  141.       Top             =   675
  142.       Width           =   1095
  143.    End
  144.    Begin VB.Label lblDirName 
  145.       BackColor       =   &H00000000&
  146.       ForeColor       =   &H0000FF00&
  147.       Height          =   285
  148.       Left            =   3945
  149.       TabIndex        =   5
  150.       Top             =   945
  151.       Width           =   3960
  152.    End
  153.    Begin VB.Label lblFileName 
  154.       BackColor       =   &H00000000&
  155.       Caption         =   "File Name:"
  156.       BeginProperty Font 
  157.          Name            =   "MS Sans Serif"
  158.          Size            =   9.75
  159.          Charset         =   0
  160.          Weight          =   700
  161.          Underline       =   0   'False
  162.          Italic          =   0   'False
  163.          Strikethrough   =   0   'False
  164.       EndProperty
  165.       ForeColor       =   &H0000FF00&
  166.       Height          =   225
  167.       Left            =   1800
  168.       TabIndex        =   4
  169.       Top             =   675
  170.       Width           =   1290
  171.    End
  172. Attribute VB_Name = "frmSelectGame"
  173. Attribute VB_GlobalNameSpace = False
  174. Attribute VB_Creatable = False
  175. Attribute VB_PredeclaredId = True
  176. Attribute VB_Exposed = False
  177. Option Explicit
  178. Private Sub cmdCancel_Click()
  179. 'return to cover form - prevent game crashing
  180. 'when there is no game to load
  181. LoadCancelled = True
  182. Unload Me
  183. End Sub
  184. Private Sub cmdStart_Click()
  185. If txtFileName = "" Then
  186.     'no game selected
  187.     PlaySoundEffect "Quiet"
  188.     MsgBox "Please select a game to load"
  189.     Exit Sub
  190.     'decompress selected saved game file
  191.     Dim Path As String
  192.     Path = dirDir1.Path
  193.     If Right(Path, 1) <> "\" Then
  194.         Path = Path + "\"
  195.     End If
  196.        
  197.     zlibUnzipper.InputFileName = Path + txtFileName.Text
  198.     zlibUnzipper.OutputFileName = App.Path + "\gameinfo.txt"
  199.     zlibUnzipper.Decompress
  200.     GameNumber = Val(Mid$(txtFileName.Text, 2, 1))
  201.     Unload Me  '***program returns to frmCover to read big file, then loads frmGameScreen
  202. End If
  203. End Sub
  204. Private Sub dirDir1_Change()
  205. 'update file list box with new directory
  206. filFile1.Path = dirDir1.Path
  207. 'update dir label
  208. lblDirName.Caption = dirDir1.Path
  209. End Sub
  210. Private Sub drvDrive1_Change()
  211. On Error GoTo DriveError
  212. 'change path of dir list box to new drive
  213. dirDir1.Path = drvDrive1.Drive
  214. Exit Sub
  215. DriveError:
  216. PlaySoundEffect "Warning"
  217. MsgBox "Drive Error", , " "
  218. 'restore the original drive
  219. drvDrive1.Drive = dirDir1.Path
  220. Exit Sub
  221. End Sub
  222. Private Sub filFile1_Click()
  223. txtFileName.Text = filFile1.Filename
  224. End Sub
  225. Private Sub filFile1_DblClick()
  226. txtFileName.Text = filFile1.Filename
  227. cmdStart_Click
  228. End Sub
  229. Private Sub Form_Activate()
  230. Randomize
  231. 'draw white stars on the screen
  232.     Dim a, X, Y
  233.     For a = 1 To 400
  234.         X = Int(Rnd * Me.ScaleWidth)
  235.         Y = Int(Rnd * Me.ScaleHeight)
  236.         Me.PSet (X, Y), vbWhite
  237.     Next a
  238.     'draw dark grey stars
  239.     Dim grey
  240.     grey = &H808080
  241.     For a = 1 To 400
  242.         X = Int(Rnd * Me.ScaleWidth)
  243.         Y = Int(Rnd * Me.ScaleHeight)
  244.         Me.PSet (X, Y), grey
  245.     Next a
  246.     'draw blue stars
  247.     Dim blue
  248.     blue = &H800000
  249.     For a = 1 To 200
  250.        X = Int(Rnd * Me.ScaleWidth)
  251.        Y = Int(Rnd * Me.ScaleHeight)
  252.        Me.PSet (X, Y), blue
  253.     Next a
  254. End Sub
  255. Private Sub Form_Load()
  256. 'set up drives, set to look only for
  257. 'compressed game files ending in .zlb
  258. drvDrive1.Drive = App.Path
  259. dirDir1.Path = App.Path
  260. filFile1.Pattern = "*.zlb"
  261. End Sub
  262.