We just released a Feb. 5 '89 prototype of DuckTales for the NES!
If you'd like to support our preservation efforts (and this wasn't cheap), please consider donating or supporting us on Patreon. Thank you!
If you'd like to support our preservation efforts (and this wasn't cheap), please consider donating or supporting us on Patreon. Thank you!
Apollo 18: The Moon Missions/Uncompiled Code
Jump to navigation
Jump to search
This is a sub-page of Apollo 18: The Moon Missions.
\DOCKING
DOCKING2.FRM
VERSION 4.00
Begin VB.Form docking
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "Docking with the Lunar Module"
ClientHeight = 7140
ClientLeft = 1785
ClientTop = 1575
ClientWidth = 9600
Height = 7545
Left = 1725
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "DOCKING2.frx":0000
ScaleHeight = 7140
ScaleWidth = 9600
Top = 1230
Visible = 0 'False
Width = 9720
Begin VB.Timer Timer3
Interval = 50
Left = 150
Top = 6300
End
Begin VB.VScrollBar VScroll1
Height = 870
LargeChange = 10
Left = 6975
Max = 100
TabIndex = 31
Top = 6195
Width = 270
End
Begin VB.TextBox Text6
Appearance = 0 'Flat
BackColor = &H00000000&
ForeColor = &H0000FF00&
Height = 300
Left = 5910
TabIndex = 27
Text = "Text6"
Top = 1080
Visible = 0 'False
Width = 1815
End
Begin VB.TextBox Text5
Appearance = 0 'Flat
BackColor = &H00000000&
ForeColor = &H0000FF00&
Height = 300
Left = 5835
TabIndex = 26
Text = "Text5"
Top = 735
Visible = 0 'False
Width = 1980
End
Begin VB.TextBox Text4
BackColor = &H00000000&
BorderStyle = 0 'None
ForeColor = &H0000FF00&
Height = 315
Left = 3270
TabIndex = 25
Text = "Text4"
Top = 1125
Visible = 0 'False
Width = 1965
End
Begin VB.TextBox Text3
Appearance = 0 'Flat
BackColor = &H00000000&
BorderStyle = 0 'None
ForeColor = &H0000FF00&
Height = 315
Left = 3270
TabIndex = 24
Text = "Text3"
Top = 750
Visible = 0 'False
Width = 2220
End
Begin VB.TextBox Text2
Appearance = 0 'Flat
BackColor = &H00000000&
ForeColor = &H0000FF00&
Height = 300
Left = 1065
TabIndex = 23
Text = "Text2"
Top = 1110
Visible = 0 'False
Width = 2010
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
BackColor = &H00000000&
ForeColor = &H0000FF00&
Height = 300
Left = 1080
TabIndex = 22
Text = "Text1"
Top = 690
Visible = 0 'False
Width = 2070
End
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 1000
Left = 2835
Top = 7770
End
Begin VB.CommandButton Command2
BackColor = &H00C0C0C0&
Caption = "REV"
Height = 375
Index = 1
Left = 5295
TabIndex = 21
Top = 6555
Visible = 0 'False
Width = 615
End
Begin VB.CommandButton Command2
Caption = "FWD"
Height = 375
Index = 0
Left = 4110
TabIndex = 20
Top = 6555
Visible = 0 'False
Width = 615
End
Begin VB.CommandButton starlock
Caption = "LOCK"
Height = 585
Left = 8880
TabIndex = 19
Top = 6345
Visible = 0 'False
Width = 600
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 9690
TabIndex = 18
Top = 6690
Width = 1215
End
Begin VB.PictureBox PicSave
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 8550
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 16
Top = 7305
Width = 1755
End
Begin VB.PictureBox PicWork
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 6705
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 15
Top = 7335
Width = 1755
End
Begin VB.PictureBox PicMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 5085
Picture = "DOCKING2.frx":4B444
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 14
Top = 7350
Width = 1500
End
Begin VB.PictureBox PicImage
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1410
Left = 3420
Picture = "DOCKING2.frx":4DE08
ScaleHeight = 94
ScaleMode = 3 'Pixel
ScaleWidth = 99
TabIndex = 13
Top = 7365
Width = 1485
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 5
Left = 10110
Picture = "DOCKING2.frx":50704
ScaleHeight = 95
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 9
Top = 2385
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 4
Left = 10290
Picture = "DOCKING2.frx":537D0
ScaleHeight = 95
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 8
Top = 1635
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 3
Left = 10335
Picture = "DOCKING2.frx":5689C
ScaleHeight = 95
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 7
Top = 1215
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 2
Left = 9825
Picture = "DOCKING2.frx":59968
ScaleHeight = 95
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 6
Top = 555
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 1
Left = 9975
Picture = "DOCKING2.frx":5CA34
ScaleHeight = 95
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 5
Top = 135
Width = 1755
End
Begin VB.PictureBox picWorkBG
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00400000&
ForeColor = &H80000008&
Height = 4860
Left = 4860
ScaleHeight = 322
ScaleMode = 3 'Pixel
ScaleWidth = 635
TabIndex = 4
Top = 7305
Width = 9555
End
Begin VB.PictureBox picBGoriginal
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 9030
Left = -9360
Picture = "DOCKING2.frx":5FB00
ScaleHeight = 600
ScaleMode = 3 'Pixel
ScaleWidth = 800
TabIndex = 1
Top = 7350
Width = 12030
End
Begin VB.PictureBox picPitMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 9780
Picture = "DOCKING2.frx":D5244
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 3
Top = 4020
Width = 9600
End
Begin VB.PictureBox picPitSprite
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 10005
Picture = "DOCKING2.frx":10BA08
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 2
Top = 510
Width = 9600
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 55
Left = 9960
Top = 5865
End
Begin VB.PictureBox Picture4
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 7200
Left = 0
Picture = "DOCKING2.frx":1421CC
ScaleHeight = 480
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 0
Top = -15
Width = 9600
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 0
Left = 4110
Picture = "DOCKING2.frx":18D610
ScaleHeight = 95
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 10
Top = 5520
Width = 1755
Begin VB.Image auxjoy
Height = 300
Index = 0
Left = 720
Top = 225
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 1
Left = 1035
Top = 555
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 2
Left = 720
Top = 870
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 3
Left = 390
Top = 555
Width = 300
End
End
Begin VB.PictureBox picBackground
Appearance = 0 'Flat
BackColor = &H00000000&
BorderStyle = 0 'None
DragIcon = "DOCKING2.frx":1906DC
ForeColor = &H80000008&
Height = 5190
Left = 0
Picture = "DOCKING2.frx":1909E6
ScaleHeight = 346
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 17
Top = 150
Width = 9600
Begin VB.TextBox splattextbox
Alignment = 2 'Center
BackColor = &H00000000&
ForeColor = &H000000FF&
Height = 300
Left = 1830
TabIndex = 30
Top = 165
Visible = 0 'False
Width = 6000
End
Begin VB.Label labeltime
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "labeltime"
ForeColor = &H000000FF&
Height = 285
Left = 7710
TabIndex = 29
Top = 600
Visible = 0 'False
Width = 870
End
End
Begin VB.Image dockThrust
Height = 330
Index = 2
Left = 7515
Picture = "DOCKING2.frx":1C71AA
Top = 6540
Width = 195
End
Begin VB.Image dockThrust
Height = 330
Index = 1
Left = 7710
Picture = "DOCKING2.frx":1C774E
Top = 6540
Width = 195
End
Begin VB.Image dockThrust
Height = 330
Index = 0
Left = 7965
Picture = "DOCKING2.frx":1C7CF2
Top = 6540
Width = 195
End
Begin VB.Label Label1
Caption = "Label1"
Height = 465
Left = 2925
TabIndex = 28
Top = 675
Width = 4215
End
Begin VB.Image Image1
Height = 585
Index = 2
Left = 8175
Picture = "DOCKING2.frx":1C8296
Top = 5535
Visible = 0 'False
Width = 870
End
Begin VB.Image Image1
Height = 570
Index = 1
Left = 7305
Picture = "DOCKING2.frx":1C8C72
Top = 5535
Visible = 0 'False
Width = 870
End
Begin VB.Image Image1
Height = 585
Index = 0
Left = 6435
Picture = "DOCKING2.frx":1C9616
Top = 5550
Visible = 0 'False
Width = 870
End
Begin VB.Label distance
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1140
TabIndex = 12
Top = 6435
Width = 600
End
Begin VB.Label closerate
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1140
TabIndex = 11
Top = 5790
Width = 600
End
End
End
Attribute VB_Name = "docking"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim WaitingToLeave As Boolean
Dim IAMTurnedAround As Boolean
Dim Backward As Integer
' Constant for joystick
Dim JoyInfo As tJoyInfo
Dim RangeWidth As Integer
Dim RangeHeight As Integer
Dim ScrollSpeed As Integer ' The ship's current turning speed
Rem
Dim topj, leftj, rightj, bottomj, centx, centy, leftX, rightX, topY, bottomY As Long
' Constants for mouse action.
Const NO_BUTTON = 0
Const LBUTTON = 1
Const RBUTTON = 2
' Constants for WaveMix channels
Const BACKGROUND = 0
Const MISSION_CONTROL = 1
Const BUTTONS = 2
Const EFFECTS = 3
Const WARNINGS = 4
Const MCSECOND = 5
Const Gravity = 13 'lunar gravity
Const LUPE = 1
Const NO_LUPE = 0
Const MOONHEIGHT = 1200
' Boolean that indicates if mouse button has been pressed down.
Dim MouseButtonDown As Integer
'-----------------------------------------------------
' BITDEMO1.FRM
' This program demonstrates some of the methods used
' to display bitmaps and sprites.
'-----------------------------------------------------
' The number of pixels to offset the sprite
' each time it is moved.
Const INCREMENT = 1
' Constants for Raster Operations used by BitBlt function.
Const SRCAND = &H8800C6 ' dest = source AND dest
Const SRCCOPY = &HCC0020 ' dest = source
Const SRCPAINT = &HEE0086 ' dest = source OR dest
'Dim Ship(1 To 4) As tShip
' The x and y coordinates for the Sprite
Dim SpriteX As Integer
Dim SpriteY As Integer
' The x and y coordinates for the upper left corner
' of the large bitmap (picBMP).
Dim BackgroundX As Integer
Dim BackgroundY As Integer
' The width and height of the work area bitmap (picWork).
Dim WorkWidth As Integer
Dim WorkHeight As Integer
Dim ldist As Integer
Dim zcomponent As Integer
Dim S4B(51) As String
Dim s4bmask(51) As String
Dim csmDock(51) As String
Dim csmMask(51) As String
Dim DistDrop As Integer
Dim DropTime As Integer
Dim LmAlt As Integer
Dim dirtLevel As Integer
Dim OlddirtLevel As Integer
Dim AltiMeter As Integer
Dim AltiMeterReading As Integer
Dim FwdVel As Single
Dim LatVel As Single
Dim FwdDist As Single
Dim LatDist As Single
Dim Direction As String
Dim PorSta As String
Dim ForRev As String
Rem --- disScreen declarations ---
Dim Box(4, 2) As Integer
Dim poly_clip_min_x, poly_clip_min_y, poly_clip_max_x, poly_clip_max_y As Integer
Dim X1, Y1, X2, Y2 As Integer
Dim ClipReturn, WithClip As Boolean
Rem --- landstuff declarations
Const GREEN = 2
Const LTGREEN = 10
Const LTRED = 12
Const BLACK = 0
'/*****************************************************************************/
Dim Biggy(300, 400) As Integer 'array to hold altitudes
Dim TargetBiggy(300, 400) As Boolean 'array to hold position of target
'Dim NextBiggy(300, 400) As Integer 'array to hold 2nd set of altitudes for hyperclose landing
'Dim NextTargetBiggy(300, 400) As Boolean 'array to hold position of X and C3PO
'Dim GenBiggy(300, 400) As Integer 'array to hold altitudes for general landing other than land site
Dim Display(32, 32) As Integer 'array hold alts for movement
Dim TargetDisplay(32, 32) As Boolean 'array holds target position for movement
Dim Cdisplay(32, 32) As Integer ' array to hold old values for ClearScreen
Dim BluedLine(32) As Integer 'which lines are created
Dim CollisionFlag As Integer 'special cases, mtn, crater, life, death, etc.
'Dim NewMap As Integer '0 is original, 1 is Landing site, 2 is general landing map
Dim Doublein, DoubleStart, DoubleFlag As Integer
'Scaling Constants
Const XSCALE = 17
Const YSCALE = 3
Const SPACING = 8
Dim starty, startx As Integer 'begining position on any map for starting
Dim OldStarty, OldStartx As Integer
Dim xoffset, yoffset As Integer
Dim GraphOffset As Integer
Dim Mag As Single 'Multiplication factor
Dim biggytemp As Integer 'map array
Dim hShift, vShift As Integer 'amounts to move position of radar
Dim pubXpos As Integer
Dim pubYpos As Integer
Dim diedFlag As Boolean
Sub JoyControl(Index As Integer)
Dim x As Integer
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
'Ydock = Ydock - 1
auxcon(0).Picture = auxcon(1).Picture
Case Is = 1
'Xdock = Xdock + 1
auxcon(0).Picture = auxcon(2).Picture
Case Is = 2
'Ydock = Ydock + 1
auxcon(0).Picture = auxcon(3).Picture
Case Is = 3
'Xdock = Xdock - 1
auxcon(0).Picture = auxcon(4).Picture
End Select
'x = frmtime.playsound("rcstrst.wav", 3, 0)
End Sub
Sub auxjoy_Click(Index As Integer)
Dim x As Integer
Dim currpath As String
currpath = CDdrive + "\docking\csm4\"
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
Ydock = Ydock - 1
auxcon(0).Picture = auxcon(1).Picture
RCSBurstCount = RCSBurstCount + 1
Case Is = 1
Xdock = Xdock + 1
auxcon(0).Picture = auxcon(2).Picture
LatVel = 33 * Xdock
RCSBurstCount = RCSBurstCount + 1
Case Is = 2
Ydock = Ydock + 1
auxcon(0).Picture = auxcon(3).Picture
RCSBurstCount = RCSBurstCount + 1
Case Is = 3
Xdock = Xdock - 1
auxcon(0).Picture = auxcon(4).Picture
LatVel = 33 * Xdock
RCSBurstCount = RCSBurstCount + 1
End Select
If MissionState = 6 And (Index = 0 Or Index = 2) Then
x = frmTime.playSound(CDdrive + "\sfx\updwnrcs.wav", EFFECTS, NO_LUPE)
Else
x = frmTime.playSound(CDdrive + "\sfx\rcstrst.wav", EFFECTS, NO_LUPE)
End If
End Sub
Sub Command2_Click(Index As Integer)
Dim x As Integer
Dim currpath As String
currpath = CDdrive + "\docking\csm4\"
Select Case Index
Case Is = 0
If MissionState = 6 Then
Zdock = Zdock - 1
FwdVel = -Zdock * 33
Else
Zdock = Zdock - 1
End If
Case Is = 1
If MissionState = 6 Then
Zdock = Zdock + 1
FwdVel = -Zdock * 33
Else
Zdock = Zdock + 1
End If
End Select
If MissionState = 6 Then
x = frmTime.playSound(CDdrive + "\sfx\updwnrcs.wav", EFFECTS, NO_LUPE)
Else
x = frmTime.playSound(CDdrive + "\sfx\rcstrst.wav", EFFECTS, NO_LUPE)
End If
End Sub
Sub Form_Load()
Dim x As Integer
Dim rc As Long
Randomize
StopEverything = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Rem --- set the pallette pref
picBGOriginal.ZOrder 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
picBackground.Visible = False
picBackground.Picture = picPitSprite.Picture
MouseButtonDown = NO_BUTTON
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Image1(0).Visible = True
Image1(1).Visible = True
Image1(2).Visible = True
Command2(0).Visible = True
Command2(1).Visible = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If StarCrossed Then ' star finder
Xdock = 0
Ydock = 0
LookedForStars = True
VScroll1.Visible = False
picBGOriginal = LoadPicture(CDdrive + "\panels\starfind\strfld4.bmp")
Timer3.Enabled = True
picBackground.Picture = LoadPicture(CDdrive + "\panels\starfind\strfndw.bmp")
picPitSprite.Picture = LoadPicture(CDdrive + "\panels\starfind\strfndw.bmp")
picPitMask.Picture = LoadPicture(CDdrive + "\panels\starfind\strfndm.bmp")
starlock.Visible = False
distance.Visible = False
closerate.Visible = False
docking.dockThrust(0).Visible = False
docking.dockThrust(1).Visible = False
docking.dockThrust(2).Visible = False
firstXpos = -(Int(Rnd * 500) + 1)
firstYpos = -(Int(Rnd * 400) + 1)
ElseIf MissionState = 2 Then ' earth orbit
VScroll1.Visible = False
starlock.Visible = False
Xdock = 0
Ydock = 0
Zdock = 0
ldist = 120
picBGOriginal = LoadPicture(CDdrive + "\docking\csm4\strfld2.bmp")
S4B(1) = CDdrive + "\docking\s4b\s4b1.bmp"
S4B(2) = CDdrive + "\docking\s4b\s4b2.bmp"
S4B(3) = CDdrive + "\docking\s4b\s4b3.bmp"
S4B(4) = CDdrive + "\docking\s4b\s4b4.bmp"
S4B(5) = CDdrive + "\docking\s4b\s4b5.bmp"
S4B(6) = CDdrive + "\docking\s4b\s4b6.bmp"
S4B(7) = CDdrive + "\docking\s4b\s4b7.bmp"
S4B(8) = CDdrive + "\docking\s4b\s4b8.bmp"
S4B(9) = CDdrive + "\docking\s4b\s4b9.bmp"
S4B(10) = CDdrive + "\docking\s4b\s4b10.bmp"
S4B(11) = CDdrive + "\docking\s4b\s4b11.bmp"
S4B(12) = CDdrive + "\docking\s4b\s4b12.bmp"
S4B(13) = CDdrive + "\docking\s4b\s4b13.bmp"
S4B(14) = CDdrive + "\docking\s4b\s4b14.bmp"
S4B(15) = CDdrive + "\docking\s4b\s4b15.bmp"
S4B(16) = CDdrive + "\docking\s4b\s4b16.bmp"
S4B(17) = CDdrive + "\docking\s4b\s4b17.bmp"
S4B(18) = CDdrive + "\docking\s4b\s4b18.bmp"
s4bmask(1) = CDdrive + "\docking\mask\s4b1m.bmp"
s4bmask(2) = CDdrive + "\docking\mask\s4b2m.bmp"
s4bmask(3) = CDdrive + "\docking\mask\s4b3m.bmp"
s4bmask(4) = CDdrive + "\docking\mask\s4b4m.bmp"
s4bmask(5) = CDdrive + "\docking\mask\s4b5m.bmp"
s4bmask(6) = CDdrive + "\docking\mask\s4b6m.bmp"
s4bmask(7) = CDdrive + "\docking\mask\s4b7m.bmp"
s4bmask(8) = CDdrive + "\docking\mask\s4b8m.bmp"
s4bmask(9) = CDdrive + "\docking\mask\s4b9m.bmp"
s4bmask(10) = CDdrive + "\docking\mask\s4b10m.bmp"
s4bmask(11) = CDdrive + "\docking\mask\s4b11m.bmp"
s4bmask(12) = CDdrive + "\docking\mask\s4b12m.bmp"
s4bmask(13) = CDdrive + "\docking\mask\s4b13m.bmp"
s4bmask(14) = CDdrive + "\docking\mask\s4b14m.bmp"
s4bmask(15) = CDdrive + "\docking\mask\s4b15m.bmp"
s4bmask(16) = CDdrive + "\docking\mask\s4b16m.bmp"
s4bmask(17) = CDdrive + "\docking\mask\s4b17m.bmp"
s4bmask(18) = CDdrive + "\docking\mask\s4b18m.bmp"
Timer1.Enabled = True
text1.Visible = False
Text2.Visible = False
Text3.Visible = False
Text4.Visible = False
Text5.Visible = False
Text6.Visible = False
labeltime.Visible = False
SplatTextBox.Visible = False
distance.Visible = True
closerate.Visible = True
docking.dockThrust(0).Visible = False
docking.dockThrust(1).Visible = False
docking.dockThrust(2).Visible = False
ElseIf MissionState = 6 Then 'Landing
lmEng = True
VScroll1.Visible = True
starlock.Visible = False
Xdock = 0
Ydock = 0
Zdock = 0
picBackground.Picture = LoadPicture(CDdrive + "\landsite\lmScren.bmp")
picPitSprite.Picture = LoadPicture(CDdrive + "\landsite\lmScren.bmp")
picPitMask.Picture = LoadPicture(CDdrive + "\landsite\lmScrmsk.bmp")
picImage = LoadPicture(CDdrive + "\landsite\croshair.bmp")
picPitMask = LoadPicture(CDdrive + "\landsite\croshair.bmp")
FwdVel = -200
LmAlt = 1200 '1200
VScroll1.Value = 50
xoffset = 133 ' 110 - target
yoffset = 93 ' 75 - target
startx = Int(Rnd * 100) + 50 '50
starty = Int(Rnd * 100) + 225 '300
GraphOffset = 0
hShift = 47 'amount to shift radar
vShift = 60 'amount to shift radar
WithClip = True
Mag = 1
text1.Visible = True
Text2.Visible = True
Text3.Visible = True
Text4.Visible = True
Text5.Visible = True
Text6.Visible = True
labeltime.Visible = True
SplatTextBox.Visible = True
'limits of box
poly_clip_min_x = 50
poly_clip_min_y = 80
poly_clip_max_x = 575
poly_clip_max_y = 320
Box(0, 0) = poly_clip_min_x 'top left X
Box(0, 1) = poly_clip_min_y 'top left Y
Box(1, 0) = poly_clip_max_x 'top right X
Box(1, 1) = poly_clip_min_y 'top right Y
Box(2, 0) = poly_clip_max_x 'bottom right X
Box(2, 1) = poly_clip_max_y 'bottom right Y
Box(3, 0) = poly_clip_min_x 'bottom left X
Box(3, 1) = poly_clip_max_y 'bottom left Y
loadYvals
Timer2.Enabled = True
DockedWithCSM = True
LmAlt = 1200
Xdock = 0
Ydock = 0
Zdock = -6
FwdVel = -Zdock * 33
distance.Visible = True
closerate.Visible = True
docking.dockThrust(0).Picture = frmTime.imgdnum(0).Picture
docking.dockThrust(1).Picture = frmTime.imgdnum(5).Picture
docking.dockThrust(2).Picture = frmTime.imgdnum(0).Picture
docking.dockThrust(0).Visible = True
docking.dockThrust(1).Visible = True
docking.dockThrust(2).Visible = True
ElseIf MissionState = 8 Then ' moon orbit
VScroll1.Visible = False
starlock.Visible = False
Xdock = 0
Ydock = 0
Zdock = 0
ldist = 120
picBGOriginal = LoadPicture(CDdrive + "\docking\csm4\strfld3.bmp")
csmDock(1) = CDdrive + "\docking\CSM\csm1.bmp"
csmDock(2) = CDdrive + "\docking\CSM\csm2.bmp"
csmDock(3) = CDdrive + "\docking\CSM\csm3.bmp"
csmDock(4) = CDdrive + "\docking\CSM\csm4.bmp"
csmDock(5) = CDdrive + "\docking\CSM\csm5.bmp"
csmDock(6) = CDdrive + "\docking\CSM\csm6.bmp"
csmDock(7) = CDdrive + "\docking\CSM\csm7.bmp"
csmDock(8) = CDdrive + "\docking\CSM\csm8.bmp"
csmDock(9) = CDdrive + "\docking\CSM\csm9.bmp"
csmDock(10) = CDdrive + "\docking\CSM\csm10.bmp"
csmDock(11) = CDdrive + "\docking\CSM\csm11.bmp"
csmDock(12) = CDdrive + "\docking\CSM\csm12.bmp"
csmDock(13) = CDdrive + "\docking\CSM\csm13.bmp"
csmDock(14) = CDdrive + "\docking\CSM\csm14.bmp"
csmDock(15) = CDdrive + "\docking\CSM\csm15.bmp"
csmDock(16) = CDdrive + "\docking\CSM\csm16.bmp"
csmDock(17) = CDdrive + "\docking\CSM\csm17.bmp"
csmDock(18) = CDdrive + "\docking\CSM\csm18.bmp"
csmMask(1) = CDdrive + "\docking\cMask\cMask1.bmp"
csmMask(2) = CDdrive + "\docking\cMask\cMask2.bmp"
csmMask(3) = CDdrive + "\docking\cMask\cMask3.bmp"
csmMask(4) = CDdrive + "\docking\cMask\cMask4.bmp"
csmMask(5) = CDdrive + "\docking\cMask\cMask5.bmp"
csmMask(6) = CDdrive + "\docking\cMask\cMask6.bmp"
csmMask(7) = CDdrive + "\docking\cMask\cMask7.bmp"
csmMask(8) = CDdrive + "\docking\cMask\cMask8.bmp"
csmMask(9) = CDdrive + "\docking\cMask\cMask9.bmp"
csmMask(10) = CDdrive + "\docking\cMask\cMask10.bmp"
csmMask(11) = CDdrive + "\docking\cMask\cMask11.bmp"
csmMask(12) = CDdrive + "\docking\cMask\cMask12.bmp"
csmMask(13) = CDdrive + "\docking\cMask\cMask13.bmp"
csmMask(14) = CDdrive + "\docking\cMask\cMask14.bmp"
csmMask(15) = CDdrive + "\docking\cMask\cMask15.bmp"
csmMask(16) = CDdrive + "\docking\cMask\cMask16.bmp"
csmMask(17) = CDdrive + "\docking\cMask\cMask17.bmp"
csmMask(18) = CDdrive + "\docking\cMask\cMask18.bmp"
Timer1.Enabled = True
text1.Visible = False
Text2.Visible = False
Text3.Visible = False
Text4.Visible = False
Text5.Visible = False
Text6.Visible = False
labeltime.Visible = False
SplatTextBox.Visible = False
distance.Visible = True
closerate.Visible = True
docking.dockThrust(0).Visible = False
docking.dockThrust(1).Visible = False
docking.dockThrust(2).Visible = False
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Rem *** check to see if joystick will be used ***
If joystick = 1 Then
'Calibrate.Visible = True
'/* temp vals for joyst */
rightX = 40000
leftX = 6200
topY = 14250
bottomY = 45251
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
'StartGame
Else
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
'StartGame
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'tdigs(0) = 0
'tdigs(1) = 5
'tdigs(2) = 0
picBackground.Visible = True
ScrollSpeed = 5
frmTime.Center Me
Me.Visible = True
Me.Show
frmTime.TopperOn 5 'docking to fore
StopEverything = False
If MissionState = 6 Then disScreen
End Sub
Sub Form_Unload(Cancel As Integer)
' WAVMIX_Close
'goGame = 0
If Not CompUnload Then Cancel = 1
StarCrossed = False
End Sub
Sub Image1_Click(Index As Integer)
Dim x As Integer
Select Case Index
Case Is = 0 'Csm1
If goodDock = True Or FoundStars = True Then
TranzFlag = True
Male = 3 'coming from docking
StopEverything = True
If MissionState = 8 Or MissionState = 7 Then
Female = 2 'going to LM
Else
Female = 1 'going to CSM
End If
End If
Case Is = 1 'Dock Lock
If MissionState = 2 Or MissionState = 8 Then
goodDock = True
End If
Case Is = 2 'Star Finder
If (pubXpos >= 500 And pubXpos <= 533) Then
If (pubYpos >= 456 And pubYpos <= 486) Then
YourLost = False
x = frmTime.playSound(CDdrive + "\sfx\119sfx81.wav", EFFECTS, NO_LUPE)
x = frmTime.playSound(CDdrive + "\warnings\starlock.wav", WARNINGS, NO_LUPE)
FoundStars = True
End If
ElseIf (pubXpos >= -295 And pubXpos <= -267) Then
If (pubYpos >= 456 And pubYpos <= 486) Then
YourLost = False
x = frmTime.playSound(CDdrive + "\sfx\119sfx81.wav", EFFECTS, NO_LUPE)
x = frmTime.playSound(CDdrive + "\warnings\starlock.wav", WARNINGS, NO_LUPE)
FoundStars = True
End If
End If
End Select
If FoundStars Then
FoundStars = False
StarCrossed = False
WaitingToLeave = True
End If
End Sub
Sub starlock_KeyPress(KeyAscii As Integer)
Dim LSx1, LSx2, LSy1, LSy2 As Integer
Dim rc As Long
Dim row, col, linekount As Integer
Dim lineColor As Integer
lineColor = 2
'clearscreen
If Chr(KeyAscii) = "q" Or Chr(KeyAscii) = "Q" Then
starty = starty - 5
End If
If Chr(KeyAscii) = "a" Or Chr(KeyAscii) = "A" Then
starty = starty + 5
End If
If Chr(KeyAscii) = "z" Or Chr(KeyAscii) = "Z" Then
startx = startx - 5
End If
If Chr(KeyAscii) = "x" Or Chr(KeyAscii) = "X" Then
startx = startx + 5
End If
If Chr(KeyAscii) = "1" Then
LmAlt = 25
End If
If Chr(KeyAscii) = "2" Then
LmAlt = 75
End If
If Chr(KeyAscii) = "3" Then
LmAlt = 125
End If
If Chr(KeyAscii) = "4" Then
LmAlt = 175
End If
Label1.Caption = Str(LmAlt)
For row = 0 To 31 'start and end line in array
linekount = row * SPACING
For col = 0 To 30 '
LSx1 = col * XSCALE
LSy1 = (-Display(col, row) * YSCALE) + (linekount * 5)
LSx2 = (col + 1) * XSCALE
LSy2 = (-Display(col + 1, row) * YSCALE) + (linekount * 5)
If row = 24 And col = 15 Then
picWork.Line (LSx1, LSy1)-(LSx2, LSy2), QBColor(14)
Else
picWork.Line (LSx1, LSy1)-(LSx2, LSy2), QBColor(lineColor)
End If
Next
Next
End Sub
Sub Timer1_Timer()
Static Xpos, Ypos As Integer
Static passed_s4b, reorient As Integer
Static tempd As Integer
Static turnAroundx As Boolean
Static turnAroundy As Boolean
Dim rc As Long
'Dim xtoken, ytoken As Integer
'Joystick docking etc.
Static xComponent As Integer
Static yComponent As Integer
Static zcomponent As Integer
Rem joyst
Dim x As Integer
'Dim i As Integer
Dim WhereAmI, whereisX, whereisY, wheretoken As Integer
'lblZ = ldist
Dim currpath As String
Static NotFirstTime As Boolean
If RCSBurstCount >= 150 Then Check_For_Crash 999, 999
If NotFirstTime = False Then 'Need to turn around to dock
IAMTurnedAround = True
'''''''''''''''''''
'''''''''''''''''''
'''''''''''''''''''
Xpos = 499
Ypos = 50
'''''''''''''''''''
'''''''''''''''''''
'''''''''''''''''''
Xdock = 2
Ydock = 1
' ldist = -200
' xpos = xpos + 400
NotFirstTime = True
End If
If IAMTurnedAround Then
Backward = 0
Else
Backward = 0
End If
Me.Caption = "(24 < " & Xpos & " < 48 , -47 < " & Ypos & " < -89)"
BackGroundSound = 4
currpath = CDdrive + "\docking\csm4\"
' Command3.Caption = xpos
'Command4.Caption = ypos
'closerate.Caption = ypos 'turnAroundx
closerate.Caption = Zdock
distance.Caption = ldist
UpdateBackground
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
If ldist <= 0 Then
passed_s4b = 1
Zdock = -Zdock
reorient = 1
distance.Caption = "missed"
End If
If passed_s4b = 1 Then
If Xpos > 500 Or Xpos < -300 Then
turnAroundx = True
End If
If Ypos > 200 And Ypos < 320 Then
turnAroundy = True
End If
If turnAroundx Or turnAroundy Then
passed_s4b = 0
'Zdock = -Zdock
reorient = 0
turnAroundx = False
turnAroundy = False
End If
End If
'calculate distance from s4sb
'If passed_s4b = 1 Then
Rem hide s4b
'End If
ldist = ldist + Zdock
If ldist <= 140 And ldist > 131 Then tempd = 18
If ldist <= 130 And ldist > 121 Then tempd = 17
If ldist <= 120 And ldist > 111 Then tempd = 16
If ldist <= 110 And ldist > 101 Then tempd = 15
If ldist <= 100 And ldist > 91 Then tempd = 14
If ldist <= 90 And ldist > 81 Then tempd = 13
If ldist <= 80 And ldist > 71 Then tempd = 12
If ldist <= 70 And ldist > 61 Then tempd = 11
If ldist <= 60 And ldist > 51 Then tempd = 10
If ldist <= 50 And ldist > 41 Then tempd = 9
If ldist <= 40 And ldist > 31 Then tempd = 8
' If ldist <= 30 And ldist > 21 Then tempd = 7
' If ldist <= 20 And ldist > 10 Then tempd = 6
If ldist <= 1 And ldist >= -1 Then
'xtoken = xpos
'ytoken = ypos
Check_For_Crash Xpos, Ypos
Exit Sub
End If
If tempd > 5 And tempd < 19 Then
If MissionState = 2 Then
picImage = LoadPicture(S4B(tempd))
picMask = LoadPicture(s4bmask(tempd))
Else
picImage = LoadPicture(csmDock(tempd))
picMask = LoadPicture(csmMask(tempd))
End If
End If
Rem ********************************************************************************
Xpos = Xpos - Xdock
Ypos = Ypos - Ydock
Rem --- if x is off left side ---
If Xpos < -picPitSprite.ScaleWidth + picImage.ScaleWidth Then
Xpos = 800 - picPitSprite.ScaleWidth + picImage.ScaleWidth
Else 'if off right side
If Xpos > 800 - picImage.ScaleWidth Then Xpos = 0 - picImage.ScaleWidth
End If
Rem --- if y is off top side ---
If Ypos < -picImage.ScaleHeight Then
Ypos = 600 - picImage.ScaleHeight
Else 'if off bottom
If Ypos > 600 - picImage.ScaleHeight Then Ypos = 0 - picImage.ScaleHeight
End If
' Copy a section of the large bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, 0, 0, SRCCOPY)
' Copy the sprite work area onto the background.
'rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
If passed_s4b <> 1 Then
Rem hide s4b if passed_s4b
' Draw the sprite mask bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, Xpos + 80, Ypos + 80, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
'draw sprite into the work area
rc = BitBlt(picWorkBG.hDC, Xpos + 80, Ypos + 80, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
End If 'passed_s4b
' Draw the cockpit mask into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitMask.hDC, 0, 0, SRCAND)
'draw cockpit
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitSprite.hDC, 0, 0, SRCPAINT)
'FlickerlessSpriteMove
' Draw the whole thing back onto the screen.
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.Width, picBackground.Height, picWorkBG.hDC, 0, 0, SRCCOPY)
auxjoy(0).Visible = True
auxjoy(1).Visible = True
auxjoy(2).Visible = True
auxjoy(3).Visible = True
auxcon(0).Picture = auxcon(5).Picture
Rem
Rem
Rem Joystick
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If rc = 0 Then
'imgJoyCursor.Left = RangeWidth * ((JoyInfo.X - JoyCaps.Xmin) / (JoyCaps.Xmax - JoyCaps.Xmin))
'imgJoyCursor.Top = RangeHeight * ((JoyInfo.Y - JoyCaps.Ymin) / (JoyCaps.Ymax - JoyCaps.Ymin))
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
'BackgroundX = HScroll1
'BackgroundX = HScroll1
' rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, landsite.hDC, BackgroundX + xComponent, BackgroundY, SRCCOPY)
'calculate distance from s4sb
ldist = ldist + zcomponent
End If
Rem --- check for left or right
whereisX = 0
If JoyInfo.x < leftX Then
whereisX = -1
Else
If JoyInfo.x > rightX Then
whereisX = 1
End If
End If
Rem --- check for up or down
whereisY = 0
If JoyInfo.y < topY Then
whereisY = -1
Else
If JoyInfo.y > bottomY Then
whereisY = 1
End If
End If
wheretoken = whereisX + whereisY
WhereAmI = 4
If wheretoken = 1 Then
If whereisX = 1 Then
WhereAmI = 1
Else
WhereAmI = 2
End If
End If
If wheretoken = -1 Then
If whereisY = -1 Then
WhereAmI = 0
Else
WhereAmI = 3
End If
End If
Command1.Caption = WhereAmI
If WhereAmI <> 4 Then
Call JoyControl((WhereAmI))
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 1 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock + 1
'xComponent = xComponent + 1
Call JoyControl(1)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 3 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock - 1
'xComponent = xComponent - 1
Call JoyControl(3)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 2 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock + 1
'yComponent = yComponent + 1
Call JoyControl(2)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 0 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock - 1
'yComponent = yComponent - 1
Call JoyControl(0)
End If
If JoyInfo.ButtonDown(2) And WhereAmI = 2 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Zdock = Zdock + 1
End If
If JoyInfo.ButtonDown(2) And WhereAmI = 0 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Zdock = Zdock - 1
End If
Rem
Rem
Rem end joystick
End Sub
Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'----------------------------------------------------------
' Set the module-level MouseButtonDown variable, so that
' the Mouse Control timer knows a button was pushed.
'----------------------------------------------------------
MouseButtonDown = Button
End Sub
Sub Pause(Seconds As Single)
'------------------------------------------------------------
' Delay for a specified number of seconds.
'------------------------------------------------------------
Dim Start As Single
Start = Timer
Do While (Timer - Start) < Seconds
DoEvents
Loop
End Sub
Sub StartGame()
'------------------------------------------------------------
' Initialize everything and start the game.
'------------------------------------------------------------
Dim rc As Integer
Dim i As Integer
Static NotFirstTime As Integer
Dim x As Integer
picBackground.Visible = True
ScrollSpeed = 5
If MissionState = 6 Then 'Landing
lmEng = True
Timer1.Enabled = False
startx = 50 'initialize x value
starty = 300 'initialize line
' disScreen 'display starting position
Timer2.Enabled = True
text1.Visible = True
Text2.Visible = True
picImage = LoadPicture(CDdrive + "\landsite\croshair.bmp")
picPitMask = LoadPicture(CDdrive + "\landsite\croshair.bmp")
LmAlt = 1200
Xdock = 0
Ydock = 0
Zdock = -6
FwdVel = -Zdock * 33
ElseIf Not StarCrossed Then
Timer2.Enabled = False
Timer1.Enabled = True
text1.Visible = False
Text2.Visible = False
End If
End Sub
Sub UpdateBackground()
'------------------------------------------------------------
' The first step in building a new view is to copy the
' next section of the original background onto the working
' background picture box.
'------------------------------------------------------------
'Static LastXdir As Integer
'Static LastYdir As Integer
' BGMove picWorkBG, picBGOriginal, LastXdir * 2, LastYdir * 2
BGMove picWorkBG, picBGOriginal, Xdock, Ydock
' End If
End Sub
Sub FlickerlessSpriteMove()
'-----------------------------------------------------
' Moving a sprite without flicker requires the use
' of an off-screen work area into which we copy a
' section of the background and sprite.
'-----------------------------------------------------
Dim rc As Integer
WorkWidth = 2090
WorkHeight = 2020
BackgroundX = SpriteX
BackgroundY = SpriteY
' Calculate the next position for the sprite, and any
' necessary direction changes.
GetNextPos picImage.ScaleWidth, picImage.ScaleHeight
' Copy a section of the large bitmap into the work area.
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY)
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBackground.hDC, (SpriteX), (SpriteY), SRCCOPY)
rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (SpriteX), (SpriteY), SRCCOPY)
' Draw the mask and sprite bitmaps into the work area.
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
'rc = BitBlt(picWork.hDC, 0, 0, picmask.ScaleWidth, picmask.ScaleHeight, picmask.hDC, 0, 0, SRCAND)
'rc = BitBlt(picWork.hDC, 0, 0, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Copy the work area onto the background.
' rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' rc = BitBlt(picBackground.hDC, 10, 10, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
DoEvents
End Sub
Sub GetNextPos(ByVal AWidth As Integer, ByVal AHeight As Integer)
'-----------------------------------------------------
' Calculate the next position for the sprite, and
' make any necessary direction changes.
'-----------------------------------------------------
Xdir = Xdock
Ydir = Ydock
' Calculate the new position for the sprite.
SpriteX = SpriteX + (Xdir)
SpriteY = SpriteY + (Ydir)
End Sub
Public Sub Check_For_Crash(xtoken, ytoken)
Dim lmx As Boolean 'lm
Dim Tx As Boolean 'target
Dim lmy As Boolean 'lm
Dim Ty As Boolean 'target
Dim csmx As Boolean 'Csm
Dim csmy As Boolean 'Csm
Dim z As Integer
Dim WentToForm As Boolean
If xtoken = 999 And ytoken = 999 Then GoTo CFCENDING
BackGroundSound = 999
If MissionState = 2 Then 'docking with LM from CSM
If xtoken <= 235 + Backward And xtoken >= -35 + Backward Then lmx = True
If xtoken <= 89 + Backward And xtoken >= 62 + Backward Then Tx = True
If ytoken <= 90 And ytoken >= -160 Then lmy = True
If ytoken <= 52 And ytoken >= 26 Then Ty = True
If Zdock <= 0 And Zdock > -3 Then z = 0
If Zdock > 0 Then z = -1
If Zdock <= -3 Then z = 1
ElseIf MissionState >= 7 Then 'docking with CSM from LM
If xtoken <= 183 + Backward And xtoken >= -84 + Backward Then csmx = True
If xtoken <= 48 + Backward And xtoken >= 24 + Backward Then Tx = True
If ytoken <= 49 And ytoken >= -226 Then csmy = True
If ytoken <= -47 And ytoken >= -89 Then Ty = True
If Zdock <= 0 And Zdock > -3 Then z = 0
If Zdock > 0 Then z = -1
If Zdock <= -3 Then z = 1
Else
Exit Sub
End If
If (lmx And lmy) Or (csmx And csmy) Then
If z = 0 Then 'not too fast
frmTime.masterTimer.Enabled = False
Timer1.Enabled = False
docking.Hide
If MissionState = 2 Then
Dock2LM.Show
WentToForm = True
ElseIf MissionState >= 7 Then
Dock2CSM.Show
WentToForm = True
End If
'If Tx And Ty Then
'docked
' distance.Caption = "docked"
' Timer1.Enabled = False
' Zdock = 0
' If MissionState = 8 Then
' MissionState = 9
' Else
'what are you doing here then...
' End If
' frmTime.PlayAVI "success\shot32.avi", 3
' youaredead = False
' goodDock = True
'Else
'missed target - bounced off
' distance.Caption = "bounced"
' Xdock = -Xdock
' Ydock = -Ydock
' Zdock = -Zdock
' Exit Sub
'End If
ElseIf z = -1 Then 'reverse
'nothing
Else 'z = 1 too fast
If (lmx And lmy) Then
frmTime.PlayAVI "death\shot33.avi", 3
distance.Caption = "crashed"
Timer1.Enabled = False
Zdock = 0
YouAreDead = True
Else
distance.Caption = "missed"
IAMTurnedAround = Not IAMTurnedAround
Exit Sub
End If
End If
Else
distance.Caption = "missed"
IAMTurnedAround = Not IAMTurnedAround
Exit Sub
End If
CFCENDING:
If WentToForm Then
If MissionState = 2 Then
CompUnload = True
Unload Dock2LM
CompUnload = False
ElseIf MissionState >= 7 Then
CompUnload = True
Unload Dock2CSM
CompUnload = False
End If
End If
frmTime.masterTimer.Enabled = True
Me.Visible = False
If MissionState >= 2 And MissionState <= 6 Then
If Not YouAreDead Then
fivek = 5
Met = 615
StopEverything = True
OkToDock = False
Exit Sub
Else
fivek = 5
Met = 565
StopEverything = True
OkToDock = False
End If
ElseIf MissionState >= 7 And MissionState <= 9 Then
If Not YouAreDead Then
fivek = 5
Met = 2185 ''''
StopEverything = True
OkToDock = False
Else
fivek = 5
Met = 2175 ''''
StopEverything = True
OkToDock = False
End If
End If
Me.Visible = False
End Sub
Public Sub loadYvals()
Dim iAutoNumber As Integer
Dim row, col As Integer
Dim TheNameOfTheFile As String
' ***
' *** OPEN DATA FILE AND FILL ARRAY WITH VALUES
' ***
'main matrix load and setup
iAutoNumber = FreeFile
Open (CDdrive + "\landsite\terrain.dat") For Input As iAutoNumber
For row = 0 To 399
For col = 0 To 299
Input #iAutoNumber, Biggy(col, row) 'read 1 number
TargetBiggy(col, row) = False
Next 'col
Next 'row
Close iAutoNumber
TargetBiggy(133, 93) = True
' Open (CDdrive + "\landsite\target.dat") For Input As iAutoNumber
' For row = 0 To 399
' For col = 0 To 299
' Input #iAutoNumber, NextBiggy(col, row) 'read 1 number
' NextTargetBiggy(col, row) = False
' Next col
' Next row
' Close iAutoNumber
'
' 'secondary matrix load and setup
' Select Case Int(Rnd * 3) + 1
' Case Is = 1
' TheNameOfTheFile = CDdrive + "\landsite\rndgrnd1.dat"
' Case Is = 2
' TheNameOfTheFile = CDdrive + "\landsite\rndgrnd2.dat"
' Case Is = 3
' TheNameOfTheFile = CDdrive + "\landsite\rndgrnd3.dat"
' End Select
'
' Open TheNameOfTheFile For Input As iAutoNumber
' For row = 0 To 399
' For col = 0 To 299
' Input #iAutoNumber, GenBiggy(col, row) 'read 1 number
' Next col
' Next row
' Close iAutoNumber
End Sub
Sub Timer2_Timer()
Static Xpos, Ypos As Integer
Static passed_s4b, reorient As Integer
Static tempd As Integer
Dim rc As Long
Dim xtoken, ytoken As Integer
'Joystick docking etc.
Static xComponent As Integer
Static yComponent As Integer
Static zcomponent As Integer
Rem joyst
Dim x As Integer
'Dim i As Integer
'lblZ = ldist
Dim currpath As String
Dim TrueDist As Single
Dim TrueVel As Single
Dim ClosRate As Double
Dim RobsAlt As Single
Dim RobsDistDrop As Single
Static Duration As Integer
Dim contThrustEffect As Single
Dim contThrustResult As Integer
Static WasHolding As Boolean
'If RCSBurstCount >= 150 Then collision 0
'Zdock = FwdVel / 28
'clearScreen
starty = starty + Zdock
startx = startx + Xdock
'update distances
FwdDist = 33 * (starty + DoubleStart + (24 / Mag))
LatDist = 33 * (startx + DoubleStart + (16 / Mag))
TrueDist = Sqr((LmAlt) ^ 2 + (FwdDist) ^ 2 + (LatDist) ^ 2)
If TrueDist <> 0 Then
RobsAlt = LmAlt ' counteract overflow problem
RobsDistDrop = DistDrop ' counteract overflow problem
ClosRate = ((LatDist * LatVel) + (FwdDist * FwdVel) + (RobsAlt * RobsDistDrop)) / TrueDist
Else
ClosRate = 0
End If
Rem ******* DISPLAYS **********
text1.Text = "True Alt = " + Str(AltiMeterReading)
Text2.Text = "Your X " + Str(startx + 16) '"fuel"
Text3.Text = Direction
Text4.Text = "Your Y " + Str(starty + 16) '"RCS"
Text5.Text = "Fwd Vel = " + Str(FwdVel)
Text6.Text = "Lat Vel = " + Str(LatVel)
distance.Caption = Str(Int(TrueDist))
closerate.Caption = Str(Int(ClosRate))
labeltime.Caption = Duration
'If Duration = 20000 Then
' labeltime.Caption = "too bad!!"
'Else
Duration = Duration + 1 ' your 40 of life!!!
'End If
landstuff
If StopEverything Then
Timer2.Enabled = False
Exit Sub
End If
If diedFlag = True Then Exit Sub 'bail
disScreen
If StopEverything Then
Timer2.Enabled = False
Exit Sub
End If
auxjoy(0).Visible = True
auxjoy(1).Visible = True
auxjoy(2).Visible = True
auxjoy(3).Visible = True
auxcon(0).Picture = auxcon(5).Picture
'contThrustEffect = -(2 * contThrust / 100) * GRAVITY + GRAVITY
contThrustEffect = (2 * contThrust / 100) * Gravity + Gravity
DropTime = DropTime + Ydock * 2.75
DistDrop = -Int(((contThrustEffect) * DropTime) + Ydock * 2.75 * 3)
Ydock = 0
LmAlt = LmAlt + DistDrop
If contThrust <= 45 Then
If DropTime < 0 Then DropTime = 0
DropTime = DropTime + 1
ElseIf contThrust > 45 And contThrust < 55 Then
DropTime = 0
Else
If DropTime > 0 Then DropTime = 0
DropTime = DropTime - 1
End If
End Sub
Public Sub LeadLine(curline As Integer)
Dim col As Integer
Dim LSx1, LSx2, LSy1, LSy2 As Integer
Dim linekount As Integer
linekount = curline * SPACING
For col = 0 To 30 '
'newvalues for new lines
LSx1 = col * XSCALE + hShift
LSy1 = (-Display(col, curline) * YSCALE) + (linekount) + GraphOffset + vShift
LSx2 = (col + 1) * XSCALE + hShift
LSy2 = (-Display(col + 1, curline) * YSCALE) + (linekount) + GraphOffset + vShift
If WithClip = True Then
ClipLine LSx1, LSy1, LSx2, LSy2 'newline with clip
If StopEverything Then Exit Sub
If ClipReturn = True Then
picBackground.Line (LSx1, LSy1)-(LSx2, LSy2), QBColor(10)
End If
Else 'no cliping
picBackground.Line (LSx1, LSy1)-(LSx2, LSy2), QBColor(10)
End If
Next 'col
DoEvents
End Sub
Public Sub disScreen()
Dim LSx1 As Integer, LSx2 As Integer, LSy1 As Integer, LSy2 As Integer
Dim rc As Long
Dim row As Integer, col As Integer, linekount, blinekount, tempkount As Integer
Dim dirtLevel As Integer
Dim x As Long
Static HoldOffset As Integer
Dim target As Boolean
Dim Q As Integer
'DrawBox 'displays limits of clipping
Select Case Doublein ' offsetting the screen values
Case Is = 1
GraphOffset = Mag * SPACING
Case Is = 2
GraphOffset = Mag * SPACING ^ 1.5
Case Is = 4
GraphOffset = Mag * SPACING ^ 1.75
Case Is = 8
GraphOffset = Mag * SPACING ^ 1.85
Case Is = 16
GraphOffset = Mag * SPACING ^ 2
End Select
' *** DISPLAY CONTENTS OF ARRAY
' *** ON SCREEN
' ***
For row = 0 To 8 'start and end line in array
blinekount = row * SPACING
For col = 0 To 30 '
X1 = col * XSCALE + hShift
Y1 = (-Cdisplay(col, row) * YSCALE) + (blinekount) + HoldOffset + vShift
X2 = (col + 1) * XSCALE + hShift
Y2 = (-Cdisplay(col + 1, row) * YSCALE) + (blinekount) + HoldOffset + vShift
If WithClip Then
ClipLine X1, Y1, X2, Y2
If ClipReturn Then
picBackground.Line (X1, Y1)-(X2, Y2), QBColor(0)
End If
Else
picBackground.Line (X1, Y1)-(X2, Y2), QBColor(0)
End If
Cdisplay(col, row) = Display(col, row) 'load current value into backup array
Next
Cdisplay(col, row) = Display(31, row)
joyPolling 'here is a joystick call
Next
tempkount = blinekount
For row = 0 To 31 'start and end line in array
linekount = row * SPACING
blinekount = linekount + tempkount + SPACING
For col = 0 To 30 '
If row <= 22 Then
X1 = col * XSCALE + hShift
Y1 = (-Cdisplay(col, row + 9) * YSCALE) + (blinekount) + HoldOffset + vShift
X2 = (col + 1) * XSCALE + hShift
Y2 = (-Cdisplay(col + 1, row + 9) * YSCALE) + (blinekount) + HoldOffset + vShift
End If
'If row <= 22 Then
' Cdisplay(col, row + 9) = Display(col, row + 9)
'End If
'newvalues for new lines
LSx1 = col * XSCALE + hShift
LSy1 = (-Display(col, row) * YSCALE) + (linekount) + GraphOffset + vShift
LSx2 = (col + 1) * XSCALE + hShift
LSy2 = (-Display(col + 1, row) * YSCALE) + (linekount) + GraphOffset + vShift
If WithClip Then 'Clipped
If row <= 22 Then
ClipLine X1, Y1, X2, Y2 'blankline
If StopEverything Then Exit Sub
If ClipReturn = True Then
picBackground.Line (X1, Y1)-(X2, Y2), QBColor(0)
End If
End If
ClipLine LSx1, LSy1, LSx2, LSy2 'green line
If StopEverything Then Exit Sub
If ClipReturn Then 'draw if clipped properly
picBackground.Line (LSx1, LSy1)-(LSx2, LSy2), QBColor(BluedLine(row))
If TargetDisplay(col, row) Then
target = True
End If
If target Then 'the target
picBackground.Line (LSx1, LSy1)-(LSx2, LSy2), QBColor(12)
End If
End If 'if Clipreturn
Else 'not clipped
If row <= 22 Then
picBackground.Line (X1, Y1)-(X2, Y2), QBColor(0) 'unclipped blankline
End If
picBackground.Line (LSx1, LSy1)-(LSx2, LSy2), QBColor(BluedLine(row)) 'unclipped green
If TargetDisplay(col, row) = True Then
target = True
End If
If target Then 'the target
picBackground.Line (LSx1, LSy1)-(LSx2, LSy2), QBColor(12)
'x = ellipse(picBackGround.hDC, LSx1, LSy1, LSx2 + 10, LSy2 + 10)
End If
End If
target = False
If row = 24 And col = 16 Then '>XZX< check for collision >XZX<
picBackground.Line (LSx1, LSy1)-(LSx2, LSy2), QBColor(14)
End If
If row <= 22 Then 'copy ys over to Cdisplay
Cdisplay(col, row + 9) = Display(col, row + 9)
End If
Next 'col
Cdisplay(col, row) = Display(31, row)
If row <= 22 Then 'Copy last Y position
Cdisplay(col + 1, row + 9) = Display(col + 1, row + 9) 'load current value into backup array
End If
If row <= 30 Then 'draw leadline
LeadLine row + 1
If StopEverything Then Exit Sub
End If
joyPolling
If StopEverything Then Exit Sub
Next 'row
'yoffset = yoffset - 1
HoldOffset = GraphOffset
For Q = 0 To 3
auxjoy(Q).Enabled = True
Command2(Int(Q / 2)).Enabled = True
Next Q
x = frmTime.playSound(CDdrive + "\sfx\55sfx27.wav", EFFECTS, NO_LUPE)
End Sub
Public Sub ClipLine(X1, Y1, X2, Y2)
'int Clip_Line(int *x1,int *y1,int *x2, int *y2)
' //////////////////////////////////////////////////////////////////////////////
'// this function clips the sent line using the globally defined clipping
'// region
Dim point_1, point_2 As Integer '// tracks if each end point is visible or invisible
Dim clip_always '// used for clipping override
Dim xi, yi As Integer '// point of intersection
'// which edges are the endpoints beyond
Dim right_edge, left_edge, top_edge, bottom_edge As Integer
Dim success As Integer '// was there a successfull clipping
Dim Dx, dY As Single '// used to holds slope deltas
' //////////////////////////////////////////////////////////////////////////////
point_1 = 0
point_2 = 0
clip_always = 0
right_edge = 0 '// which edges are the endpoints beyond
left_edge = 0
top_edge = 0
bottom_edge = 0
success = 0
'// SECTION 1 //////////////////////////////////////////////////////////////////
'// test if line is completely visible
If ((X1 >= poly_clip_min_x) And (X1 <= poly_clip_max_x) And (Y1 >= poly_clip_min_y) And (Y1 <= poly_clip_max_y)) Then point_1 = 1
If ((X2 >= poly_clip_min_x) And (X2 <= poly_clip_max_x) And (Y2 >= poly_clip_min_y) And (Y2 <= poly_clip_max_y)) Then point_2 = 1
'// SECTION 2 /////////////////////////////////////////////////////////////////
'// test endpoints
'both endpoints are good
If (point_1 = 1 And point_2 = 1) Then
ClipReturn = True 'return(success);
Exit Sub 'then return(1)
End If
'// SECTION 3 /////////////////////////////////////////////////////////////////
'// test if line is completely invisible
'entire line is outside box
If (point_1 = 0 And point_2 = 0) Then
'// must test to see if each endpoint is on the same side of one of
'// the bounding planes created by each clipping region boundary
If (((X1 < poly_clip_min_x) And (X2 < poly_clip_min_x)) Or ((X1 > poly_clip_max_x) And (X2 > poly_clip_max_x)) Or ((Y1 < poly_clip_min_y) And (Y2 < poly_clip_min_y)) Or ((Y1 > poly_clip_max_y) And (Y2 > poly_clip_max_y))) Then
ClipReturn = False
Exit Sub 'return(0); no need to draw line
End If 'invisible
'// if we got here we have the special case where the line cuts into and
'// out of the clipping region
clip_always = 1
End If 'test for invisibly
'// SECTION 4 /////////////////////////////////////////////////////////////////
'// take care of case where either endpoint is in clipping region
'If ((point_1 = 1) Or (point_2 = 1) Or (point_1 = 0 And point_2 = 0)) Then
'left endpoint or both endpoints lie outside of box
If ((point_1 = 1) Or (point_1 = 0 And point_2 = 0)) Then
'/ compute deltas
Dx = X2 - X1
dY = Y2 - Y1
'// compute what boundary line need to be clipped against
If (X2 > poly_clip_max_x) Then 'right edge
right_edge = 1 '// flag right edge
'// compute intersection with right edge
If (Dx <> 0) Then
yi = Int(0.5 + (dY / Dx) * (poly_clip_max_x - X1) + Y1)
Else
yi = -1 '// invalidate intersection
End If
'End If 'to right
ElseIf (X2 < poly_clip_min_x) Then 'left edge
left_edge = 1 '/ flag left edge
'// compute intersection with left edge
If (Dx <> 0) Then
yi = Int(0.5 + (dY / Dx) * (poly_clip_min_x - X1) + Y1)
Else
yi = -1 '// invalidate intersection
End If
'End If 'to left
'// horizontal intersections
ElseIf (Y2 > poly_clip_max_y) Then 'bottom edge
bottom_edge = 1 '// flag bottom edge
'// compute intersection with right edge
If (dY <> 0) Then
xi = Int(0.5 + (Dx / dY) * (poly_clip_max_y - Y1) + X1)
Else
xi = -1 '// invalidate inntersection
End If
' End If 'bottom
ElseIf (Y2 < poly_clip_min_y) Then 'top edge
top_edge = 1 '// flag top edge
'// compute intersection with top edge
If (dY <> 0) Then
xi = Int(0.5 + (Dx / dY) * (poly_clip_min_y - Y1) + X1)
Else
xi = -1 '// invalidate inntersection
End If
End If 'top
'// SECTION 5 /////////////////////////////////////////////////////////////////
' // now we know where the line passed thru
' // compute which edge is the proper intersection
If (right_edge = 1 And (yi >= poly_clip_min_y And yi <= poly_clip_max_y)) Then
X2 = poly_clip_max_x
Y2 = yi
success = 1
'End If 'intersected right edge
ElseIf (left_edge = 1 And (yi >= poly_clip_min_y And yi <= poly_clip_max_y)) Then
X2 = poly_clip_min_x
Y2 = yi
success = 1
End If 'intersected left edge
If (bottom_edge = 1 And (xi >= poly_clip_min_x And xi <= poly_clip_max_x)) Then
X2 = xi
Y2 = poly_clip_max_y
success = 1
'End If 'intersected bottom edge
ElseIf (top_edge = 1 And (xi >= poly_clip_min_x And xi <= poly_clip_max_x)) Then
X2 = xi
Y2 = poly_clip_min_y
success = 1
End If 'intersected top edge
End If 'point_1 is visible
'// SECTION 6 /////////////////////////////////////////////////////////////////
'// reset edge flags
right_edge = 0
left_edge = 0
top_edge = 0
bottom_edge = 0
'// test second endpoint
If ((point_2 = 1) Or (point_1 = 0 And point_2 = 0)) Then
' // compute deltas
Dx = X1 - X2
dY = Y1 - Y2
' // compute what boundary line need to be clipped against
If (X1 > poly_clip_max_x) Then
right_edge = 1 '// flag right edge
'// compute intersection with right edge
If (Dx <> 0) Then
yi = Int(0.5 + (dY / Dx) * (poly_clip_max_x - X2) + Y2)
Else
yi = -1 '// invalidate inntersection
End If '// to right
ElseIf (X1 < poly_clip_min_x) Then
left_edge = 1 '// flag left edge @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'// compute intersection with left edge
If (Dx <> 0) Then
yi = Int(0.5 + (dY / Dx) * (poly_clip_min_x - X2) + Y2)
Else
yi = -1 '// invalidate intersection
End If 'to left
'// horizontal intersections
ElseIf (Y1 > poly_clip_max_y) Then
'// flag bottom edge
bottom_edge = 1
'// compute intersection with right edge
If (dY <> 0) Then
xi = Int(0.5 + (Dx / dY) * (poly_clip_max_y - Y2) + X2)
Else
xi = -1 '// invalidate inntersection
End If 'bottom
ElseIf (Y1 < poly_clip_min_y) Then
'// flag top edge
top_edge = 1
'// compute intersection with top edge
If (dY <> 0) Then
xi = Int(0.5 + (Dx / dY) * (poly_clip_min_y - Y2) + X2)
Else
xi = -1 '// invalidate inntersection
End If 'top
End If
'// now we know where the line passed thru
'// compute which edge is the proper intersection
If (right_edge = 1 And (yi >= poly_clip_min_y And yi <= poly_clip_max_y)) Then
X1 = poly_clip_max_x
Y1 = yi
success = 1
End If 'intersected right edge
If (left_edge = 1 And (yi >= poly_clip_min_y And yi <= poly_clip_max_y)) Then
X1 = poly_clip_min_x
Y1 = yi
success = 1
End If 'intersected left edge
If (bottom_edge = 1 And (xi >= poly_clip_min_x And xi <= poly_clip_max_x)) Then
X1 = xi
Y1 = poly_clip_max_y
success = 1
End If 'intersected bottom edge
If (top_edge = 1 And (xi >= poly_clip_min_x And xi <= poly_clip_max_x)) Then
X1 = xi
Y1 = poly_clip_min_y
success = 1
End If 'intersected top edge
End If 'point_2 is visible
'// SECTION 7 /////////////////////////////////////////////////////////////////
If success = 1 Then
ClipReturn = True 'return(success);
Else
ClipReturn = False
End If
' // end Clip_Line
End Sub
Public Sub landstuff()
Dim biggyx, biggyy As Integer
Dim x As Integer
Dim y As Integer
Dim Temporary(32, 32) As Single
Dim TempTarget(32, 32) As Boolean
Dim Q As Integer
Static GotoLanding As Boolean
'""""""""""""""""determine display matrix step and offset"""""""""""""""""""
If LmAlt >= 1000 Then 'you are ok mag factor 0
DoubleFlag = 0
Doublein = 1
DoubleStart = 0
Mag = 1
ElseIf LmAlt >= 750 Then 'you are ok mag factor 1
DoubleFlag = 1
Doublein = 2
DoubleStart = 8
Mag = 2
ElseIf LmAlt >= 500 Then 'you are ok mag factor 2
DoubleFlag = 3
Doublein = 4
DoubleStart = 12
Mag = 4
ElseIf LmAlt >= 400 Then
DoubleFlag = 3
Doublein = 4
DoubleStart = 12
Mag = 4
GotoLanding = True
ElseIf LmAlt < 400 Then
DoubleFlag = 3
Doublein = 4
DoubleStart = 12
Mag = 4
GotoLanding = True
'ElseIf LmAlt < 400 Then 'you are ok mag factor 3
' GotoLanding = True
' DoubleFlag = 3
' Doublein = 4
' DoubleStart = 12
' Mag = 4
End If
blueLine DoubleFlag
'"""""""""""""""""""""""""""""""""""""""y maginification"""""""""""""""""""""""""""""""""""
biggyy = DoubleStart + starty - 1
For y = starty To starty + 31 Step Doublein 'these indices are stepped depending on mag factor
biggyy = biggyy + 1
biggyx = DoubleStart + startx - 1
For x = startx To startx + 31
biggyx = biggyx + 1
Select Case DoubleFlag
Case Is = 0
Temporary(x - startx, y - starty) = (1 + Biggy(biggyx, biggyy)) * Mag
TempTarget(x - startx, y - starty) = TargetBiggy(biggyx, biggyy)
Case Is = 1
Temporary(x - startx, y - starty) = (2 + Biggy(biggyx, biggyy)) * Mag
Temporary(x - startx, y - starty + 1) = (2 + 0.5 * Biggy(biggyx, biggyy) + 0.5 * Biggy(biggyx, biggyy + 1)) * Mag
TempTarget(x - startx, y - starty) = TargetBiggy(biggyx, biggyy)
TempTarget(x - startx, y - starty + 1) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
Case Is = 3
Temporary(x - startx, y - starty) = (4 + Biggy(biggyx, biggyy)) * Mag
Temporary(x - startx, y - starty + 1) = (4 + 0.75 * Biggy(biggyx, biggyy) + 0.25 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 2) = (4 + 0.5 * Biggy(biggyx, biggyy) + 0.5 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 3) = (4 + 0.25 * Biggy(biggyx, biggyy) + 0.75 * Biggy(biggyx, biggyy + 1)) * Mag
TempTarget(x - startx, y - starty) = TargetBiggy(biggyx, biggyy)
TempTarget(x - startx, y - starty + 1) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 2) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 3) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
Case Is = 7
Temporary(x - startx, y - starty) = (8 + Biggy(biggyx, biggyy)) * Mag
Temporary(x - startx, y - starty + 1) = (8 + 0.875 * Biggy(biggyx, biggyy) + 0.125 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 2) = (8 + 0.75 * Biggy(biggyx, biggyy) + 0.25 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 3) = (8 + 0.625 * Biggy(biggyx, biggyy) + 0.375 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 4) = (8 + 0.5 * Biggy(biggyx, biggyy) + 0.5 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 5) = (8 + 0.375 * Biggy(biggyx, biggyy) + 0.625 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 6) = (8 + 0.25 * Biggy(biggyx, biggyy) + 0.75 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 7) = (8 + 0.125 * Biggy(biggyx, biggyy) + 0.875 * Biggy(biggyx, biggyy + 1)) * Mag
TempTarget(x - startx, y - starty) = TargetBiggy(biggyx, biggyy)
TempTarget(x - startx, y - starty + 1) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 2) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 3) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 4) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 5) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 6) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 7) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
Case Is = 15
Temporary(x - startx, y - starty) = (16 + Biggy(biggyx, biggyy)) * Mag
Temporary(x - startx, y - starty + 1) = (16 + 0.9375 * Biggy(biggyx, biggyy) + 0.0625 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 2) = (16 + 0.875 * Biggy(biggyx, biggyy) + 0.125 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 3) = (16 + 0.8125 * Biggy(biggyx, biggyy) + 0.1875 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 4) = (16 + 0.75 * Biggy(biggyx, biggyy) + 0.25 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 5) = (16 + 0.6875 * Biggy(biggyx, biggyy) + 0.3125 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 6) = (16 + 0.625 * Biggy(biggyx, biggyy) + 0.375 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 7) = (16 + 0.5625 * Biggy(biggyx, biggyy) + 0.4375 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 8) = (16 + 0.5 * Biggy(biggyx, biggyy) + 0.5 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 9) = (16 + 0.4375 * Biggy(biggyx, biggyy) + 0.5625 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 10) = (16 + 0.375 * Biggy(biggyx, biggyy) + 0.625 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 11) = (16 + 0.3125 * Biggy(biggyx, biggyy) + 0.6875 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 12) = (16 + 0.25 * Biggy(biggyx, biggyy) + 0.75 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 13) = (16 + 0.1875 * Biggy(biggyx, biggyy) + 0.8125 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 14) = (16 + 0.125 * Biggy(biggyx, biggyy) + 0.875 * Biggy(biggyx, biggyy + 1)) * Mag
Temporary(x - startx, y - starty + 15) = (16 + 0.0625 * Biggy(biggyx, biggyy) + 0.9375 * Biggy(biggyx, biggyy + 1)) * Mag
TempTarget(x - startx, y - starty) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 1) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 2) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 3) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 4) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 5) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 6) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 7) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 8) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 9) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 10) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 11) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 12) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 13) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 14) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
TempTarget(x - startx, y - starty + 15) = TargetBiggy(biggyx, biggyy) Or TargetBiggy(biggyx, biggyy + 1)
End Select
Next x
Next y
'""""""""""""""""""""""""""""""""""""x magnification"""""""""""""""""""""""""""""""""""""
biggyx = -1
For x = 0 To 31 Step Doublein 'these indices are stepped depending on mag factor
biggyx = biggyx + 1
biggyy = -1
For y = 0 To 31
biggyy = biggyy + 1
Select Case DoubleFlag
Case Is = 0
Display(x, y) = 1 + Temporary(biggyx, biggyy)
TargetDisplay(x, y) = TempTarget(biggyx, biggyy)
Case Is = 1
Display(x, y) = 2 + Temporary(biggyx, biggyy)
Display(x + 1, y) = (2 + 0.5 * Temporary(biggyx, biggyy) + 0.5 * Temporary(biggyx + 1, biggyy))
TargetDisplay(x, y) = TempTarget(biggyx, biggyy)
TargetDisplay(x + 1, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
Case Is = 3
Display(x, y) = 4 + Temporary(biggyx, biggyy)
Display(x + 1, y) = (4 + 0.75 * Temporary(biggyx, biggyy) + 0.25 * Temporary(biggyx + 1, biggyy))
Display(x + 2, y) = (4 + 0.5 * Temporary(biggyx, biggyy) + 0.5 * Temporary(biggyx + 1, biggyy))
Display(x + 3, y) = (4 + 0.25 * Temporary(biggyx, biggyy) + 0.75 * Temporary(biggyx + 1, biggyy))
TargetDisplay(x, y) = TempTarget(biggyx, biggyy)
TargetDisplay(x + 1, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 2, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 3, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
Case Is = 7
Display(x, y) = 8 + Temporary(biggyx, biggyy)
Display(x + 1, y) = (8 + 0.875 * Temporary(biggyx, biggyy) + 0.125 * Temporary(biggyx + 1, biggyy))
Display(x + 2, y) = (8 + 0.75 * Temporary(biggyx, biggyy) + 0.25 * Temporary(biggyx + 1, biggyy))
Display(x + 3, y) = (8 + 0.625 * Temporary(biggyx, biggyy) + 0.375 * Temporary(biggyx + 1, biggyy))
Display(x + 4, y) = (8 + 0.5 * Temporary(biggyx, biggyy) + 0.5 * Temporary(biggyx + 1, biggyy))
Display(x + 5, y) = (8 + 0.375 * Temporary(biggyx, biggyy) + 0.625 * Temporary(biggyx + 1, biggyy))
Display(x + 6, y) = (8 + 0.25 * Temporary(biggyx, biggyy) + 0.75 * Temporary(biggyx + 1, biggyy))
Display(x + 7, y) = (8 + 0.125 * Temporary(biggyx, biggyy) + 0.875 * Temporary(biggyx + 1, biggyy))
TargetDisplay(x, y) = TempTarget(biggyx, biggyy)
TargetDisplay(x + 1, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 2, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 3, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 4, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 5, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 6, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 7, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
Case Is = 15
Display(x, y) = 16 + Temporary(biggyx, biggyy)
Display(x + 1, y) = (16 + 0.9375 * Temporary(biggyx, biggyy) + 0.0625 * Temporary(biggyx + 1, biggyy))
Display(x + 2, y) = (16 + 0.875 * Temporary(biggyx, biggyy) + 0.125 * Temporary(biggyx + 1, biggyy))
Display(x + 3, y) = (16 + 0.8125 * Temporary(biggyx, biggyy) + 0.1875 * Temporary(biggyx + 1, biggyy))
Display(x + 4, y) = (16 + 0.75 * Temporary(biggyx, biggyy) + 0.25 * Temporary(biggyx + 1, biggyy))
Display(x + 5, y) = (16 + 0.6875 * Temporary(biggyx, biggyy) + 0.3125 * Temporary(biggyx + 1, biggyy))
Display(x + 6, y) = (16 + 0.625 * Temporary(biggyx, biggyy) + 0.375 * Temporary(biggyx + 1, biggyy))
Display(x + 7, y) = (16 + 0.5625 * Temporary(biggyx, biggyy) + 0.4375 * Temporary(biggyx + 1, biggyy))
Display(x + 8, y) = (16 + 0.5 * Temporary(biggyx, biggyy) + 0.5 * Temporary(biggyx + 1, biggyy))
Display(x + 9, y) = (16 + 0.4375 * Temporary(biggyx, biggyy) + 0.5625 * Temporary(biggyx + 1, biggyy))
Display(x + 10, y) = (16 + 0.375 * Temporary(biggyx, biggyy) + 0.625 * Temporary(biggyx + 1, biggyy))
Display(x + 11, y) = (16 + 0.3125 * Temporary(biggyx, biggyy) + 0.6875 * Temporary(biggyx + 1, biggyy))
Display(x + 12, y) = (16 + 0.25 * Temporary(biggyx, biggyy) + 0.75 * Temporary(biggyx + 1, biggyy))
Display(x + 13, y) = (16 + 0.1875 * Temporary(biggyx, biggyy) + 0.8125 * Temporary(biggyx + 1, biggyy))
Display(x + 14, y) = (16 + 0.125 * Temporary(biggyx, biggyy) + 0.875 * Temporary(biggyx + 1, biggyy))
Display(x + 15, y) = (16 + 0.0625 * Temporary(biggyx, biggyy) + 0.9375 * Temporary(biggyx + 1, biggyy))
TargetDisplay(x, y) = TempTarget(biggyx, biggyy)
TargetDisplay(x + 1, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 2, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 3, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 4, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 5, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 6, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 7, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 8, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 9, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 10, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 11, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 12, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 13, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 14, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
TargetDisplay(x + 15, y) = TempTarget(biggyx + 1, biggyy) Or TargetBiggy(biggyx, biggyy)
End Select
Next y
Next x
dirtLevel = ((Display(16, 24) / Mag) * 15.6)
AltiMeter = LmAlt - dirtLevel
AltiMeterReading = AltiMeter
FwdDist = 33 * (starty + DoubleStart + (24 / Mag))
LatDist = 33 * (startx + DoubleStart + (16 / Mag))
joyPolling ' this is a joystick call
If StopEverything Then Exit Sub
If (LatDist / 33) < 133 Then
PorSta = "Starboard"
ElseIf (LatDist / 33) = 133 Then
PorSta = ""
Else
PorSta = "Port"
End If
If (FwdDist / 33) < 93 Then
ForRev = "Rev"
ElseIf (FwdDist / 33) = 93 Then
ForRev = ""
Else
ForRev = "Fwd"
End If
Direction = ForRev + " " + PorSta
If startx >= 268 Or startx <= 32 Then 'outtabounds
collision 0 ' 0 - out of bounds
If StopEverything Then Exit Sub
End If
If starty >= 368 Or starty <= 32 Then
collision 0
If StopEverything Then Exit Sub
End If
If GotoLanding Then
Ydock = 0
For x = 15 To 17
For y = 23 To 25
If TargetDisplay(x, y) Then
PaintLandingSite = True
End If
Next y
Next x
For Q = 0 To 3
auxjoy(Q).Enabled = False
Command2(Int(Q / 2)).Enabled = False
Next Q
docking.Timer2.Enabled = False
frmTime.masterTimer.Enabled = False
Me.Hide
StopEverything = True
GotoApland = True
If GotoApland = True Then
Apland.Show
If YouAreDead Then
docking.collision 0
Else
If BullsEye Then
docking.collision 4
ElseIf PaintLandingSite Then
docking.collision 5
Else
docking.collision 3
End If
End If
End If
End If
End Sub
Public Sub DrawBox()
picBackground.Line (Box(0, 0), Box(0, 1))-(Box(1, 0), Box(1, 1)), QBColor(15)
picBackground.Line -(Box(2, 0), Box(2, 1)), QBColor(15)
picBackground.Line -(Box(3, 0), Box(3, 1)), QBColor(15)
picBackground.Line -(Box(0, 0), Box(0, 1)), QBColor(15)
End Sub
Public Sub collision(Result As Integer)
Dim SplatText As String
diedFlag = True
Select Case Result
Case Is = 0 ' abort? <---------------------------------------------rick setup abort
CompUnload = True
Unload Apland
CompUnload = False
frmTime.masterTimer.Enabled = True
Case Is = 1 ' general crash scene 1
If LmAlt <= 6 * 15.6 Then
frmTime.PlayAVI "death\shot21.avi", 3
SplatText = "goin' too flippin' fast in a crater"
Else 'LmAlt >= 8 * 15.6 Then
frmTime.PlayAVI "death\shot22.avi", 3
SplatText = "goin' too darn fast near a mountain"
End If
Case Is = 2
frmTime.PlayAVI "death\shot20.avi", 3
Case Is = 3
'oh damn, I can't reach it mvi
frmTime.masterTimer.Enabled = True
CompUnload = True
Unload Apland
CompUnload = False
SplatText = "so close you can smell it. Too bad you cant take it."
OnTheMoon = True
CanReachIt = False
diedFlag = False
frmTime.masterTimer.Enabled = True
CompUnload = True
Unload Apland
CompUnload = False
Case Is = 4
'happy happy joy joy mvi
frmTime.PlayAVI "success\shot19a.avi", 3
frmTime.PlayAVI "success\shot19c.avi", 3
OnTheMoon = True
CanReachIt = True
SplatText = "hory cow, you did it!"
diedFlag = False
MissionState = 7
frmTime.masterTimer.Enabled = True
CompUnload = True
Unload Apland
CompUnload = False
Case Is = 5
'your a loser, you couldn't even get close to the target mvi
SplatText = "you suck. try asteroids."
OnTheMoon = True
CanReachIt = False
diedFlag = False
frmTime.masterTimer.Enabled = True
CompUnload = True
Unload Apland
CompUnload = False
End Select
SplatTextBox.Text = SplatText
text1.Text = "True Alt = 0"
Text2.Text = "Your X " + Str(startx + 16) '"fuel"
Text3.Text = " "
Text4.Text = "Your Y " + Str(starty + 16) '"RCS"
Text5.Text = "Fwd Vel = 0"
Text6.Text = "Lat Vel = 0"
distance.Caption = "0"
closerate.Caption = "0"
DoCurve = False
Me.Visible = False
MissionState = 7
If Not diedFlag Then
Met = 1670
fivek = 5
StopEverything = True
OkToLand = False
Else
diedFlag = False
StopEverything = True
Met = 1660
fivek = 5
OkToLand = False
End If
End Sub
Public Sub blueLine(whatLine As Integer)
Dim k, j As Integer
For k = 0 To 31 'initialize bluedline to green
BluedLine(k) = 2
Next k
Select Case whatLine
Case Is = 1 'Alt 599
For k = 1 To 31 Step 2
BluedLine(k) = 8 '1 fake line
Next k
Case Is = 3 'alt 449
For k = 1 To 31 Step 4
For j = 0 To 2 ' three fake lines
BluedLine(k + j) = 8
Next j
Next k
Case Is = 7 'alt 199
For k = 1 To 31 Step 8
For j = 0 To 6 'seven fake lines
BluedLine(k + j) = 8
Next j
Next k
Case Is = 15
For k = 1 To 31 Step 16
For j = 0 To 14 'fifteen fake lines
BluedLine(k + j) = 8
Next j
Next k
Case Is = 999
End Select
BluedLine(24) = 10
'Label1.Caption = "x = " + Str(startx + 24)
'Label2.Caption = "y = " + Str(starty + 25)
End Sub
Public Sub joyPolling()
Dim WhereAmI, whereisX, whereisY, wheretoken As Integer
Dim rc As Long
Dim x As Integer
Rem Joystick
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
DoEvents
Rem --- check for left or right
whereisX = 0
If JoyInfo.x < leftX Then
whereisX = -1
Else
If JoyInfo.x > rightX Then
whereisX = 1
End If
End If
Rem --- check for up or down
whereisY = 0
If JoyInfo.y < topY Then
whereisY = -1
ElseIf JoyInfo.y > bottomY Then
whereisY = 1
End If
wheretoken = whereisX + whereisY
WhereAmI = 4
If wheretoken = 1 And whereisX = 1 Then
WhereAmI = 1
ElseIf wheretoken = 1 And whereisX <> 1 Then
WhereAmI = 2
End If
If wheretoken = -1 And whereisY = -1 Then
WhereAmI = 0
ElseIf wheretoken = -1 And whereisY <> -1 Then
WhereAmI = 3
End If
Command1.Caption = WhereAmI
If WhereAmI <> 4 Then
Call JoyControl((WhereAmI))
End If
If JoyInfo.ButtonDown(1) Then
Select Case WhereAmI
Case Is = 0
x = frmTime.playSound(CDdrive + "\sfx\rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock - 1
Call JoyControl(0)
Case Is = 1
x = frmTime.playSound(CDdrive + "\sfx\rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock + 1
LatVel = Xdock * 33
Call JoyControl(1)
Case Is = 2
x = frmTime.playSound(CDdrive + "\sfx\rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock + 1
Call JoyControl(2)
Case Is = 3
x = frmTime.playSound(CDdrive + "\sfx\rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock - 1
LatVel = Xdock * 33
Call JoyControl(3)
End Select
End If
If JoyInfo.ButtonDown(2) Then
Select Case WhereAmI
Case Is = 0
x = frmTime.playSound(CDdrive + "\sfx\rcstrst.wav", EFFECTS, NO_LUPE)
Zdock = Zdock - 1
FwdVel = -Zdock * 33
Case Is = 2
x = frmTime.playSound(CDdrive + "\sfx\rcstrst.wav", EFFECTS, NO_LUPE)
Zdock = Zdock + 1
FwdVel = -Zdock * 33
End Select
End If
Rem
Rem
Rem end joystick
End Sub
Sub Timer3_Timer()
Static Xpos As Integer
Static Ypos As Integer
Dim rc As Long
Static Scountz As Integer
Static Secondz As Integer
Static WaitCountz As Integer
Static NotFirstTime2 As Boolean
Static NotFirstTime1 As Boolean
Static xComponent As Integer
Static yComponent As Integer
Dim x As Integer
'Dim i As Integer
Dim WhereAmI, whereisX, whereisY, wheretoken As Integer
'lblZ = ldist
Dim currpath As String
If Not NotFirstTime2 Then
If Not NotFirstTime1 Then
StarSeconds = Int(StarSeconds / 2)
Xdock = firstXpos
Ydock = firstYpos
NotFirstTime1 = True
Xpos = 0
Ypos = 0
BG_NewX = 0
BG_NewY = 0
Else
Xdock = 0
Ydock = 0
NotFirstTime2 = True
End If
End If
If Not WaitingToLeave Then
Scountz = Scountz + 1
If Scountz >= 20 Then
Scountz = 0
Secondz = Secondz + 1
If Secondz >= StarSeconds Then
StarCrossed = False
goGame = 0
Reason = 26
YouAreDead = True
Timer3.Enabled = False
docking.Visible = False
Exit Sub
End If
End If
Else
WaitCountz = WaitCountz + 1
If WaitCountz >= 100 Then
DoEvents
StarCrossed = False
Scountz = 0
Secondz = 0
WaitCountz = 0
WaitingToLeave = False
NotFirstTime1 = False
NotFirstTime2 = False
Male = 3
Female = 1
frmTime.Transfer
End If
Exit Sub
End If
currpath = CDdrive + "\docking\csm4\"
closerate.Visible = True
distance.Visible = True
closerate.Caption = pubXpos
distance.Caption = pubYpos
Secondz = 0
'closerate.Caption = " N/A"
'distance.Caption = "N/A"
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
Rem ********************************************************************************
Xpos = Xpos - Xdock
Ypos = Ypos - Ydock
UpdateBackground
Rem --- if x is off left side ---
If Xpos < -picPitSprite.ScaleWidth + picImage.ScaleWidth Then
Xpos = 800 - picPitSprite.ScaleWidth + picImage.ScaleWidth
Else 'if off right side
If Xpos > 800 - picImage.ScaleWidth Then Xpos = 0 - picImage.ScaleWidth
End If
Rem --- if y is off top side ---
If Ypos < -picImage.ScaleHeight Then
Ypos = 600 - picImage.ScaleHeight
Else 'if off bottom
If Ypos > 600 - picImage.ScaleHeight Then Ypos = 0 - picImage.ScaleHeight
End If
' Copy a section of the large bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitMask.hDC, 0, 0, SRCAND)
'draw cockpit
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitSprite.hDC, 0, 0, SRCPAINT)
' Draw the whole thing back onto the screen.
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.Width, picBackground.Height, picWorkBG.hDC, 0, 0, SRCCOPY)
auxjoy(0).Visible = True
auxjoy(1).Visible = True
auxjoy(2).Visible = True
auxjoy(3).Visible = True
auxcon(0).Picture = auxcon(5).Picture
Rem
Rem
Rem Joystick
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
Rem --- check for left or right
whereisX = 0
If JoyInfo.x < leftX Then
whereisX = -1
Else
If JoyInfo.x > rightX Then
whereisX = 1
End If
End If
Rem --- check for up or down
whereisY = 0
If JoyInfo.y < topY Then
whereisY = -1
Else
If JoyInfo.y > bottomY Then
whereisY = 1
End If
End If
wheretoken = whereisX + whereisY
WhereAmI = 4
If wheretoken = 1 Then
If whereisX = 1 Then
WhereAmI = 1
Else
WhereAmI = 2
End If
End If
If wheretoken = -1 Then
If whereisY = -1 Then
WhereAmI = 0
Else
WhereAmI = 3
End If
End If
Command1.Caption = WhereAmI
If WhereAmI <> 4 Then
Call JoyControl((WhereAmI))
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 1 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock + 1
'xComponent = xComponent + 1
Call JoyControl(1)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 3 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock - 1
'xComponent = xComponent - 1
Call JoyControl(3)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 2 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock + 1
'yComponent = yComponent + 1
Call JoyControl(2)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 0 Then
x = frmTime.playSound(CDdrive + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock - 1
'yComponent = yComponent - 1
Call JoyControl(0)
End If
pubXpos = Xpos
pubYpos = Ypos
End Sub
Sub VScroll1_Change()
Dim temp As Integer
Dim tdigs(3) As Integer
contThrust = VScroll1 'vscroll1 is the value of the slider
temp = contThrust
tdigs(0) = contThrust Mod 10
temp = temp - tdigs(0)
tdigs(1) = temp / 10
If tdigs(1) >= 10 Then
tdigs(1) = tdigs(1) - 10
tdigs(2) = 1
Else
tdigs(2) = 0
End If
docking.dockThrust(0).Picture = frmTime.imgdnum(tdigs(0)).Picture
docking.dockThrust(1).Picture = frmTime.imgdnum(tdigs(1)).Picture
docking.dockThrust(2).Picture = frmTime.imgdnum(tdigs(2)).Picture
End Sub
DOCKING2.LOG
Line 245: Property Picture in auxcon could not be set.
\CALIBRAT
JOYTEST1.FRM
VERSION 4.00
Begin VB.Form Form1
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Joystick Example"
ClientHeight = 6405
ClientLeft = 1035
ClientTop = 1650
ClientWidth = 6765
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 6810
Left = 975
LinkTopic = "Form1"
ScaleHeight = 6405
ScaleWidth = 6765
Top = 1305
Width = 6885
Begin VB.CommandButton Command1
Caption = "Set Center"
Height = 495
Left = 2190
TabIndex = 26
Top = 4335
Width = 1215
End
Begin VB.CommandButton btnCancel
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Cancel"
Height = 375
Left = 4620
TabIndex = 1
Top = 2520
Width = 1095
End
Begin VB.Timer Timer1
Interval = 22
Left = 5700
Top = 0
End
Begin VB.PictureBox picBackground
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H00008000&
ForeColor = &H80000008&
Height = 2715
Left = 240
ScaleHeight = 2685
ScaleWidth = 4005
TabIndex = 0
Top = 240
Width = 4035
Begin VB.Image imgJoyCursor
Appearance = 0 'Flat
Height = 165
Left = 1140
Picture = "JOYTEST1.frx":0000
Top = 1320
Width = 165
End
Begin VB.Label lblButton
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H000000FF&
BorderStyle = 1 'Fixed Single
Caption = "Button 4"
ForeColor = &H80000008&
Height = 255
Index = 3
Left = 3000
TabIndex = 4
Top = 2340
Width = 915
End
Begin VB.Label lblButton
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H000000FF&
BorderStyle = 1 'Fixed Single
Caption = "Button 3"
ForeColor = &H80000008&
Height = 255
Index = 2
Left = 60
TabIndex = 6
Top = 2340
Width = 915
End
Begin VB.Label lblButton
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H000000FF&
BorderStyle = 1 'Fixed Single
Caption = "Button 2"
ForeColor = &H80000008&
Height = 255
Index = 1
Left = 3000
TabIndex = 5
Top = 60
Width = 915
End
Begin VB.Label lblButton
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H000000FF&
BorderStyle = 1 'Fixed Single
Caption = "Button 1"
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 60
TabIndex = 3
Top = 60
Width = 915
End
End
Begin VB.Label Label20
AutoSize = -1 'True
Caption = "bottom y limit"
ForeColor = &H00FFFF00&
Height = 195
Left = 5115
TabIndex = 36
Top = 5535
Width = 1125
End
Begin VB.Label Label19
AutoSize = -1 'True
Caption = "top y limit"
ForeColor = &H00FFFF00&
Height = 195
Left = 5325
TabIndex = 35
Top = 4560
Width = 825
End
Begin VB.Label Label18
AutoSize = -1 'True
Caption = "right x limit"
ForeColor = &H00FFFF00&
Height = 195
Left = 405
TabIndex = 34
Top = 5610
Width = 930
End
Begin VB.Label Label17
AutoSize = -1 'True
Caption = "left x limit"
ForeColor = &H00FFFF00&
Height = 195
Left = 480
TabIndex = 33
Top = 4710
Width = 825
End
Begin VB.Label Label16
Caption = "Label16"
Height = 495
Left = 5115
TabIndex = 32
Top = 5835
Width = 1215
End
Begin VB.Label Label15
Caption = "Label15"
Height = 495
Left = 5085
TabIndex = 31
Top = 4905
Width = 1215
End
Begin VB.Label Label14
Caption = "Label14"
Height = 495
Left = 285
TabIndex = 30
Top = 5850
Width = 1290
End
Begin VB.Label Label13
Caption = "Label13"
Height = 495
Left = 360
TabIndex = 29
Top = 4980
Width = 1215
End
Begin VB.Label Label12
AutoSize = -1 'True
BackColor = &H00FFFF00&
Caption = "Label12"
ForeColor = &H000000FF&
Height = 195
Left = 4065
TabIndex = 28
Top = 4365
Width = 690
End
Begin VB.Label Label11
AutoSize = -1 'True
BackColor = &H00FFFF00&
Caption = "Label11"
ForeColor = &H000000FF&
Height = 195
Left = 720
TabIndex = 27
Top = 4320
Width = 690
End
Begin VB.Label Label10
Caption = "Label10"
ForeColor = &H0000C000&
Height = 495
Left = 4485
TabIndex = 25
Top = 3630
Width = 1215
End
Begin VB.Label Label9
Caption = "Label9"
ForeColor = &H0000C000&
Height = 495
Left = 3060
TabIndex = 24
Top = 3645
Width = 1215
End
Begin VB.Label Label8
Caption = "Label8"
ForeColor = &H0000C000&
Height = 495
Left = 1605
TabIndex = 23
Top = 3675
Width = 1215
End
Begin VB.Label Label7
Caption = "Label7"
ForeColor = &H0000C000&
Height = 495
Left = 135
TabIndex = 22
Top = 3630
Width = 1215
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "Left"
Height = 195
Left = 4470
TabIndex = 21
Top = 3285
Width = 345
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "Bottom"
Height = 195
Left = 3090
TabIndex = 20
Top = 3315
Width = 600
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "Right"
Height = 195
Left = 1695
TabIndex = 19
Top = 3345
Width = 465
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "Top "
Height = 195
Left = 255
TabIndex = 18
Top = 3330
Width = 405
End
Begin VB.Label lblMinY
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00800000&
Height = 195
Left = 5100
TabIndex = 17
Top = 2040
Width = 735
End
Begin VB.Label lblMaxY
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00800000&
Height = 195
Left = 5100
TabIndex = 16
Top = 1800
Width = 735
End
Begin VB.Label lblMinX
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00800000&
Height = 195
Left = 5100
TabIndex = 15
Top = 1500
Width = 735
End
Begin VB.Label lblMaxX
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00800000&
Height = 195
Left = 5100
TabIndex = 14
Top = 1260
Width = 735
End
Begin VB.Label lblY
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00800000&
Height = 195
Left = 5100
TabIndex = 13
Top = 720
Width = 735
End
Begin VB.Label lblX
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00800000&
Height = 195
Left = 5100
TabIndex = 12
Top = 540
Width = 735
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Min Y:"
ForeColor = &H80000008&
Height = 195
Index = 4
Left = 4440
TabIndex = 11
Top = 2040
Width = 735
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Max Y:"
ForeColor = &H80000008&
Height = 195
Index = 3
Left = 4440
TabIndex = 10
Top = 1800
Width = 735
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Min X:"
ForeColor = &H80000008&
Height = 195
Index = 2
Left = 4440
TabIndex = 9
Top = 1500
Width = 735
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Max X:"
ForeColor = &H80000008&
Height = 195
Index = 1
Left = 4440
TabIndex = 8
Top = 1260
Width = 735
End
Begin VB.Label Label2
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Y:"
ForeColor = &H80000008&
Height = 195
Left = 4440
TabIndex = 7
Top = 780
Width = 735
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "X:"
ForeColor = &H80000008&
Height = 195
Index = 0
Left = 4440
TabIndex = 2
Top = 540
Width = 735
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------
' Constants and module-level variables used by
' JOYTEST1.FRM.
'-------------------------------------------------------
Dim JoyInfo As tJoyInfo
Dim RangeWidth As Integer
Dim RangeHeight As Integer
Const YELLOW = &HFFFF&
Const RED = &HFF&
Dim topj, leftj, rightj, bottomj As Long
Private Sub btnCancel_Click()
'-------------------------------------------------------
' Exit the program when the Cancel button is pressed.
'-------------------------------------------------------
Unload Me
End Sub
Private Sub Command1_Click()
Dim centx, centy, leftX, rightX, topY, bottomY As Long
Dim tempx, tempy As Long
centx = lblX
centy = lblY
label11.Caption = "Centerx " + centx
Label12.Caption = "Centery " + centy
leftX = (centx - leftj) / 2
tempx = (rightj - centx) / 2
rightX = rightj - tempx
tempy = (centy - topj) / 2
topY = bottomj - tempy
bottomY = (bottomj - centy) / 2
Label13.Caption = leftX
Label14.Caption = rightX
Label15.Caption = topY
Label16.Caption = bottomY
End Sub
Private Sub Form_Load()
'-------------------------------------------------------
' Set the range for the little on-screen joystick cursor.
'-------------------------------------------------------
RangeWidth = picBackground.ScaleWidth - imgJoyCursor.Width
RangeHeight = picBackground.ScaleHeight - imgJoyCursor.Height
End Sub
Private Sub Timer1_Timer()
'-------------------------------------------------------
' The timer routine constantly polls the joystick to
' determine the current positions and button states,
' and changes the screen accordingly.
'-------------------------------------------------------
Dim rc As Integer
Dim i As Integer
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If rc = 0 Then
imgJoyCursor.Left = RangeWidth * ((JoyInfo.X - JoyCaps.Xmin) / (JoyCaps.Xmax - JoyCaps.Xmin))
imgJoyCursor.Top = RangeHeight * ((JoyInfo.Y - JoyCaps.Ymin) / (JoyCaps.Ymax - JoyCaps.Ymin))
lblX = JoyInfo.X
lblY = JoyInfo.Y
lblMinX = JoyCaps.Xmin
lblMaxX = JoyCaps.Xmax
lblMinY = JoyCaps.Ymin
lblMaxY = JoyCaps.Ymax
If JoyInfo.ButtonDown(1) Then
If lblButton(1).BackColor <> RED Then lblButton(1).BackColor = RED
leftj = JoyInfo.X
topj = JoyInfo.Y
End If
If JoyInfo.ButtonDown(2) Then
If lblButton(2).BackColor <> YELLOW Then lblButton(2).BackColor = YELLOW
rightj = JoyInfo.X
bottomj = JoyInfo.Y
End If
End If
Label7.Caption = topj
Label8.Caption = rightj
Label9.Caption = bottomj
Label10.Caption = leftj
End Sub
\CSM4
=DOCKING.FRM
VERSION 4.00
Begin VB.Form docking
Caption = "Docking with the Lunar Module"
ClientHeight = 7275
ClientLeft = 1185
ClientTop = 1590
ClientWidth = 9570
Height = 7680
Left = 1125
LinkTopic = "Form1"
Picture = "DOCKING.frx":0000
ScaleHeight = 7275
ScaleWidth = 9570
Top = 1245
Width = 9690
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 9690
TabIndex = 26
Top = 6690
Width = 1215
End
Begin VB.Frame Calibrate
Height = 4395
Left = 2490
TabIndex = 22
Top = 1620
Visible = 0 'False
Width = 5715
Begin VB.TextBox textCalibrator
BackColor = &H00FF0000&
ForeColor = &H00FFFFFF&
Height = 375
Left = 915
Locked = -1 'True
TabIndex = 24
Text = "Move Joystick to Upper Left and Press Button 1"
Top = 2010
Width = 3900
End
Begin VB.CommandButton centerCalibrate
Caption = "Center Joystick Then Press This Button"
Height = 495
Left = 825
TabIndex = 23
Top = 3120
Visible = 0 'False
Width = 3915
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Joystick Calibration"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 24
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 555
Left = 630
TabIndex = 25
Top = 735
Width = 4455
End
End
Begin VB.PictureBox PicSave
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 8565
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 20
Top = 7335
Width = 1755
End
Begin VB.PictureBox PicWork
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 6720
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 19
Top = 7335
Width = 1755
End
Begin VB.PictureBox PicMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 5085
Picture = "DOCKING.frx":4B444
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 18
Top = 7350
Width = 1500
End
Begin VB.PictureBox PicImage
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1410
Left = 3435
Picture = "DOCKING.frx":4DE08
ScaleHeight = 94
ScaleMode = 3 'Pixel
ScaleWidth = 99
TabIndex = 17
Top = 7320
Width = 1485
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 5
Left = 10110
Picture = "DOCKING.frx":50704
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 9
Top = 2385
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 4
Left = 10290
Picture = "DOCKING.frx":537D0
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 8
Top = 1635
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 3
Left = 10335
Picture = "DOCKING.frx":5689C
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 7
Top = 1215
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 2
Left = 9840
Picture = "DOCKING.frx":59968
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 6
Top = 555
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 1
Left = 9975
Picture = "DOCKING.frx":5CA34
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 5
Top = 135
Width = 1755
End
Begin VB.PictureBox picWorkBG
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00400000&
DragIcon = "DOCKING.frx":5FB00
ForeColor = &H80000008&
Height = 4860
Left = 2775
ScaleHeight = 322
ScaleMode = 3 'Pixel
ScaleWidth = 635
TabIndex = 4
Top = 7425
Width = 9555
End
Begin VB.PictureBox picBGoriginal
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 9015
Left = -8400
Picture = "DOCKING.frx":5FE0A
ScaleHeight = 599
ScaleMode = 3 'Pixel
ScaleWidth = 799
TabIndex = 1
Top = 7290
Width = 12015
End
Begin VB.PictureBox picPitMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 9795
Picture = "DOCKING.frx":D554E
ScaleHeight = 5205
ScaleWidth = 9600
TabIndex = 3
Top = 6555
Width = 9600
End
Begin VB.PictureBox picPitSprite
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 9765
Picture = "DOCKING.frx":10BD12
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 2
Top = 285
Width = 9600
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 55
Left = 9960
Top = 5865
End
Begin VB.PictureBox Picture4
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 7200
Left = -15
Picture = "DOCKING.frx":1424D6
ScaleHeight = 7200
ScaleWidth = 9600
TabIndex = 0
Top = 75
Width = 9600
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 0
Left = 3990
Picture = "DOCKING.frx":18D91A
ScaleHeight = 95
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 10
Top = 5520
Width = 1755
Begin Threed.SSCommand SSCommand1
Height = 330
Index = 1
Left = 1185
TabIndex = 14
Top = 1080
Width = 555
_version = 65536
_extentx = 979
_extenty = 582
_stockprops = 78
caption = "REV"
bevelwidth = 4
font3d = 4
End
Begin Threed.SSCommand SSCommand1
Height = 330
Index = 0
Left = 0
TabIndex = 13
Top = 1065
Width = 555
_version = 65536
_extentx = 979
_extenty = 582
_stockprops = 78
caption = "FWD"
bevelwidth = 4
font3d = 4
End
Begin VB.Image auxjoy
Height = 300
Index = 0
Left = 720
Top = 225
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 1
Left = 1035
Top = 555
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 2
Left = 720
Top = 870
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 3
Left = 390
Top = 555
Width = 300
End
End
Begin VB.PictureBox picBackground
Appearance = 0 'Flat
BackColor = &H00000000&
BorderStyle = 0 'None
DragIcon = "DOCKING.frx":1909E6
ForeColor = &H80000008&
Height = 5205
Left = 0
Picture = "DOCKING.frx":190CF0
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 21
Top = 90
Width = 9600
Begin VB.Image imgjoyCursor
Height = 225
Left = 2610
Picture = "DOCKING.frx":1C74B4
Top = 2910
Visible = 0 'False
Width = 225
End
End
Begin VB.Label distance
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1410
TabIndex = 16
Top = 6420
Width = 600
End
Begin VB.Label closerate
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1395
TabIndex = 15
Top = 5805
Width = 600
End
Begin Threed.SSCommand Leave
Height = 360
Left = 6120
TabIndex = 12
Top = 6615
Width = 3105
_version = 65536
_extentx = 5477
_extenty = 635
_stockprops = 78
caption = "EXIT"
BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713}
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
font3d = 4
End
Begin Threed.SSCommand start
Height = 360
Left = 6105
TabIndex = 11
Top = 6225
Width = 3105
_version = 65536
_extentx = 5477
_extenty = 635
_stockprops = 78
caption = "START"
BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713}
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
font3d = 4
End
End
End
Attribute VB_Name = "docking"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Constant for joystick
Dim JoyInfo As tJoyInfo
Dim RangeWidth As Integer
Dim RangeHeight As Integer
Dim ScrollSpeed As Integer ' The ship's current turning speed
Rem
Dim topj, leftj, rightj, bottomj, centx, centy, leftX, rightX, topY, bottomY As Long
' Constants for mouse action.
Const NO_BUTTON = 0
Const LBUTTON = 1
Const RBUTTON = 2
' Constants for WaveMix channels
Const BACKGROUND = 0
Const MISSION_CONTROL = 1
Const BUTTONS = 2
Const EFFECTS = 3
Const WARNINGS = 4
Const MCSECOND = 5
Const LUPE = 1
Const NO_LUPE = 0
' Boolean that indicates if mouse button has been pressed down.
Dim MouseButtonDown As Integer
' Windows API calls
Private Declare Function GetPixel Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer) As Long
Private Declare Function setpixel Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
Private Declare Function ellipse Lib "GDI" (ByVal hDC As Integer, ByVal nLeft As Integer, ByVal nTop As Integer, ByVal nRight As Integer, ByVal nBottom As Integer) As Long
Private Declare Function LineTo Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer) As Integer
Private Declare Function Polyline Lib "GDI" (ByVal hDC As Integer, lpPoints As POINTAPI, ByVal nCount As Integer) As Integer
Private Declare Function MoveTo Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer) As Long
'-----------------------------------------------------
' BITDEMO1.FRM
' This program demonstrates some of the methods used
' to display bitmaps and sprites.
'-----------------------------------------------------
' The number of pixels to offset the sprite
' each time it is moved.
Const INCREMENT = 1
' Constants for Raster Operations used by BitBlt function.
Const SRCAND = &H8800C6 ' dest = source AND dest
Const SRCCOPY = &HCC0020 ' dest = source
Const SRCPAINT = &HEE0086 ' dest = source OR dest
' The BitBlt Windows API call.
Private Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
'Dim Ship(1 To 4) As tShip
' The x and y coordinates for the Sprite
Dim SpriteX As Integer
Dim SpriteY As Integer
' The x and y coordinates for the upper left corner
' of the large bitmap (picBMP).
Dim BackgroundX As Integer
Dim BackgroundY As Integer
' The width and height of the work area bitmap (picWork).
Dim WorkWidth As Integer
Dim WorkHeight As Integer
Dim ldist As Integer
Dim zcomponent As Integer
Dim s4b(51) As String
Dim s4bmask(51) As String
Private Sub JoyControl(Index As Integer)
Dim x As Integer
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
'Ydock = Ydock - 1
auxcon(0).Picture = auxcon(1).Picture
Case Is = 1
'Xdock = Xdock + 1
auxcon(0).Picture = auxcon(2).Picture
Case Is = 2
'Ydock = Ydock + 1
auxcon(0).Picture = auxcon(3).Picture
Case Is = 3
'Xdock = Xdock - 1
auxcon(0).Picture = auxcon(4).Picture
End Select
'x = playSound("rcstrst.wav", 3, 0)
End Sub
Public Function playSound(sname As String, chan As Integer, lp As Integer)
Select Case lp
' don't loop
Case 0
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (False)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' loop
Case 1
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (True)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' stop loop
Case 2
WAVMIX_StopChannel chan
End Select
End Function
Private Sub auxjoy_Click(Index As Integer)
Dim x As Integer
Dim currpath As String
currpath = "D:\docking\csm4\"
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
Ydock = Ydock - 1
auxcon(0).Picture = auxcon(1).Picture
Case Is = 1
Xdock = Xdock + 1
auxcon(0).Picture = auxcon(2).Picture
Case Is = 2
Ydock = Ydock + 1
auxcon(0).Picture = auxcon(3).Picture
Case Is = 3
Xdock = Xdock - 1
auxcon(0).Picture = auxcon(4).Picture
End Select
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
'x = playSound("rcstrst.wav", 3, 0)
End Sub
Private Sub btnStart_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Rem --- set the pallette pref
picBGOriginal.ZOrder 0
Dim rc As Long
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
StartGame
End If
End Sub
Private Sub cmdExit_Click()
' Shut down the WaveMix .DLL.
WAVMIX_Close
Unload Me
End Sub
Private Sub FOREREV_Click(Index As Integer)
Dim x As Integer
Select Case Index
Case Is = 0
Case Is = 1
End Select
x = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub centerCalibrate_Click()
Dim tempx, tempy As Long
centx = JoyInfo.x
centy = JoyInfo.Y
' label11.Caption = "Centerx " + centx
' Label12.Caption = "Centery " + centy
leftX = (centx - leftj) / 2
tempx = (rightj - centx) / 2
rightX = rightj - tempx
topY = (centy - topj) / 2
tempy = (bottomj - centy) / 2
bottomY = bottomj - tempy
Calibrate.Visible = False
End Sub
Private Sub Form_Load()
'------------------------------------------------------------
' Set up the form when its first loaded.
'------------------------------------------------------------
Rem joyst
RangeWidth = picBackground.ScaleWidth - imgJoyCursor.Width
RangeHeight = picBackground.ScaleWidth - imgJoyCursor.Height
Rem
' Hide the scope and background PictureBoxes.
picBackground.Visible = False
'picScope.Visible = False
' Copy the cockpit "sprite" image into the background PictureBox.
picBackground.Picture = picPitSprite.Picture
' Center the form on the screen.
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
MouseButtonDown = NO_BUTTON
Rem --- %%% Initialize WaveMix DLL %%% ---
If Not WAVMIX_InitMixer() Then
MsgBox "Unable to Initialize WaveMix DLL"
End
End If
Xdock = 0
Ydock = 0
ldist = 125
's4b(1) = "D:\docking\dock\dock1.bmp"
's4b(2) = "D:\docking\dock\dock2.bmp"
's4b(3) = "D:\docking\dock\dock3.bmp"
's4b(4) = "D:\docking\dock\dock4.bmp"
's4b(5) = "D:\docking\dock\dock5.bmp"
's4b(6) = "D:\docking\dock\dock6.bmp"
's4b(7) = "D:\docking\dock\dock7.bmp"
's4b(8) = "D:\docking\dock\dock8.bmp"
's4b(9) = "D:\docking\dock\dock9.bmp"
's4b(10) = "D:\docking\dock\dock10.bmp"
's4b(11) = "D:\docking\dock\dock11.bmp"
's4b(12) = "D:\docking\dock\dock12.bmp"
's4b(13) = "D:\docking\dock\dock13.bmp"
's4b(14) = "D:\docking\dock\dock14.bmp"
's4b(15) = "D:\docking\dock\dock15.bmp"
's4b(16) = "D:\docking\dock\dock16.bmp"
's4b(17) = "D:\docking\dock\dock17.bmp"
's4b(18) = "D:\docking\dock\dock18.bmp"
's4b(19) = "D:\docking\dock\dock19.bmp"
's4b(20) = "D:\docking\dock\dock20.bmp"
's4b(21) = "D:\docking\dock\dock21.bmp"
's4b(22) = "D:\docking\dock\dock22.bmp"
's4b(23) = "D:\docking\dock\dock23.bmp"
's4b(24) = "D:\docking\dock\dock24.bmp"
's4b(25) = "D:\docking\dock\dock25.bmp"
's4b(26) = "D:\docking\dock\dock26.bmp"
's4b(27) = "D:\docking\dock\dock27.bmp"
's4b(28) = "D:\docking\dock\dock28.bmp"
's4b(29) = "D:\docking\dock\dock29.bmp"
's4b(30) = "D:\docking\dock\dock30.bmp"
's4b(31) = "D:\docking\dock\dock31.bmp"
's4b(32) = "D:\docking\dock\dock32.bmp"
's4b(33) = "D:\docking\dock\dock33.bmp"
's4b(34) = "D:\docking\dock\dock34.bmp"
's4b(35) = "D:\docking\dock\dock35.bmp"
's4b(36) = "D:\docking\dock\dock36.bmp"
's4b(37) = "D:\docking\dock\dock37.bmp"
's4b(38) = "D:\docking\dock\dock38.bmp"
's4b(39) = "D:\docking\dock\dock39.bmp"
's4b(40) = "D:\docking\dock\dock40.bmp"
's4b(41) = "D:\docking\dock\dock41.bmp"
's4b(42) = "D:\docking\dock\dock42.bmp"
's4b(43) = "D:\docking\dock\dock43.bmp"
's4b(44) = "D:\docking\dock\dock44.bmp"
's4b(45) = "D:\docking\dock\dock45.bmp"
's4b(46) = "D:\docking\dock\dock46.bmp"
's4b(47) = "D:\docking\dock\dock47.bmp"
's4b(48) = "D:\docking\dock\dock48.bmp"
's4b(49) = "D:\docking\dock\dock49.bmp"
's4b(50) = "D:\docking\dock\dock50.bmp"
'***********************************
Rem *************** masks *********
'*********************************
's4bmask(1) = "D:\docking\mask\m1.bmp"
's4bmask(2) = "D:\docking\mask\m2.bmp"
's4bmask(3) = "D:\docking\mask\m3.bmp"
's4bmask(4) = "D:\docking\mask\m4.bmp"
's4bmask(5) = "D:\docking\mask\m5.bmp"
's4bmask(6) = "D:\docking\mask\m6.bmp"
's4bmask(7) = "D:\docking\mask\m7.bmp"
's4bmask(8) = "D:\docking\mask\m8.bmp"
's4bmask(9) = "D:\docking\mask\m9.bmp"
's4bmask(10) = "D:\docking\mask\m10.bmp"
's4bmask(11) = "D:\docking\mask\m11.bmp"
's4bmask(12) = "D:\docking\mask\m12.bmp"
's4bmask(13) = "D:\docking\mask\m13.bmp"
's4bmask(14) = "D:\docking\mask\m14.bmp"
's4bmask(15) = "D:\docking\mask\m15.bmp"
's4bmask(16) = "D:\docking\mask\m16.bmp"
's4bmask(17) = "D:\docking\mask\m17.bmp"
's4bmask(18) = "D:\docking\mask\m18.bmp"
's4bmask(19) = "D:\docking\mask\m19.bmp"
's4bmask(20) = "D:\docking\mask\m20.bmp"
's4bmask(21) = "D:\docking\mask\m21.bmp"
's4bmask(22) = "D:\docking\mask\m22.bmp"
's4bmask(23) = "D:\docking\mask\m23.bmp"
's4bmask(24) = "D:\docking\mask\m24.bmp"
's4bmask(25) = "D:\docking\mask\m25.bmp"
's4bmask(26) = "D:\docking\mask\m26.bmp"
's4bmask(27) = "D:\docking\mask\m27.bmp"
's4bmask(28) = "D:\docking\mask\m28.bmp"
's4bmask(29) = "D:\docking\mask\m29.bmp"
's4bmask(30) = "D:\docking\mask\m30.bmp"
's4bmask(31) = "D:\docking\mask\m31.bmp"
's4bmask(32) = "D:\docking\mask\m32.bmp"
's4bmask(33) = "D:\docking\mask\m33.bmp"
's4bmask(34) = "D:\docking\mask\m34.bmp"
's4bmask(35) = "D:\docking\mask\m35.bmp"
's4bmask(36) = "D:\docking\mask\m36.bmp"
's4bmask(37) = "D:\docking\mask\m37.bmp"
's4bmask(38) = "D:\docking\mask\m38.bmp"
's4bmask(39) = "D:\docking\mask\m39.bmp"
's4bmask(40) = "D:\docking\mask\m40.bmp"
's4bmask(41) = "D:\docking\mask\m41.bmp"
's4bmask(42) = "D:\docking\mask\m42.bmp"
's4bmask(43) = "D:\docking\mask\m43.bmp"
's4bmask(44) = "D:\docking\mask\m44.bmp"
's4bmask(45) = "D:\docking\mask\m45.bmp"
's4bmask(46) = "D:\docking\mask\m46.bmp"
's4bmask(47) = "D:\docking\mask\m47.bmp"
's4bmask(48) = "D:\docking\mask\m48.bmp"
's4bmask(49) = "D:\docking\mask\m49.bmp"
's4bmask(50) = "D:\docking\mask\m50.bmp"
'***********************************
Rem ************ Temp *************
'***********************************
s4b(1) = "D:\tdock\dock\dock30.bmp"
s4b(2) = "D:\tdock\dock\dock31.bmp"
s4b(3) = "D:\tdock\dock\dock32.bmp"
s4b(4) = "D:\tdock\dock\dock33.bmp"
s4b(5) = "D:\tdock\dock\dock34.bmp"
s4b(6) = "D:\tdock\dock\dock35.bmp"
s4b(7) = "D:\tdock\dock\dock36.bmp"
s4b(8) = "D:\tdock\dock\dock37.bmp"
s4b(9) = "D:\tdock\dock\dock38.bmp"
s4b(10) = "D:\tdock\dock\dock39.bmp"
s4b(11) = "D:\tdock\dock\dock41.bmp"
s4b(12) = "D:\tdock\dock\dock42.bmp"
s4b(13) = "D:\tdock\dock\dock43.bmp"
s4b(14) = "D:\tdock\dock\dock44.bmp"
s4b(15) = "D:\tdock\dock\dock45.bmp"
Rem *********************************
s4bmask(1) = "D:\tdock\mask\mask30.bmp"
s4bmask(2) = "D:\tdock\mask\mask31.bmp"
s4bmask(3) = "D:\tdock\mask\mask32.bmp"
s4bmask(4) = "D:\tdock\mask\mask33.bmp"
s4bmask(5) = "D:\tdock\mask\mask34.bmp"
s4bmask(6) = "D:\tdock\mask\mask35.bmp"
s4bmask(7) = "D:\tdock\mask\mask36.bmp"
s4bmask(8) = "D:\tdock\mask\mask37.bmp"
s4bmask(9) = "D:\tdock\mask\mask38.bmp"
s4bmask(10) = "D:\tdock\mask\mask39.bmp"
s4bmask(11) = "D:\tdock\mask\mask41.bmp"
s4bmask(12) = "D:\tdock\mask\mask42.bmp"
s4bmask(13) = "D:\tdock\mask\mask43.bmp"
s4bmask(14) = "D:\tdock\mask\mask44.bmp"
s4bmask(15) = "D:\tdock\mask\mask45.bmp"
End Sub
Private Sub Form_Unload(Cancel As Integer)
WAVMIX_Close
Unload Me
End Sub
Private Sub Frame1_DragDrop(Source As Control, x As Single, Y As Single)
End Sub
Private Sub Leave_Click()
' Shut down the WaveMix .DLL.
WAVMIX_Close
Unload Me
End
End Sub
Private Sub SSCommand1_Click(Index As Integer)
Dim x As Integer
Select Case Index
Case Is = 0
zcomponent = zcomponent - 1
Case Is = 1
zcomponent = zcomponent + 1
End Select
x = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub Start_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Dim rc As Long
Static NotFirstTime As Integer
Calibrate.Visible = True
calibrator
' Me.Show
' Sprites only need to be initialized the first time
' the game is played.
' If Not NotFirstTime Then
' SpriteInit Ship(1).Sprite, Me, picImage, picmask , picWorkBG, 50
' Ship(1).Visible = 1
' Ship(1).MaxHits = 3
' NotFirstTime = True
' End If
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
StartGame
End If
End Sub
Private Sub Text1_Change()
End Sub
Private Sub Timer1_Timer()
'------------------------------------------------------------
' This routine is the heart of this game. It's a trifle
' monolithic, but that is in large part by design. By
' reducing the number of subroutines called from here, we
' can improve the game performance somewhat.
'
' Each pass through this routine, the game display is
' updated.
'------------------------------------------------------------
Static xpos, ypos As Integer
Dim tempd As Integer
Dim rc As Long
Rem joyst
Dim x As Integer
'Dim i As Integer
Static xComponent As Integer
Static yComponent As Integer
Static zcomponent As Integer
Dim WhereAmI, whereisX, whereisY, wheretoken As Integer
'lblZ = ldist
Dim currpath As String
currpath = "d:\docking\csm4\"
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
'calculate distance from s4sb
ldist = ldist + zcomponent
If ldist <= 4000 And ldist > 2500 Then tempd = 1
If ldist <= 2500 And ldist > 1700 Then tempd = 2
If ldist <= 1700 And ldist > 1200 Then tempd = 3
If ldist <= 1200 And ldist > 900 Then tempd = 4
If ldist <= 900 And ldist > 800 Then tempd = 5
If ldist <= 800 And ldist > 700 Then tempd = 6
If ldist <= 700 And ldist > 640 Then tempd = 7
If ldist <= 640 And ldist > 590 Then tempd = 8
If ldist <= 590 And ldist > 550 Then tempd = 9
If ldist <= 550 And ldist > 510 Then tempd = 10
If ldist <= 510 And ldist > 470 Then tempd = 12
If ldist <= 470 And ldist > 430 Then tempd = 13
If ldist <= 430 And ldist > 400 Then tempd = 14
If ldist <= 400 And ldist > 370 Then tempd = 15
If ldist <= 370 And ldist > 340 Then tempd = 16
If ldist <= 340 And ldist > 310 Then tempd = 17
If ldist <= 310 And ldist > 290 Then tempd = 18
If ldist <= 290 And ldist > 270 Then tempd = 19
If ldist <= 270 And ldist > 250 Then tempd = 20
If ldist <= 250 And ldist > 230 Then tempd = 21
If ldist <= 230 And ldist > 210 Then tempd = 22
If ldist <= 210 And ldist > 195 Then tempd = 23
If ldist <= 195 And ldist > 180 Then tempd = 24
If ldist <= 180 And ldist > 165 Then tempd = 25
If ldist <= 165 And ldist > 150 Then tempd = 26
If ldist <= 150 And ldist > 140 Then tempd = 27
If ldist <= 140 And ldist > 130 Then tempd = 28
If ldist <= 130 And ldist > 120 Then tempd = 29
If ldist <= 120 And ldist > 110 Then tempd = 30
If ldist <= 110 And ldist > 100 Then tempd = 31
If ldist <= 100 And ldist > 90 Then tempd = 32
If ldist <= 90 And ldist > 80 Then tempd = 33
If ldist <= 80 And ldist > 70 Then tempd = 34
If ldist <= 70 And ldist > 60 Then tempd = 35
If ldist <= 60 And ldist > 55 Then tempd = 36
If ldist <= 55 And ldist > 50 Then tempd = 37
If ldist <= 50 And ldist > 45 Then tempd = 38
If ldist <= 45 And ldist > 40 Then tempd = 39
If ldist <= 40 And ldist > 35 Then tempd = 40
' If ldist <= 35 And ldist > 30 Then tempd = 41
' If ldist <= 30 And ldist > 25 Then tempd = 42
' If ldist <= 25 And ldist > 17 Then tempd = 43
' If ldist <= 17 And ldist > 15 Then tempd = 44
' If ldist <= 15 And ldist > 13 Then tempd = 45
' If ldist <= 13 And ldist > 10 Then tempd = 46
' If ldist <= 10 And ldist > 7 Then tempd = 47
' If ldist <= 7 And ldist > 6 Then tempd = 48
' If ldist <= 6 And ldist > 5 Then tempd = 49
' If ldist <= 5 And ldist > 0 Then tempd = 50
'Select Case tempd
' Case Is = 1
' picImage = LoadPicture(s4b(1))
' picMask = LoadPicture(s4bmask(1))
' Case Is = 2
' picImage = LoadPicture(s4b(2))
' picMask = LoadPicture(s4bmask(2))
' Case Is = 3
' picImage = LoadPicture(s4b(3))
' picMask = LoadPicture(s4bmask(3))
' Case Is = 4
' picImage = LoadPicture(s4b(4))
' picMask = LoadPicture(s4bmask(4))
' Case Is = 5
' picImage = LoadPicture(s4b(5))
' picMask = LoadPicture(s4bmask(5))
' Case Is = 6
' picImage = LoadPicture(s4b(6))
' picMask = LoadPicture(s4bmask(6))
' Case Is = 7
' picImage = LoadPicture(s4b(7))
' picMask = LoadPicture(s4bmask(7))
' Case Is = 8
' picImage = LoadPicture(s4b(8))
' picMask = LoadPicture(s4bmask(8))
' Case Is = 9
' picImage = LoadPicture(s4b(9))
' picMask = LoadPicture(s4bmask(9))
' Case Is = 10
' picImage = LoadPicture(s4b(10))
' picMask = LoadPicture(s4bmask(10))
' Case Is = 11
' picImage = LoadPicture(s4b(11))
' picMask = LoadPicture(s4bmask(11))
' Case Is = 12
' picImage = LoadPicture(s4b(12))'
' picMask = LoadPicture(s4bmask(12))
' Case Is = 13
' picImage = LoadPicture(s4b(13))
' picMask = LoadPicture(s4bmask(13))
' Case Is = 14
' picImage = LoadPicture(s4b(14))
' picMask = LoadPicture(s4bmask(14))
' Case Is = 15
' picImage = LoadPicture(s4b(15))
' picMask = LoadPicture(s4bmask(15))
' Case Is = 16
' picImage = LoadPicture(s4b(16))
' picMask = LoadPicture(s4bmask(16))
' Case Is = 17
' picImage = LoadPicture(s4b(17))
' picMask = LoadPicture(s4bmask(17))
' Case Is = 18
' picImage = LoadPicture(s4b(18))
' picMask = LoadPicture(s4bmask(18))
' Case Is = 19
' picImage = LoadPicture(s4b(19))
' picMask = LoadPicture(s4bmask(19))
' Case Is = 20
' picImage = LoadPicture(s4b(20))
' picMask = LoadPicture(s4bmask(20))
' Case Is = 21
' picImage = LoadPicture(s4b(21))
' picMask = LoadPicture(s4bmask(21))
' Case Is = 22
' picImage = LoadPicture(s4b(22))
' picMask = LoadPicture(s4bmask(22))
' Case Is = 23
' picImage = LoadPicture(s4b(23))
' picMask = LoadPicture(s4bmask(23))
' Case Is = 24
' picImage = LoadPicture(s4b(24))
' picMask = LoadPicture(s4bmask(24))
' Case Is = 25
' picImage = LoadPicture(s4b(25))
' picMask = LoadPicture(s4bmask(25))
' Case Is = 26
' picImage = LoadPicture(s4b(26))
' picMask = LoadPicture(s4bmask(26))
' Case Is = 27
' picImage = LoadPicture(s4b(27))
' picMask = LoadPicture(s4bmask(27))
' Case Is = 28
' picImage = LoadPicture(s4b(28))
' picMask = LoadPicture(s4bmask(28))
' Case Is = 29
' picImage = LoadPicture(s4b(29))
' picMask = LoadPicture(s4bmask(29))
' Case Is = 30
' 'picImage = LoadPicture(s4b(30))
'picMask = LoadPicture(s4bmask(30))
' Case Is = 31
' picImage = LoadPicture(s4b(31))
' picMask = LoadPicture(s4bmask(31))
' Case Is = 32
' picImage = LoadPicture(s4b(32))
' picMask = LoadPicture(s4bmask(32))
' Case Is = 33
' picImage = LoadPicture(s4b(33))
' picMask = LoadPicture(s4bmask(33))
' Case Is = 34
' picImage = LoadPicture(s4b(34))
' picMask = LoadPicture(s4bmask(34))
' Case Is = 35
' picImage = LoadPicture(s4b(35))
' picMask = LoadPicture(s4bmask(35))
' Case Is = 36
' picImage = LoadPicture(s4b(36))
' picMask = LoadPicture(s4bmask(36))
' Case Is = 37
' picImage = LoadPicture(s4b(37))
' picMask = LoadPicture(s4bmask(37))
' Case Is = 38
' picImage = LoadPicture(s4b(38))
' picMask = LoadPicture(s4bmask(38))
' Case Is = 39
' picImage = LoadPicture(s4b(39))
' picMask = LoadPicture(s4bmask(39))
' Case Is = 40
' picImage = LoadPicture(s4b(40))
' picMask = LoadPicture(s4bmask(40))
' Case Is = 41
' picImage = LoadPicture(s4b(41))
' picMask = LoadPicture(s4bmask(41))
' Case Is = 42
' picImage = LoadPicture(s4b(42))
' picMask = LoadPicture(s4bmask(42))
' Case Is = 43
' picImage = LoadPicture(s4b(43))
' picMask = LoadPicture(s4bmask(43))
' Case Is = 44
' picImage = LoadPicture(s4b(44))
' picMask = LoadPicture(s4bmask(44))
' Case Is = 45
' picImage = LoadPicture(s4b(45))
' picMask = LoadPicture(s4bmask(45))
' Case Is = 46
' picImage = LoadPicture(s4b(46))
' picMask = LoadPicture(s4bmask(46))
' Case Is = 47
' picImage = LoadPicture(s4b(47))
' picMask = LoadPicture(s4bmask(47))
' Case Is = 48
' picImage = LoadPicture(s4b(48))
' picMask = LoadPicture(s4bmask(48))
' Case Is = 49
' picImage = LoadPicture(s4b(49))
' picMask = LoadPicture(s4bmask(49))
' Case Is = 50
' picImage = LoadPicture(s4b(50))
' picMask = LoadPicture(s4bmask(50))
' End Select
Rem **************** T E M P **********************
'************************************************
Select Case tempd
Case Is = 30
picImage = LoadPicture(s4b(1))
picMask = LoadPicture(s4bmask(1))
Case Is = 31
picImage = LoadPicture(s4b(2))
picMask = LoadPicture(s4bmask(2))
Case Is = 32
picImage = LoadPicture(s4b(3))
picMask = LoadPicture(s4bmask(3))
Case Is = 33
picImage = LoadPicture(s4b(4))
picMask = LoadPicture(s4bmask(4))
Case Is = 34
picImage = LoadPicture(s4b(5))
picMask = LoadPicture(s4bmask(5))
Case Is = 35
picImage = LoadPicture(s4b(6))
picMask = LoadPicture(s4bmask(6))
Case Is = 36
picImage = LoadPicture(s4b(7))
picMask = LoadPicture(s4bmask(7))
Case Is = 37
picImage = LoadPicture(s4b(8))
picMask = LoadPicture(s4bmask(8))
Case Is = 38
picImage = LoadPicture(s4b(9))
picMask = LoadPicture(s4bmask(9))
Case Is = 39
picImage = LoadPicture(s4b(10))
picMask = LoadPicture(s4bmask(10))
Case Is = 41
picImage = LoadPicture(s4b(11))
picMask = LoadPicture(s4bmask(11))
Case Is = 42
picImage = LoadPicture(s4b(12))
picMask = LoadPicture(s4bmask(12))
Case Is = 43
picImage = LoadPicture(s4b(13))
picMask = LoadPicture(s4bmask(13))
Case Is = 44
picImage = LoadPicture(s4b(14))
picMask = LoadPicture(s4bmask(14))
Case Is = 45
picImage = LoadPicture(s4b(15))
picMask = LoadPicture(s4bmask(15))
End Select
Rem ********************************************************************************
xpos = xpos - Xdock
ypos = ypos - Ydock
Rem --- if x is off left side ---
If xpos < -picPitSprite.ScaleWidth Then
xpos = 800 - picPitSprite.ScaleWidth
Else 'if off right side
If xpos > 800 Then xpos = 0
End If
Rem --- if y is off top side ---
If ypos < -(picPitSprite.ScaleHeight) Then
ypos = 600 - picPitSprite.ScaleHeight
Else 'if off bottom
If ypos > 600 - picPitSprite.ScaleHeight Then ypos = picPitSprite.ScaleHeight
End If
closerate.Caption = xpos
distance.Caption = ypos
' Update the background (starfield) based on the
' current speed and direction of the player's ship.
UpdateBackground
' Copy a section of the large bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, 0, 0, SRCCOPY)
' Copy the sprite work area onto the background.
'rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' Draw the sprite mask bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
'draw sprite into the work area
rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Draw the cockpit mask into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitMask.hDC, 0, 0, SRCAND)
'draw cockpit
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitSprite.hDC, 0, 0, SRCPAINT)
'FlickerlessSpriteMove
' Draw the whole thing back onto the screen.
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.Width, picBackground.Height, picWorkBG.hDC, 0, 0, SRCCOPY)
auxjoy(0).Visible = True
auxjoy(1).Visible = True
auxjoy(2).Visible = True
auxjoy(3).Visible = True
auxcon(0).Picture = auxcon(5).Picture
Rem
Rem
Rem Joystick
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If rc = 0 Then
imgJoyCursor.Left = RangeWidth * ((JoyInfo.x - JoyCaps.Xmin) / (JoyCaps.Xmax - JoyCaps.Xmin))
imgJoyCursor.Top = RangeHeight * ((JoyInfo.Y - JoyCaps.Ymin) / (JoyCaps.Ymax - JoyCaps.Ymin))
'lblX = JoyInfo.X
'lblY = JoyInfo.Y
'lblX = xComponent
'lblY = yComponent
'lblZ = ldist
' x is positive
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
'BackgroundX = HScroll1
'BackgroundX = HScroll1
' rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, landsite.hDC, BackgroundX + xComponent, BackgroundY, SRCCOPY)
'calculate distance from s4sb
ldist = ldist + zcomponent
'lblMinX = JoyCaps.Xmin
'lblMaxX = JoyCaps.Xmax
'lblMinY = JoyCaps.Ymin
' lblMaxY = JoyCaps.Ymax
'testy = JoyInfo.X
'test2 = JoyInfo.y
' For i = 0 To 1
' If JoyInfo.ButtonDown(i + 1) Then
' If lblbutton(i).BackColor <> RED Then lblbutton(i).BackColor = RED
' Else
' If lblbutton(i).BackColor <> YELLOW Then lblbutton(i).BackColor = YELLOW
' End If
' Next
End If
Rem --- check for left or right
whereisX = 0
If JoyInfo.x < leftX Then
whereisX = -1
Else
If JoyInfo.x > rightX Then
whereisX = 1
End If
End If
Rem --- check for up or down
whereisY = 0
If JoyInfo.Y < topY Then
whereisY = -1
Else
If JoyInfo.Y > bottomY Then
whereisY = 1
End If
End If
wheretoken = whereisX + whereisY
WhereAmI = 4
If wheretoken = 1 Then
If whereisX = 1 Then
WhereAmI = 1
Else
WhereAmI = 2
End If
End If
If wheretoken = -1 Then
If whereisY = -1 Then
WhereAmI = 0
Else
WhereAmI = 3
End If
End If
Command1.Caption = WhereAmI
'If JoyInfo.X > (JoyCaps.Xmax - 1500) Then
' Call JoyControl(1)
'Else
' If JoyInfo.X < 1500 Then
' Call JoyControl(3)
' Else
' If JoyInfo.Y > 30000 Then
' Call JoyControl(2)
' Else
' If JoyInfo.Y < 1500 Then
' Call JoyControl(0)
' End If
' End If
' End If
'End If
If WhereAmI <> 4 Then
Call JoyControl((WhereAmI))
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 1 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock + 1
'xComponent = xComponent + 1
Call JoyControl(1)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 3 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock - 1
'xComponent = xComponent - 1
Call JoyControl(3)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 2 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock + 1
'yComponent = yComponent + 1
Call JoyControl(2)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 0 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock - 1
'yComponent = yComponent - 1
Call JoyControl(0)
End If
If JoyInfo.ButtonDown(2) And WhereAmI = 2 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
zcomponent = zcomponent + 1
End If
If JoyInfo.ButtonDown(2) And WhereAmI = 0 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
zcomponent = zcomponent - 1
End If
Rem
Rem
Rem end joystick
End Sub
Public Sub EndGame()
'------------------------------------------------------------
' Close everything down.
'------------------------------------------------------------
Dim rc As Long
' Shut down the WaveMix .DLL.
WAVMIX_Close
' Turn off the timer.
Timer1.Enabled = False
' Ready to start again?
btnStart.Caption = "&START"
Me.Refresh
' Wait a couple of seconds
Pause 5
picBackground.Visible = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
'----------------------------------------------------------
' Set the module-level MouseButtonDown variable, so that
' the Mouse Control timer knows a button was pushed.
'----------------------------------------------------------
MouseButtonDown = Button
End Sub
Private Sub Pause(Seconds As Single)
'------------------------------------------------------------
' Delay for a specified number of seconds.
'------------------------------------------------------------
Dim Start As Single
Start = Timer
Do While (Timer - Start) < Seconds
DoEvents
Loop
End Sub
Private Sub StartGame()
'------------------------------------------------------------
' Initialize everything and start the game.
'------------------------------------------------------------
Dim rc As Integer
Dim i As Integer
Static NotFirstTime As Integer
Me.Show
picBackground.Visible = True
ScrollSpeed = 5
Timer1.Enabled = True
End Sub
Private Sub UpdateBackground()
'------------------------------------------------------------
' The first step in building a new view is to copy the
' next section of the original background onto the working
' background picture box.
'------------------------------------------------------------
'Static LastXdir As Integer
'Static LastYdir As Integer
' BGMove picWorkBG, picBGOriginal, LastXdir * 2, LastYdir * 2
BGMove picWorkBG, picBGOriginal, Xdock, Ydock
' End If
End Sub
Private Sub FlickerlessSpriteMove()
'-----------------------------------------------------
' Moving a sprite without flicker requires the use
' of an off-screen work area into which we copy a
' section of the background and sprite.
'-----------------------------------------------------
Dim rc As Integer
WorkWidth = 2090
WorkHeight = 2020
BackgroundX = SpriteX
BackgroundY = SpriteY
' Calculate the next position for the sprite, and any
' necessary direction changes.
GetNextPos picImage.ScaleWidth, picImage.ScaleHeight
' Copy a section of the large bitmap into the work area.
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY)
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBackground.hDC, (SpriteX), (SpriteY), SRCCOPY)
rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (SpriteX), (SpriteY), SRCCOPY)
' Draw the mask and sprite bitmaps into the work area.
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
'rc = BitBlt(picWork.hDC, 0, 0, picmask.ScaleWidth, picmask.ScaleHeight, picmask.hDC, 0, 0, SRCAND)
'rc = BitBlt(picWork.hDC, 0, 0, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Copy the work area onto the background.
' rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' rc = BitBlt(picBackground.hDC, 10, 10, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
DoEvents
End Sub
Private Sub GetNextPos(ByVal AWidth As Integer, ByVal AHeight As Integer)
'-----------------------------------------------------
' Calculate the next position for the sprite, and
' make any necessary direction changes.
'-----------------------------------------------------
xdir = Xdock
ydir = Ydock
' Calculate the new position for the sprite.
SpriteX = SpriteX + (xdir)
SpriteY = SpriteY + (ydir)
End Sub
Public Sub calibrator()
Dim k, rc As Integer
k = 0
DoEvents
Do
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If JoyInfo.ButtonDown(1) Then
leftj = JoyInfo.x
topj = JoyInfo.Y
k = 1
End If
Loop While k = 0
textCalibrator.Text = "Move Joystick to Lower Right and Press Button 2"
DoEvents
Do
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If JoyInfo.ButtonDown(2) Then
rightj = JoyInfo.x
bottomj = JoyInfo.Y
k = 2
End If
Loop While k = 1
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
textCalibrator.Text = ""
DoEvents
centerCalibrate.Visible = True
End Sub
DOCKING2.FRM
VERSION 4.00
Begin VB.Form docking
AutoRedraw = -1 'True
Caption = "Docking with the Lunar Module"
ClientHeight = 7185
ClientLeft = 1230
ClientTop = 1695
ClientWidth = 9570
Height = 7590
Left = 1170
LinkTopic = "Form1"
Picture = "DOCKING2.frx":0000
ScaleHeight = 7185
ScaleWidth = 9570
Top = 1350
Width = 9690
Begin VB.CommandButton Command2
BackColor = &H00C0C0C0&
Caption = "REV"
Height = 375
Index = 1
Left = 5415
TabIndex = 21
Top = 6540
Width = 435
End
Begin VB.CommandButton Command2
Caption = "FWD"
Height = 375
Index = 0
Left = 4065
TabIndex = 20
Top = 6525
Width = 435
End
Begin VB.CommandButton starlock
Caption = "LOCK"
Height = 780
Left = 6495
TabIndex = 19
Top = 6180
Width = 2130
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 9690
TabIndex = 18
Top = 6690
Width = 1215
End
Begin VB.PictureBox PicSave
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 8565
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 16
Top = 7335
Width = 1755
End
Begin VB.PictureBox PicWork
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 6720
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 15
Top = 7335
Width = 1755
End
Begin VB.PictureBox PicMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 5085
Picture = "DOCKING2.frx":4B444
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 14
Top = 7350
Width = 1500
End
Begin VB.PictureBox PicImage
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1410
Left = 3435
Picture = "DOCKING2.frx":4DE08
ScaleHeight = 94
ScaleMode = 3 'Pixel
ScaleWidth = 99
TabIndex = 13
Top = 7335
Width = 1485
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 5
Left = 10110
Picture = "DOCKING2.frx":50704
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 9
Top = 2385
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 4
Left = 10290
Picture = "DOCKING2.frx":537D0
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 8
Top = 1635
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 3
Left = 10335
Picture = "DOCKING2.frx":5689C
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 7
Top = 1215
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 2
Left = 9840
Picture = "DOCKING2.frx":59968
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 6
Top = 555
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 1
Left = 9975
Picture = "DOCKING2.frx":5CA34
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 5
Top = 135
Width = 1755
End
Begin VB.PictureBox picWorkBG
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00400000&
ForeColor = &H80000008&
Height = 4860
Left = 2775
ScaleHeight = 322
ScaleMode = 3 'Pixel
ScaleWidth = 635
TabIndex = 4
Top = 7440
Width = 9555
End
Begin VB.PictureBox picBGoriginal
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 9030
Left = -8415
Picture = "DOCKING2.frx":5FB00
ScaleHeight = 600
ScaleMode = 3 'Pixel
ScaleWidth = 800
TabIndex = 1
Top = 7305
Width = 12030
End
Begin VB.PictureBox picPitMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 9705
Picture = "DOCKING2.frx":D5244
ScaleHeight = 5205
ScaleWidth = 9600
TabIndex = 3
Top = 4155
Width = 9600
End
Begin VB.PictureBox picPitSprite
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 0
Picture = "DOCKING2.frx":10BA08
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 2
Top = 60
Width = 9600
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 55
Left = 9960
Top = 5865
End
Begin VB.PictureBox Picture4
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 7200
Left = -75
Picture = "DOCKING2.frx":1421CC
ScaleHeight = 7200
ScaleWidth = 9600
TabIndex = 0
Top = -15
Width = 9600
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 0
Left = 4110
Picture = "DOCKING2.frx":18D610
ScaleHeight = 95
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 10
Top = 5520
Width = 1755
Begin VB.Image auxjoy
Height = 300
Index = 0
Left = 720
Top = 225
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 1
Left = 1035
Top = 555
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 2
Left = 720
Top = 870
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 3
Left = 390
Top = 555
Width = 300
End
End
Begin VB.PictureBox picBackground
Appearance = 0 'Flat
BackColor = &H00000000&
BorderStyle = 0 'None
DragIcon = "DOCKING2.frx":1906DC
ForeColor = &H80000008&
Height = 5205
Left = 75
Picture = "DOCKING2.frx":1909E6
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 17
Top = 135
Width = 9600
End
Begin VB.Image Image1
Height = 585
Index = 2
Left = 8160
Picture = "DOCKING2.frx":1C71AA
Top = 5535
Width = 870
End
Begin VB.Image Image1
Height = 570
Index = 1
Left = 7305
Picture = "DOCKING2.frx":1C7B86
Top = 5535
Width = 870
End
Begin VB.Image Image1
Height = 585
Index = 0
Left = 6390
Picture = "DOCKING2.frx":1C852A
Top = 5535
Width = 870
End
Begin VB.Label distance
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1410
TabIndex = 12
Top = 6420
Width = 600
End
Begin VB.Label closerate
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1395
TabIndex = 11
Top = 5805
Width = 600
End
End
End
Attribute VB_Name = "docking"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Constant for joystick
Dim JoyInfo As tJoyInfo
Dim RangeWidth As Integer
Dim RangeHeight As Integer
Dim ScrollSpeed As Integer ' The ship's current turning speed
Rem
Dim topj, leftj, rightj, bottomj, centx, centy, leftX, rightX, topY, bottomY As Long
' Constants for mouse action.
Const NO_BUTTON = 0
Const LBUTTON = 1
Const RBUTTON = 2
' Constants for WaveMix channels
Const BACKGROUND = 0
Const MISSION_CONTROL = 1
Const BUTTONS = 2
Const EFFECTS = 3
Const WARNINGS = 4
Const MCSECOND = 5
Const LUPE = 1
Const NO_LUPE = 0
' Boolean that indicates if mouse button has been pressed down.
Dim MouseButtonDown As Integer
'-----------------------------------------------------
' BITDEMO1.FRM
' This program demonstrates some of the methods used
' to display bitmaps and sprites.
'-----------------------------------------------------
' The number of pixels to offset the sprite
' each time it is moved.
Const INCREMENT = 1
' Constants for Raster Operations used by BitBlt function.
Const SRCAND = &H8800C6 ' dest = source AND dest
Const SRCCOPY = &HCC0020 ' dest = source
Const SRCPAINT = &HEE0086 ' dest = source OR dest
'Dim Ship(1 To 4) As tShip
' The x and y coordinates for the Sprite
Dim SpriteX As Integer
Dim SpriteY As Integer
' The x and y coordinates for the upper left corner
' of the large bitmap (picBMP).
Dim BackgroundX As Integer
Dim BackgroundY As Integer
' The width and height of the work area bitmap (picWork).
Dim WorkWidth As Integer
Dim WorkHeight As Integer
Dim ldist As Integer
Dim zcomponent As Integer
Dim s4b(51) As String
Dim s4bmask(51) As String
Dim csmDock(51) As String
Dim csmMask(51) As String
Private Sub JoyControl(Index As Integer)
Dim x As Integer
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
'Ydock = Ydock - 1
auxcon(0).Picture = auxcon(1).Picture
Case Is = 1
'Xdock = Xdock + 1
auxcon(0).Picture = auxcon(2).Picture
Case Is = 2
'Ydock = Ydock + 1
auxcon(0).Picture = auxcon(3).Picture
Case Is = 3
'Xdock = Xdock - 1
auxcon(0).Picture = auxcon(4).Picture
End Select
'x = playSound("rcstrst.wav", 3, 0)
End Sub
Public Function playSound(sname As String, chan As Integer, lp As Integer)
Select Case lp
' don't loop
Case 0
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (False)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' loop
Case 1
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (True)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' stop loop
Case 2
WAVMIX_StopChannel chan
End Select
End Function
Private Sub auxjoy_Click(Index As Integer)
Dim x As Integer
Dim currpath As String
currpath = cddrive + "\docking\csm4\"
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
Ydock = Ydock - 1
auxcon(0).Picture = auxcon(1).Picture
Case Is = 1
Xdock = Xdock + 1
auxcon(0).Picture = auxcon(2).Picture
Case Is = 2
Ydock = Ydock + 1
auxcon(0).Picture = auxcon(3).Picture
Case Is = 3
Xdock = Xdock - 1
auxcon(0).Picture = auxcon(4).Picture
End Select
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
'x = playSound("rcstrst.wav", 3, 0)
End Sub
Private Sub btnStart_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Rem --- set the pallette pref
picBGOriginal.ZOrder 0
Dim rc As Long
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
StartGame
End If
End Sub
Private Sub cmdExit_Click()
' Shut down the WaveMix .DLL.
WAVMIX_Close
Unload Me
End Sub
Private Sub FOREREV_Click(Index As Integer)
Dim x As Integer
Select Case Index
Case Is = 0
Case Is = 1
End Select
x = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub centerCalibrate_Click()
Dim tempx, tempy As Long
centx = JoyInfo.x
centy = JoyInfo.Y
' label11.Caption = "Centerx " + centx
' Label12.Caption = "Centery " + centy
leftX = (centx - leftj) / 2
tempx = (rightj - centx) / 2
rightX = rightj - tempx
topY = (centy - topj) / 2
tempy = (bottomj - centy) / 2
bottomY = bottomj - tempy
' Calibrate.Visible = False
End Sub
Private Sub Command2_Click(Index As Integer)
Dim x As Integer
Dim currpath As String
currpath = cddrive + "\docking\csm4\"
Select Case Index
Case Is = 0
Zdock = Zdock - 1
Case Is = 1
Zdock = Zdock + 1
End Select
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub Form_Load()
Dim rc As Long
'------------------------------------------------------------
' Set up the form when its first loaded.
'------------------------------------------------------------
Rem joyst
'RangeWidth = picBackground.ScaleWidth - imgJoyCursor.Width
'RangeHeight = picBackground.ScaleWidth - imgJoyCursor.Height
Rem
Rem --- set the pallette pref
'picBGOriginal.ZOrder 0
'If MissionState = 2 Then
'picBGOriginal = LoadPicture(cddrive + "\landsite\mountz3.bmp")
' picBGOriginal = LoadPicture(cddrive + "\docking\csm4\strfld2.bmp")
'Else
' picBGOriginal = LoadPicture(cddrive + "\docking\csm4\strfld3.bmp")
'End If
' Hide the scope and background PictureBoxes.
picBackground.Visible = False
'picScope.Visible = False
' Copy the cockpit "sprite" image into the background PictureBox.
picBackground.Picture = picPitSprite.Picture
' Center the form on the screen.
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
MouseButtonDown = NO_BUTTON
Rem --- %%% Initialize WaveMix DLL %%% ---
' If Not WAVMIX_InitMixer() Then
' MsgBox "Unable to Initialize WaveMix DLL"
' End
' End If
Xdock = 0
Ydock = 0
ldist = 45
s4b(1) = cddrive + "\docking\s4b\s4b1.bmp"
s4b(2) = cddrive + "\docking\s4b\s4b2.bmp"
s4b(3) = cddrive + "\docking\s4b\s4b3.bmp"
s4b(4) = cddrive + "\docking\s4b\s4b4.bmp"
s4b(5) = cddrive + "\docking\s4b\s4b5.bmp"
s4b(6) = cddrive + "\docking\s4b\s4b6.bmp"
s4b(7) = cddrive + "\docking\s4b\s4b7.bmp"
s4b(8) = cddrive + "\docking\s4b\s4b8.bmp"
s4b(9) = cddrive + "\docking\s4b\s4b9.bmp"
s4b(10) = cddrive + "\docking\s4b\s4b10.bmp"
s4b(11) = cddrive + "\docking\s4b\s4b11.bmp"
s4b(12) = cddrive + "\docking\s4b\s4b12.bmp"
s4b(13) = cddrive + "\docking\s4b\s4b13.bmp"
s4b(14) = cddrive + "\docking\s4b\s4b14.bmp"
s4b(15) = cddrive + "\docking\s4b\s4b15.bmp"
s4b(16) = cddrive + "\docking\s4b\s4b16.bmp"
s4b(17) = cddrive + "\docking\s4b\s4b17.bmp"
s4b(18) = cddrive + "\docking\s4b\s4b18.bmp"
csmDock(1) = cddrive + "\docking\CSM\csm1.bmp"
csmDock(2) = cddrive + "\docking\CSM\csm2.bmp"
csmDock(3) = cddrive + "\docking\CSM\csm3.bmp"
csmDock(4) = cddrive + "\docking\CSM\csm4.bmp"
csmDock(5) = cddrive + "\docking\CSM\csm5.bmp"
csmDock(6) = cddrive + "\docking\CSM\csm6.bmp"
csmDock(7) = cddrive + "\docking\CSM\csm7.bmp"
csmDock(8) = cddrive + "\docking\CSM\csm8.bmp"
csmDock(9) = cddrive + "\docking\CSM\csm9.bmp"
csmDock(10) = cddrive + "\docking\CSM\csm10.bmp"
csmDock(11) = cddrive + "\docking\CSM\csm11.bmp"
csmDock(12) = cddrive + "\docking\CSM\csm12.bmp"
csmDock(13) = cddrive + "\docking\CSM\csm13.bmp"
csmDock(14) = cddrive + "\docking\CSM\csm14.bmp"
csmDock(15) = cddrive + "\docking\CSM\csm15.bmp"
csmDock(16) = cddrive + "\docking\CSM\csm16.bmp"
csmDock(17) = cddrive + "\docking\CSM\csm17.bmp"
csmDock(18) = cddrive + "\docking\CSM\csm18.bmp"
'***********************************
Rem *************** masks *********
'**********************************
s4bmask(1) = cddrive + "\docking\mask\s4b1m.bmp"
s4bmask(2) = cddrive + "\docking\mask\s4b2m.bmp"
s4bmask(3) = cddrive + "\docking\mask\s4b3m.bmp"
s4bmask(4) = cddrive + "\docking\mask\s4b4m.bmp"
s4bmask(5) = cddrive + "\docking\mask\s4b5m.bmp"
s4bmask(6) = cddrive + "\docking\mask\s4b6m.bmp"
s4bmask(7) = cddrive + "\docking\mask\s4b7m.bmp"
s4bmask(8) = cddrive + "\docking\mask\s4b8m.bmp"
s4bmask(9) = cddrive + "\docking\mask\s4b9m.bmp"
s4bmask(10) = cddrive + "\docking\mask\s4b10m.bmp"
s4bmask(11) = cddrive + "\docking\mask\s4b11m.bmp"
s4bmask(12) = cddrive + "\docking\mask\s4b12m.bmp"
s4bmask(13) = cddrive + "\docking\mask\s4b13m.bmp"
s4bmask(14) = cddrive + "\docking\mask\s4b14m.bmp"
s4bmask(15) = cddrive + "\docking\mask\s4b15m.bmp"
s4bmask(16) = cddrive + "\docking\mask\s4b16m.bmp"
s4bmask(17) = cddrive + "\docking\mask\s4b17m.bmp"
s4bmask(18) = cddrive + "\docking\mask\s4b18m.bmp"
csmMask(1) = cddrive + "\docking\cMask\cMask1.bmp"
csmMask(2) = cddrive + "\docking\cMask\cMask2.bmp"
csmMask(3) = cddrive + "\docking\cMask\cMask3.bmp"
csmMask(4) = cddrive + "\docking\cMask\cMask4.bmp"
csmMask(5) = cddrive + "\docking\cMask\cMask5.bmp"
csmMask(6) = cddrive + "\docking\cMask\cMask6.bmp"
csmMask(7) = cddrive + "\docking\cMask\cMask7.bmp"
csmMask(8) = cddrive + "\docking\cMask\cMask8.bmp"
csmMask(9) = cddrive + "\docking\cMask\cMask9.bmp"
csmMask(10) = cddrive + "\docking\cMask\cMask10.bmp"
csmMask(11) = cddrive + "\docking\cMask\cMask11.bmp"
csmMask(12) = cddrive + "\docking\cMask\cMask12.bmp"
csmMask(13) = cddrive + "\docking\cMask\cMask13.bmp"
csmMask(14) = cddrive + "\docking\cMask\cMask14.bmp"
csmMask(15) = cddrive + "\docking\cMask\cMask15.bmp"
csmMask(16) = cddrive + "\docking\cMask\cMask16.bmp"
csmMask(17) = cddrive + "\docking\cMask\cMask17.bmp"
csmMask(18) = cddrive + "\docking\cMask\cMask18.bmp"
Rem *** check to see if joystick will be used ***
If joystick = 1 Then
'Calibrate.Visible = True
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
StartGame
calibrator
Else
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
StartGame
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
WAVMIX_Close
Unload Me
End Sub
Private Sub Frame1_DragDrop(Source As Control, x As Single, Y As Single)
End Sub
Private Sub Image1_Click(Index As Integer)
Select Case Index
Case Is = 0 'Csm1
CurrentForm = 1
docking.Hide
Case Is = 1 'Csm2
CurrentForm = 2
docking.Hide
Case Is = 2 'Dock Lock if properly docked
End Select
End Sub
Private Sub SSCommand1_Click(Index As Integer)
Dim x As Integer
Dim currpath As String
currpath = cddrive + "\docking\csm4\"
Select Case Index
Case Is = 0
Zdock = Zdock - 1
Case Is = 1
Zdock = Zdock + 1
End Select
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
'x = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub Start_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Static NotFirstTime As Integer
' Me.Show
' Sprites only need to be initialized the first time
' the game is played.
' If Not NotFirstTime Then
' SpriteInit Ship(1).Sprite, Me, picImage, picmask , picWorkBG, 50
' Ship(1).Visible = 1
' Ship(1).MaxHits = 3
' NotFirstTime = True
' End If
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
End If
End Sub
Private Sub Text1_Change()
End Sub
Private Sub Timer1_Timer()
Static xpos, ypos As Integer
Static passed_s4b, reorient As Integer
Static tempd As Integer
Dim rc As Long
Dim xtoken, ytoken As Integer
'Joystick docking etc.
Static xComponent As Integer
Static yComponent As Integer
Static zcomponent As Integer
Rem joyst
Dim x As Integer
'Dim i As Integer
Dim WhereAmI, whereisX, whereisY, wheretoken As Integer
'lblZ = ldist
Dim currpath As String
currpath = cddrive + "\docking\csm4\"
closerate.Caption = ypos
distance.Caption = xpos
UpdateBackground
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
If ldist <= 0 Then
passed_s4b = 1
Zdock = -Zdock
reorient = 1
End If
'calculate distance from s4sb
If passed_s4b = 1 Then
Rem hide s4b
End If
ldist = ldist + Zdock
If ldist <= 140 And ldist > 131 Then tempd = 18
If ldist <= 130 And ldist > 121 Then tempd = 17
If ldist <= 120 And ldist > 111 Then tempd = 16
If ldist <= 110 And ldist > 101 Then tempd = 15
If ldist <= 100 And ldist > 91 Then tempd = 14
If ldist <= 90 And ldist > 81 Then tempd = 13
If ldist <= 80 And ldist > 71 Then tempd = 12
If ldist <= 70 And ldist > 61 Then tempd = 11
If ldist <= 60 And ldist > 51 Then tempd = 10
If ldist <= 50 And ldist > 41 Then tempd = 9
If ldist <= 40 And ldist > 31 Then tempd = 8
' If ldist <= 30 And ldist > 21 Then tempd = 7
' If ldist <= 20 And ldist > 10 Then tempd = 6
If ldist <= 1 Then
xtoken = xpos
ytoken = ypos
' Call Check_For_Crash(xtoken, ytoken)
End If
If tempd > 5 And tempd < 19 Then
If MissionState = 3 Then
picImage = LoadPicture(s4b(tempd))
picMask = LoadPicture(s4bmask(tempd))
Else
picImage = LoadPicture(csmDock(tempd))
picMask = LoadPicture(csmMask(tempd))
End If
End If
Rem ********************************************************************************
xpos = xpos - Xdock
ypos = ypos - Ydock
Rem --- if x is off left side ---
If xpos < -picPitSprite.ScaleWidth + picImage.ScaleWidth Then
xpos = 800 - picPitSprite.ScaleWidth + picImage.ScaleWidth
Else 'if off right side
If xpos > 800 - picImage.ScaleWidth Then xpos = 0 - picImage.ScaleWidth
End If
Rem --- if y is off top side ---
If ypos < -picImage.ScaleHeight Then
ypos = 600 - picImage.ScaleHeight
Else 'if off bottom
If ypos > 600 - picImage.ScaleHeight Then ypos = 0 - picImage.ScaleHeight
End If
' Copy a section of the large bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, 0, 0, SRCCOPY)
' Copy the sprite work area onto the background.
'rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' Draw the sprite mask bitmap into the work area.
'*** rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
'draw sprite into the work area
'*** rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Draw the cockpit mask into the work area.
'*** rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitMask.hDC, 0, 0, SRCAND)
'draw cockpit
'*** rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitSprite.hDC, 0, 0, SRCPAINT)
'FlickerlessSpriteMove
' Draw the whole thing back onto the screen.
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.Width, picBackground.Height, picWorkBG.hDC, 0, 0, SRCCOPY)
auxjoy(0).Visible = True
auxjoy(1).Visible = True
auxjoy(2).Visible = True
auxjoy(3).Visible = True
auxcon(0).Picture = auxcon(5).Picture
Rem
Rem
Rem Joystick
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If rc = 0 Then
'imgJoyCursor.Left = RangeWidth * ((JoyInfo.X - JoyCaps.Xmin) / (JoyCaps.Xmax - JoyCaps.Xmin))
'imgJoyCursor.Top = RangeHeight * ((JoyInfo.Y - JoyCaps.Ymin) / (JoyCaps.Ymax - JoyCaps.Ymin))
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
'BackgroundX = HScroll1
'BackgroundX = HScroll1
' rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, landsite.hDC, BackgroundX + xComponent, BackgroundY, SRCCOPY)
'calculate distance from s4sb
ldist = ldist + zcomponent
End If
Rem --- check for left or right
whereisX = 0
If JoyInfo.x < leftX Then
whereisX = -1
Else
If JoyInfo.x > rightX Then
whereisX = 1
End If
End If
Rem --- check for up or down
whereisY = 0
If JoyInfo.Y < topY Then
whereisY = -1
Else
If JoyInfo.Y > bottomY Then
whereisY = 1
End If
End If
wheretoken = whereisX + whereisY
WhereAmI = 4
If wheretoken = 1 Then
If whereisX = 1 Then
WhereAmI = 1
Else
WhereAmI = 2
End If
End If
If wheretoken = -1 Then
If whereisY = -1 Then
WhereAmI = 0
Else
WhereAmI = 3
End If
End If
Command1.Caption = WhereAmI
If WhereAmI <> 4 Then
Call JoyControl((WhereAmI))
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 1 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock + 1
'xComponent = xComponent + 1
Call JoyControl(1)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 3 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock - 1
'xComponent = xComponent - 1
Call JoyControl(3)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 2 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock + 1
'yComponent = yComponent + 1
Call JoyControl(2)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 0 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock - 1
'yComponent = yComponent - 1
Call JoyControl(0)
End If
If JoyInfo.ButtonDown(2) And WhereAmI = 2 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Zdock = Zdock + 1
End If
If JoyInfo.ButtonDown(2) And WhereAmI = 0 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Zdock = Zdock - 1
End If
Rem
Rem
Rem end joystick
End Sub
Private Sub Form_MouseDown(BUTTON As Integer, Shift As Integer, x As Single, Y As Single)
'----------------------------------------------------------
' Set the module-level MouseButtonDown variable, so that
' the Mouse Control timer knows a button was pushed.
'----------------------------------------------------------
MouseButtonDown = BUTTON
End Sub
Private Sub Pause(Seconds As Single)
'------------------------------------------------------------
' Delay for a specified number of seconds.
'------------------------------------------------------------
Dim Start As Single
Start = Timer
Do While (Timer - Start) < Seconds
DoEvents
Loop
End Sub
Private Sub StartGame()
'------------------------------------------------------------
' Initialize everything and start the game.
'------------------------------------------------------------
Dim rc As Integer
Dim i As Integer
Static NotFirstTime As Integer
Me.Show
picBackground.Visible = True
ScrollSpeed = 5
Timer1.Enabled = True
End Sub
Private Sub UpdateBackground()
'------------------------------------------------------------
' The first step in building a new view is to copy the
' next section of the original background onto the working
' background picture box.
'------------------------------------------------------------
'Static LastXdir As Integer
'Static LastYdir As Integer
' BGMove picWorkBG, picBGOriginal, LastXdir * 2, LastYdir * 2
BGMove picWorkBG, picBGOriginal, Xdock, Ydock
' End If
End Sub
Private Sub FlickerlessSpriteMove()
'-----------------------------------------------------
' Moving a sprite without flicker requires the use
' of an off-screen work area into which we copy a
' section of the background and sprite.
'-----------------------------------------------------
Dim rc As Integer
WorkWidth = 2090
WorkHeight = 2020
BackgroundX = SpriteX
BackgroundY = SpriteY
' Calculate the next position for the sprite, and any
' necessary direction changes.
GetNextPos picImage.ScaleWidth, picImage.ScaleHeight
' Copy a section of the large bitmap into the work area.
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY)
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBackground.hDC, (SpriteX), (SpriteY), SRCCOPY)
rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (SpriteX), (SpriteY), SRCCOPY)
' Draw the mask and sprite bitmaps into the work area.
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
'rc = BitBlt(picWork.hDC, 0, 0, picmask.ScaleWidth, picmask.ScaleHeight, picmask.hDC, 0, 0, SRCAND)
'rc = BitBlt(picWork.hDC, 0, 0, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Copy the work area onto the background.
' rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' rc = BitBlt(picBackground.hDC, 10, 10, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
DoEvents
End Sub
Private Sub GetNextPos(ByVal AWidth As Integer, ByVal AHeight As Integer)
'-----------------------------------------------------
' Calculate the next position for the sprite, and
' make any necessary direction changes.
'-----------------------------------------------------
Xdir = Xdock
Ydir = Ydock
' Calculate the new position for the sprite.
SpriteX = SpriteX + (Xdir)
SpriteY = SpriteY + (Ydir)
End Sub
Public Sub calibrator()
Dim k, rc As Integer
k = 0
DoEvents
Do
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If JoyInfo.ButtonDown(1) Then
leftj = JoyInfo.x
topj = JoyInfo.Y
k = 1
End If
Loop While k = 0
'textCalibrator.Text = "Move Joystick to Lower Right and Press Button 2"
DoEvents
Do
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If JoyInfo.ButtonDown(2) Then
rightj = JoyInfo.x
bottomj = JoyInfo.Y
k = 2
End If
Loop While k = 1
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
' textCalibrator.Text = ""
DoEvents
'centerCalibrate.Visible = True
End Sub
Public Sub Check_For_Crash(xtoken As Integer, ytoken As Integer)
End Sub
DOCKING2.LOG
Line 317: Property DragIcon in picBackground could not be set.
DOCKING3.FRM
VERSION 4.00
Begin VB.Form docking
AutoRedraw = -1 'True
Caption = "Docking with the Lunar Module"
ClientHeight = 7185
ClientLeft = 1230
ClientTop = 1695
ClientWidth = 9570
Height = 7590
Left = 1170
LinkTopic = "Form1"
Picture = "DOCKING3.frx":0000
ScaleHeight = 7185
ScaleWidth = 9570
Top = 1350
Width = 9690
Begin VB.CommandButton Command2
BackColor = &H00C0C0C0&
Caption = "REV"
Height = 375
Index = 1
Left = 5415
TabIndex = 21
Top = 6540
Width = 435
End
Begin VB.CommandButton Command2
Caption = "FWD"
Height = 375
Index = 0
Left = 4065
TabIndex = 20
Top = 6525
Width = 435
End
Begin VB.CommandButton starlock
Caption = "LOCK"
Height = 780
Left = 6495
TabIndex = 19
Top = 6180
Width = 2130
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 9690
TabIndex = 18
Top = 6690
Width = 1215
End
Begin VB.PictureBox PicSave
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 8565
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 16
Top = 7335
Width = 1755
End
Begin VB.PictureBox PicWork
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 6720
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 15
Top = 7335
Width = 1755
End
Begin VB.PictureBox PicMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 5085
Picture = "DOCKING3.frx":4B444
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 14
Top = 7350
Width = 1500
End
Begin VB.PictureBox PicImage
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1410
Left = 3435
Picture = "DOCKING3.frx":4DE08
ScaleHeight = 94
ScaleMode = 3 'Pixel
ScaleWidth = 99
TabIndex = 13
Top = 7335
Width = 1485
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 5
Left = 10110
Picture = "DOCKING3.frx":50704
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 9
Top = 2385
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 4
Left = 10290
Picture = "DOCKING3.frx":537D0
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 8
Top = 1635
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 3
Left = 10335
Picture = "DOCKING3.frx":5689C
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 7
Top = 1215
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 2
Left = 9840
Picture = "DOCKING3.frx":59968
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 6
Top = 555
Width = 1755
End
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 1
Left = 9975
Picture = "DOCKING3.frx":5CA34
ScaleHeight = 1425
ScaleWidth = 1755
TabIndex = 5
Top = 135
Width = 1755
End
Begin VB.PictureBox picWorkBG
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00400000&
ForeColor = &H80000008&
Height = 4860
Left = 2775
ScaleHeight = 322
ScaleMode = 3 'Pixel
ScaleWidth = 635
TabIndex = 4
Top = 7440
Width = 9555
End
Begin VB.PictureBox picBGoriginal
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 9030
Left = -8415
Picture = "DOCKING3.frx":5FB00
ScaleHeight = 600
ScaleMode = 3 'Pixel
ScaleWidth = 800
TabIndex = 1
Top = 7305
Width = 12030
End
Begin VB.PictureBox picPitMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 9705
Picture = "DOCKING3.frx":D5244
ScaleHeight = 5205
ScaleWidth = 9600
TabIndex = 3
Top = 4155
Width = 9600
End
Begin VB.PictureBox picPitSprite
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 0
Picture = "DOCKING3.frx":10BA08
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 2
Top = 60
Width = 9600
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 55
Left = 9960
Top = 5865
End
Begin VB.PictureBox Picture4
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 7200
Left = -75
Picture = "DOCKING3.frx":1421CC
ScaleHeight = 7200
ScaleWidth = 9600
TabIndex = 0
Top = -15
Width = 9600
Begin VB.PictureBox auxcon
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1425
Index = 0
Left = 4110
Picture = "DOCKING3.frx":18D610
ScaleHeight = 95
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 10
Top = 5520
Width = 1755
Begin VB.Image auxjoy
Height = 300
Index = 0
Left = 720
Top = 225
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 1
Left = 1035
Top = 555
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 2
Left = 720
Top = 870
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 3
Left = 390
Top = 555
Width = 300
End
End
Begin VB.PictureBox picBackground
Appearance = 0 'Flat
BackColor = &H00000000&
BorderStyle = 0 'None
DragIcon = "DOCKING3.frx":1906DC
ForeColor = &H80000008&
Height = 5205
Left = 75
Picture = "DOCKING3.frx":1909E6
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 17
Top = 135
Width = 9600
End
Begin VB.Image Image1
Height = 585
Index = 2
Left = 8160
Picture = "DOCKING3.frx":1C71AA
Top = 5535
Width = 870
End
Begin VB.Image Image1
Height = 570
Index = 1
Left = 7305
Picture = "DOCKING3.frx":1C7B86
Top = 5535
Width = 870
End
Begin VB.Image Image1
Height = 585
Index = 0
Left = 6390
Picture = "DOCKING3.frx":1C852A
Top = 5535
Width = 870
End
Begin VB.Label distance
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1410
TabIndex = 12
Top = 6420
Width = 600
End
Begin VB.Label closerate
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1395
TabIndex = 11
Top = 5805
Width = 600
End
End
End
Attribute VB_Name = "docking"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Constant for joystick
Dim JoyInfo As tJoyInfo
Dim RangeWidth As Integer
Dim RangeHeight As Integer
Dim ScrollSpeed As Integer ' The ship's current turning speed
Rem
Dim topj, leftj, rightj, bottomj, centx, centy, leftX, rightX, topY, bottomY As Long
' Constants for mouse action.
Const NO_BUTTON = 0
Const LBUTTON = 1
Const RBUTTON = 2
' Constants for WaveMix channels
Const BACKGROUND = 0
Const MISSION_CONTROL = 1
Const BUTTONS = 2
Const EFFECTS = 3
Const WARNINGS = 4
Const MCSECOND = 5
Const LUPE = 1
Const NO_LUPE = 0
' Boolean that indicates if mouse button has been pressed down.
Dim MouseButtonDown As Integer
'-----------------------------------------------------
' BITDEMO1.FRM
' This program demonstrates some of the methods used
' to display bitmaps and sprites.
'-----------------------------------------------------
' The number of pixels to offset the sprite
' each time it is moved.
Const INCREMENT = 1
' Constants for Raster Operations used by BitBlt function.
Const SRCAND = &H8800C6 ' dest = source AND dest
Const SRCCOPY = &HCC0020 ' dest = source
Const SRCPAINT = &HEE0086 ' dest = source OR dest
'Dim Ship(1 To 4) As tShip
' The x and y coordinates for the Sprite
Dim SpriteX As Integer
Dim SpriteY As Integer
' The x and y coordinates for the upper left corner
' of the large bitmap (picBMP).
Dim BackgroundX As Integer
Dim BackgroundY As Integer
' The width and height of the work area bitmap (picWork).
Dim WorkWidth As Integer
Dim WorkHeight As Integer
Dim ldist As Integer
Dim zcomponent As Integer
Dim s4b(51) As String
Dim s4bmask(51) As String
Dim csmDock(51) As String
Dim csmMask(51) As String
Private Sub JoyControl(Index As Integer)
Dim x As Integer
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
'Ydock = Ydock - 1
auxcon(0).Picture = auxcon(1).Picture
Case Is = 1
'Xdock = Xdock + 1
auxcon(0).Picture = auxcon(2).Picture
Case Is = 2
'Ydock = Ydock + 1
auxcon(0).Picture = auxcon(3).Picture
Case Is = 3
'Xdock = Xdock - 1
auxcon(0).Picture = auxcon(4).Picture
End Select
'x = playSound("rcstrst.wav", 3, 0)
End Sub
Public Function playSound(sname As String, chan As Integer, lp As Integer)
Select Case lp
' don't loop
Case 0
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (False)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' loop
Case 1
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (True)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' stop loop
Case 2
WAVMIX_StopChannel chan
End Select
End Function
Private Sub auxjoy_Click(Index As Integer)
Dim x As Integer
Dim currpath As String
currpath = cddrive + "\docking\csm4\"
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
Ydock = Ydock - 1
auxcon(0).Picture = auxcon(1).Picture
Case Is = 1
Xdock = Xdock + 1
auxcon(0).Picture = auxcon(2).Picture
Case Is = 2
Ydock = Ydock + 1
auxcon(0).Picture = auxcon(3).Picture
Case Is = 3
Xdock = Xdock - 1
auxcon(0).Picture = auxcon(4).Picture
End Select
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
'x = playSound("rcstrst.wav", 3, 0)
End Sub
Private Sub btnStart_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Rem --- set the pallette pref
picBGOriginal.ZOrder 0
Dim rc As Long
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
StartGame
End If
End Sub
Private Sub cmdExit_Click()
' Shut down the WaveMix .DLL.
WAVMIX_Close
Unload Me
End Sub
Private Sub FOREREV_Click(Index As Integer)
Dim x As Integer
Select Case Index
Case Is = 0
Case Is = 1
End Select
x = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub centerCalibrate_Click()
Dim tempx, tempy As Long
centx = JoyInfo.x
centy = JoyInfo.Y
' label11.Caption = "Centerx " + centx
' Label12.Caption = "Centery " + centy
leftX = (centx - leftj) / 2
tempx = (rightj - centx) / 2
rightX = rightj - tempx
topY = (centy - topj) / 2
tempy = (bottomj - centy) / 2
bottomY = bottomj - tempy
' Calibrate.Visible = False
End Sub
Private Sub Command2_Click(Index As Integer)
Dim x As Integer
Dim currpath As String
currpath = cddrive + "\docking\csm4\"
Select Case Index
Case Is = 0
Zdock = Zdock - 1
Case Is = 1
Zdock = Zdock + 1
End Select
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub Form_Load()
Dim rc As Long
'------------------------------------------------------------
' Set up the form when its first loaded.
'------------------------------------------------------------
Rem joyst
'RangeWidth = picBackground.ScaleWidth - imgJoyCursor.Width
'RangeHeight = picBackground.ScaleWidth - imgJoyCursor.Height
Rem
Rem --- set the pallette pref
'picBGOriginal.ZOrder 0
'If MissionState = 2 Then
'picBGOriginal = LoadPicture(cddrive + "\landsite\mountz3.bmp")
' picBGOriginal = LoadPicture(cddrive + "\docking\csm4\strfld2.bmp")
'Else
' picBGOriginal = LoadPicture(cddrive + "\docking\csm4\strfld3.bmp")
'End If
' Hide the scope and background PictureBoxes.
picBackground.Visible = False
'picScope.Visible = False
' Copy the cockpit "sprite" image into the background PictureBox.
picBackground.Picture = picPitSprite.Picture
' Center the form on the screen.
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
MouseButtonDown = NO_BUTTON
Rem --- %%% Initialize WaveMix DLL %%% ---
' If Not WAVMIX_InitMixer() Then
' MsgBox "Unable to Initialize WaveMix DLL"
' End
' End If
Xdock = 0
Ydock = 0
ldist = 45
s4b(1) = cddrive + "\docking\s4b\s4b1.bmp"
s4b(2) = cddrive + "\docking\s4b\s4b2.bmp"
s4b(3) = cddrive + "\docking\s4b\s4b3.bmp"
s4b(4) = cddrive + "\docking\s4b\s4b4.bmp"
s4b(5) = cddrive + "\docking\s4b\s4b5.bmp"
s4b(6) = cddrive + "\docking\s4b\s4b6.bmp"
s4b(7) = cddrive + "\docking\s4b\s4b7.bmp"
s4b(8) = cddrive + "\docking\s4b\s4b8.bmp"
s4b(9) = cddrive + "\docking\s4b\s4b9.bmp"
s4b(10) = cddrive + "\docking\s4b\s4b10.bmp"
s4b(11) = cddrive + "\docking\s4b\s4b11.bmp"
s4b(12) = cddrive + "\docking\s4b\s4b12.bmp"
s4b(13) = cddrive + "\docking\s4b\s4b13.bmp"
s4b(14) = cddrive + "\docking\s4b\s4b14.bmp"
s4b(15) = cddrive + "\docking\s4b\s4b15.bmp"
s4b(16) = cddrive + "\docking\s4b\s4b16.bmp"
s4b(17) = cddrive + "\docking\s4b\s4b17.bmp"
s4b(18) = cddrive + "\docking\s4b\s4b18.bmp"
csmDock(1) = cddrive + "\docking\CSM\csm1.bmp"
csmDock(2) = cddrive + "\docking\CSM\csm2.bmp"
csmDock(3) = cddrive + "\docking\CSM\csm3.bmp"
csmDock(4) = cddrive + "\docking\CSM\csm4.bmp"
csmDock(5) = cddrive + "\docking\CSM\csm5.bmp"
csmDock(6) = cddrive + "\docking\CSM\csm6.bmp"
csmDock(7) = cddrive + "\docking\CSM\csm7.bmp"
csmDock(8) = cddrive + "\docking\CSM\csm8.bmp"
csmDock(9) = cddrive + "\docking\CSM\csm9.bmp"
csmDock(10) = cddrive + "\docking\CSM\csm10.bmp"
csmDock(11) = cddrive + "\docking\CSM\csm11.bmp"
csmDock(12) = cddrive + "\docking\CSM\csm12.bmp"
csmDock(13) = cddrive + "\docking\CSM\csm13.bmp"
csmDock(14) = cddrive + "\docking\CSM\csm14.bmp"
csmDock(15) = cddrive + "\docking\CSM\csm15.bmp"
csmDock(16) = cddrive + "\docking\CSM\csm16.bmp"
csmDock(17) = cddrive + "\docking\CSM\csm17.bmp"
csmDock(18) = cddrive + "\docking\CSM\csm18.bmp"
'***********************************
Rem *************** masks *********
'**********************************
s4bmask(1) = cddrive + "\docking\mask\s4b1m.bmp"
s4bmask(2) = cddrive + "\docking\mask\s4b2m.bmp"
s4bmask(3) = cddrive + "\docking\mask\s4b3m.bmp"
s4bmask(4) = cddrive + "\docking\mask\s4b4m.bmp"
s4bmask(5) = cddrive + "\docking\mask\s4b5m.bmp"
s4bmask(6) = cddrive + "\docking\mask\s4b6m.bmp"
s4bmask(7) = cddrive + "\docking\mask\s4b7m.bmp"
s4bmask(8) = cddrive + "\docking\mask\s4b8m.bmp"
s4bmask(9) = cddrive + "\docking\mask\s4b9m.bmp"
s4bmask(10) = cddrive + "\docking\mask\s4b10m.bmp"
s4bmask(11) = cddrive + "\docking\mask\s4b11m.bmp"
s4bmask(12) = cddrive + "\docking\mask\s4b12m.bmp"
s4bmask(13) = cddrive + "\docking\mask\s4b13m.bmp"
s4bmask(14) = cddrive + "\docking\mask\s4b14m.bmp"
s4bmask(15) = cddrive + "\docking\mask\s4b15m.bmp"
s4bmask(16) = cddrive + "\docking\mask\s4b16m.bmp"
s4bmask(17) = cddrive + "\docking\mask\s4b17m.bmp"
s4bmask(18) = cddrive + "\docking\mask\s4b18m.bmp"
csmMask(1) = cddrive + "\docking\cMask\cMask1.bmp"
csmMask(2) = cddrive + "\docking\cMask\cMask2.bmp"
csmMask(3) = cddrive + "\docking\cMask\cMask3.bmp"
csmMask(4) = cddrive + "\docking\cMask\cMask4.bmp"
csmMask(5) = cddrive + "\docking\cMask\cMask5.bmp"
csmMask(6) = cddrive + "\docking\cMask\cMask6.bmp"
csmMask(7) = cddrive + "\docking\cMask\cMask7.bmp"
csmMask(8) = cddrive + "\docking\cMask\cMask8.bmp"
csmMask(9) = cddrive + "\docking\cMask\cMask9.bmp"
csmMask(10) = cddrive + "\docking\cMask\cMask10.bmp"
csmMask(11) = cddrive + "\docking\cMask\cMask11.bmp"
csmMask(12) = cddrive + "\docking\cMask\cMask12.bmp"
csmMask(13) = cddrive + "\docking\cMask\cMask13.bmp"
csmMask(14) = cddrive + "\docking\cMask\cMask14.bmp"
csmMask(15) = cddrive + "\docking\cMask\cMask15.bmp"
csmMask(16) = cddrive + "\docking\cMask\cMask16.bmp"
csmMask(17) = cddrive + "\docking\cMask\cMask17.bmp"
csmMask(18) = cddrive + "\docking\cMask\cMask18.bmp"
Rem *** check to see if joystick will be used ***
If joystick = 1 Then
'Calibrate.Visible = True
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
StartGame
calibrator
Else
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
StartGame
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
WAVMIX_Close
Unload Me
End Sub
Private Sub Frame1_DragDrop(Source As Control, x As Single, Y As Single)
End Sub
Private Sub Image1_Click(Index As Integer)
Select Case Index
Case Is = 0 'Csm1
CurrentForm = 1
docking.Hide
Case Is = 1 'Csm2
CurrentForm = 2
docking.Hide
Case Is = 2 'Dock Lock if properly docked
End Select
End Sub
Private Sub SSCommand1_Click(Index As Integer)
Dim x As Integer
Dim currpath As String
currpath = cddrive + "\docking\csm4\"
Select Case Index
Case Is = 0
Zdock = Zdock - 1
Case Is = 1
Zdock = Zdock + 1
End Select
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
'x = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub Start_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Static NotFirstTime As Integer
' Me.Show
' Sprites only need to be initialized the first time
' the game is played.
' If Not NotFirstTime Then
' SpriteInit Ship(1).Sprite, Me, picImage, picmask , picWorkBG, 50
' Ship(1).Visible = 1
' Ship(1).MaxHits = 3
' NotFirstTime = True
' End If
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
End If
End Sub
Private Sub Text1_Change()
End Sub
Private Sub Timer1_Timer()
Static xpos, ypos As Integer
Static passed_s4b, reorient As Integer
Static tempd As Integer
Dim rc As Long
Dim xtoken, ytoken As Integer
'Joystick docking etc.
Static xComponent As Integer
Static yComponent As Integer
Static zcomponent As Integer
Rem joyst
Dim x As Integer
'Dim i As Integer
Dim WhereAmI, whereisX, whereisY, wheretoken As Integer
'lblZ = ldist
Dim currpath As String
currpath = cddrive + "\docking\csm4\"
closerate.Caption = ypos
distance.Caption = xpos
UpdateBackground
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
If ldist <= 0 Then
passed_s4b = 1
Zdock = -Zdock
reorient = 1
End If
'calculate distance from s4sb
If passed_s4b = 1 Then
Rem hide s4b
End If
ldist = ldist + Zdock
If ldist <= 140 And ldist > 131 Then tempd = 18
If ldist <= 130 And ldist > 121 Then tempd = 17
If ldist <= 120 And ldist > 111 Then tempd = 16
If ldist <= 110 And ldist > 101 Then tempd = 15
If ldist <= 100 And ldist > 91 Then tempd = 14
If ldist <= 90 And ldist > 81 Then tempd = 13
If ldist <= 80 And ldist > 71 Then tempd = 12
If ldist <= 70 And ldist > 61 Then tempd = 11
If ldist <= 60 And ldist > 51 Then tempd = 10
If ldist <= 50 And ldist > 41 Then tempd = 9
If ldist <= 40 And ldist > 31 Then tempd = 8
' If ldist <= 30 And ldist > 21 Then tempd = 7
' If ldist <= 20 And ldist > 10 Then tempd = 6
If ldist <= 1 Then
xtoken = xpos
ytoken = ypos
' Call Check_For_Crash(xtoken, ytoken)
End If
If tempd > 5 And tempd < 19 Then
If MissionState = 3 Then
picImage = LoadPicture(s4b(tempd))
picMask = LoadPicture(s4bmask(tempd))
Else
picImage = LoadPicture(csmDock(tempd))
picMask = LoadPicture(csmMask(tempd))
End If
End If
Rem ********************************************************************************
xpos = xpos - Xdock
ypos = ypos - Ydock
Rem --- if x is off left side ---
If xpos < -picPitSprite.ScaleWidth + picImage.ScaleWidth Then
xpos = 800 - picPitSprite.ScaleWidth + picImage.ScaleWidth
Else 'if off right side
If xpos > 800 - picImage.ScaleWidth Then xpos = 0 - picImage.ScaleWidth
End If
Rem --- if y is off top side ---
If ypos < -picImage.ScaleHeight Then
ypos = 600 - picImage.ScaleHeight
Else 'if off bottom
If ypos > 600 - picImage.ScaleHeight Then ypos = 0 - picImage.ScaleHeight
End If
' Copy a section of the large bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, 0, 0, SRCCOPY)
' Copy the sprite work area onto the background.
'rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' Draw the sprite mask bitmap into the work area.
'*** rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
'draw sprite into the work area
'*** rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Draw the cockpit mask into the work area.
'*** rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitMask.hDC, 0, 0, SRCAND)
'draw cockpit
'*** rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitSprite.hDC, 0, 0, SRCPAINT)
'FlickerlessSpriteMove
' Draw the whole thing back onto the screen.
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.Width, picBackground.Height, picWorkBG.hDC, 0, 0, SRCCOPY)
auxjoy(0).Visible = True
auxjoy(1).Visible = True
auxjoy(2).Visible = True
auxjoy(3).Visible = True
auxcon(0).Picture = auxcon(5).Picture
Rem
Rem
Rem Joystick
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If rc = 0 Then
'imgJoyCursor.Left = RangeWidth * ((JoyInfo.X - JoyCaps.Xmin) / (JoyCaps.Xmax - JoyCaps.Xmin))
'imgJoyCursor.Top = RangeHeight * ((JoyInfo.Y - JoyCaps.Ymin) / (JoyCaps.Ymax - JoyCaps.Ymin))
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
'BackgroundX = HScroll1
'BackgroundX = HScroll1
' rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, landsite.hDC, BackgroundX + xComponent, BackgroundY, SRCCOPY)
'calculate distance from s4sb
ldist = ldist + zcomponent
End If
Rem --- check for left or right
whereisX = 0
If JoyInfo.x < leftX Then
whereisX = -1
Else
If JoyInfo.x > rightX Then
whereisX = 1
End If
End If
Rem --- check for up or down
whereisY = 0
If JoyInfo.Y < topY Then
whereisY = -1
Else
If JoyInfo.Y > bottomY Then
whereisY = 1
End If
End If
wheretoken = whereisX + whereisY
WhereAmI = 4
If wheretoken = 1 Then
If whereisX = 1 Then
WhereAmI = 1
Else
WhereAmI = 2
End If
End If
If wheretoken = -1 Then
If whereisY = -1 Then
WhereAmI = 0
Else
WhereAmI = 3
End If
End If
Command1.Caption = WhereAmI
If WhereAmI <> 4 Then
Call JoyControl((WhereAmI))
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 1 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock + 1
'xComponent = xComponent + 1
Call JoyControl(1)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 3 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Xdock = Xdock - 1
'xComponent = xComponent - 1
Call JoyControl(3)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 2 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock + 1
'yComponent = yComponent + 1
Call JoyControl(2)
End If
If JoyInfo.ButtonDown(1) And WhereAmI = 0 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Ydock = Ydock - 1
'yComponent = yComponent - 1
Call JoyControl(0)
End If
If JoyInfo.ButtonDown(2) And WhereAmI = 2 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Zdock = Zdock + 1
End If
If JoyInfo.ButtonDown(2) And WhereAmI = 0 Then
x = playSound(currpath + "rcstrst.wav", EFFECTS, NO_LUPE)
Zdock = Zdock - 1
End If
Rem
Rem
Rem end joystick
End Sub
Private Sub Form_MouseDown(BUTTON As Integer, Shift As Integer, x As Single, Y As Single)
'----------------------------------------------------------
' Set the module-level MouseButtonDown variable, so that
' the Mouse Control timer knows a button was pushed.
'----------------------------------------------------------
MouseButtonDown = BUTTON
End Sub
Private Sub Pause(Seconds As Single)
'------------------------------------------------------------
' Delay for a specified number of seconds.
'------------------------------------------------------------
Dim Start As Single
Start = Timer
Do While (Timer - Start) < Seconds
DoEvents
Loop
End Sub
Private Sub StartGame()
'------------------------------------------------------------
' Initialize everything and start the game.
'------------------------------------------------------------
Dim rc As Integer
Dim i As Integer
Static NotFirstTime As Integer
Me.Show
picBackground.Visible = True
ScrollSpeed = 5
Timer1.Enabled = True
End Sub
Private Sub UpdateBackground()
'------------------------------------------------------------
' The first step in building a new view is to copy the
' next section of the original background onto the working
' background picture box.
'------------------------------------------------------------
'Static LastXdir As Integer
'Static LastYdir As Integer
' BGMove picWorkBG, picBGOriginal, LastXdir * 2, LastYdir * 2
BGMove picWorkBG, picBGOriginal, Xdock, Ydock
' End If
End Sub
Private Sub FlickerlessSpriteMove()
'-----------------------------------------------------
' Moving a sprite without flicker requires the use
' of an off-screen work area into which we copy a
' section of the background and sprite.
'-----------------------------------------------------
Dim rc As Integer
WorkWidth = 2090
WorkHeight = 2020
BackgroundX = SpriteX
BackgroundY = SpriteY
' Calculate the next position for the sprite, and any
' necessary direction changes.
GetNextPos picImage.ScaleWidth, picImage.ScaleHeight
' Copy a section of the large bitmap into the work area.
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY)
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBackground.hDC, (SpriteX), (SpriteY), SRCCOPY)
rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (SpriteX), (SpriteY), SRCCOPY)
' Draw the mask and sprite bitmaps into the work area.
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
'rc = BitBlt(picWork.hDC, 0, 0, picmask.ScaleWidth, picmask.ScaleHeight, picmask.hDC, 0, 0, SRCAND)
'rc = BitBlt(picWork.hDC, 0, 0, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Copy the work area onto the background.
' rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' rc = BitBlt(picBackground.hDC, 10, 10, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
DoEvents
End Sub
Private Sub GetNextPos(ByVal AWidth As Integer, ByVal AHeight As Integer)
'-----------------------------------------------------
' Calculate the next position for the sprite, and
' make any necessary direction changes.
'-----------------------------------------------------
Xdir = Xdock
Ydir = Ydock
' Calculate the new position for the sprite.
SpriteX = SpriteX + (Xdir)
SpriteY = SpriteY + (Ydir)
End Sub
Public Sub calibrator()
Dim k, rc As Integer
k = 0
DoEvents
Do
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If JoyInfo.ButtonDown(1) Then
leftj = JoyInfo.x
topj = JoyInfo.Y
k = 1
End If
Loop While k = 0
'textCalibrator.Text = "Move Joystick to Lower Right and Press Button 2"
DoEvents
Do
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
If JoyInfo.ButtonDown(2) Then
rightj = JoyInfo.x
bottomj = JoyInfo.Y
k = 2
End If
Loop While k = 1
rc = GetJoyStickPos(JOYSTICK1, JoyInfo)
' textCalibrator.Text = ""
DoEvents
'centerCalibrate.Visible = True
End Sub
Public Sub Check_For_Crash(xtoken As Integer, ytoken As Integer)
End Sub
\LANDING
\LM4
DOCKING.FRM
VERSION 4.00
Begin VB.Form docking
Caption = "Docking with the Lunar Module"
ClientHeight = 6030
ClientLeft = 1275
ClientTop = 1515
ClientWidth = 6720
Height = 6435
Left = 1215
LinkTopic = "Form1"
ScaleHeight = 6030
ScaleWidth = 6720
Top = 1170
Width = 6840
Begin VB.PictureBox PicSave
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 8625
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 21
Top = 7305
Width = 1500
End
Begin VB.PictureBox PicWork
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 6975
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 20
Top = 7275
Width = 1500
End
Begin VB.PictureBox PicMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 2505
Left = 2460
Picture = "DOCKING.frx":0000
ScaleHeight = 167
ScaleMode = 3 'Pixel
ScaleWidth = 195
TabIndex = 19
Top = 7530
Width = 2925
End
Begin VB.PictureBox PicImage
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 2520
Left = 5295
Picture = "DOCKING.frx":8028
ScaleHeight = 168
ScaleMode = 3 'Pixel
ScaleWidth = 196
TabIndex = 18
Top = 7230
Width = 2940
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 5
Left = 11295
Picture = "DOCKING.frx":101E8
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 10
Top = 2115
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 4
Left = 11010
Picture = "DOCKING.frx":12FB4
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 9
Top = 1755
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 3
Left = 10785
Picture = "DOCKING.frx":15D84
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 8
Top = 1530
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 2
Left = 10590
Picture = "DOCKING.frx":18B54
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 7
Top = 1290
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 1
Left = 10440
Picture = "DOCKING.frx":1B924
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 6
Top = 1005
Width = 1755
End
Begin VB.PictureBox picWorkBG
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00400000&
DragIcon = "DOCKING.frx":1E6F4
ForeColor = &H80000008&
Height = 4860
Left = 2895
ScaleHeight = 322
ScaleMode = 3 'Pixel
ScaleWidth = 635
TabIndex = 5
Top = 7365
Width = 9555
End
Begin VB.PictureBox picBGoriginal
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 9015
Left = -7320
Picture = "DOCKING.frx":1E9FE
ScaleHeight = 599
ScaleMode = 3 'Pixel
ScaleWidth = 799
TabIndex = 4
Top = 7215
Width = 12015
End
Begin VB.PictureBox picPitMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 9795
Picture = "DOCKING.frx":94142
ScaleHeight = 5205
ScaleWidth = 9600
TabIndex = 3
Top = 6555
Width = 9600
End
Begin VB.PictureBox picPitSprite
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 9765
Picture = "DOCKING.frx":CA50E
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 2
Top = 270
Width = 9600
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 55
Left = 9960
Top = 5865
End
Begin VB.PictureBox Picture4
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 7200
Left = 0
Picture = "DOCKING.frx":10096A
ScaleHeight = 7200
ScaleWidth = 9600
TabIndex = 0
Top = -30
Width = 9600
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 0
Left = 4170
Picture = "DOCKING.frx":14BDAE
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 11
Top = 5475
Width = 1755
Begin Threed.SSCommand SSCommand1
Height = 330
Index = 1
Left = 1185
TabIndex = 15
Top = 1080
Width = 555
_version = 65536
_extentx = 979
_extenty = 582
_stockprops = 78
caption = "REV"
bevelwidth = 4
font3d = 4
End
Begin Threed.SSCommand SSCommand1
Height = 330
Index = 0
Left = 0
TabIndex = 14
Top = 1065
Width = 555
_version = 65536
_extentx = 979
_extenty = 582
_stockprops = 78
caption = "FWD"
bevelwidth = 4
font3d = 4
End
Begin VB.Image auxjoy
Height = 300
Index = 0
Left = 720
Picture = "DOCKING.frx":14EB7A
Top = 255
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 1
Left = 1035
Picture = "DOCKING.frx":14ECDA
Top = 570
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 2
Left = 720
Picture = "DOCKING.frx":14EED6
Top = 885
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 3
Left = 405
Picture = "DOCKING.frx":14F0D2
Top = 570
Width = 300
End
End
Begin VB.PictureBox picBackground
Appearance = 0 'Flat
BackColor = &H00000000&
BorderStyle = 0 'None
DragIcon = "DOCKING.frx":14F2CE
ForeColor = &H80000008&
Height = 5205
Left = 0
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 1
Top = 120
Width = 9600
End
Begin VB.Label distance
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1410
TabIndex = 17
Top = 6420
Width = 600
End
Begin VB.Label closerate
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1395
TabIndex = 16
Top = 5805
Width = 600
End
Begin Threed.SSCommand Leave
Height = 360
Left = 6090
TabIndex = 13
Top = 6630
Width = 3105
_version = 65536
_extentx = 5477
_extenty = 635
_stockprops = 78
caption = "EXIT"
BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713}
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
font3d = 4
End
Begin Threed.SSCommand start
Height = 360
Left = 6105
TabIndex = 12
Top = 6225
Width = 3105
_version = 65536
_extentx = 5477
_extenty = 635
_stockprops = 78
caption = "START"
BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713}
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
font3d = 4
End
End
End
Attribute VB_Name = "docking"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim ScrollSpeed As Integer ' The ship's current turning speed
' Constants for mouse action.
Const NO_BUTTON = 0
Const LBUTTON = 1
Const RBUTTON = 2
' Constants for WaveMix channels
Const BACKGROUND = 0
Const MISSION_CONTROL = 1
Const BUTTONS = 2
Const EFFECTS = 3
Const WARNINGS = 4
Const MCSECOND = 5
Const LUPE = 1
Const NO_LUPE = 0
' Boolean that indicates if mouse button has been pressed down.
Dim MouseButtonDown As Integer
' Windows API calls
Private Declare Function GetPixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
Private Declare Function setpixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
Private Declare Function ellipse Lib "GDI" (ByVal hDC As Integer, ByVal nLeft As Integer, ByVal nTop As Integer, ByVal nRight As Integer, ByVal nBottom As Integer) As Long
Private Declare Function LineTo Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Integer
Private Declare Function Polyline Lib "GDI" (ByVal hDC As Integer, lpPoints As POINTAPI, ByVal nCount As Integer) As Integer
Private Declare Function MoveTo Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
'-----------------------------------------------------
' BITDEMO1.FRM
' This program demonstrates some of the methods used
' to display bitmaps and sprites.
'-----------------------------------------------------
' The number of pixels to offset the sprite
' each time it is moved.
Const INCREMENT = 1
' Constants for Raster Operations used by BitBlt function.
Const SRCAND = &H8800C6 ' dest = source AND dest
Const SRCCOPY = &HCC0020 ' dest = source
Const SRCPAINT = &HEE0086 ' dest = source OR dest
' The BitBlt Windows API call.
Private Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
Dim Ship(1 To 4) As tShip
' The x and y coordinates for the Sprite
Dim SpriteX As Integer
Dim SpriteY As Integer
' The x and y coordinates for the upper left corner
' of the large bitmap (picBMP).
Dim BackgroundX As Integer
Dim BackgroundY As Integer
' The width and height of the work area bitmap (picWork).
Dim WorkWidth As Integer
Dim WorkHeight As Integer
Dim ldist As Integer
Dim zcomponent As Integer
Dim s4b(51) As String
Dim s4bmask(51) As String
Public Function playSound(sname As String, chan As Integer, lp As Integer)
Select Case lp
' don't loop
Case 0
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (False)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' loop
Case 1
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (True)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' stop loop
Case 2
WAVMIX_StopChannel chan
End Select
End Function
Private Sub auxjoy_Click(Index As Integer)
Dim X As Integer
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
Ydock = Ydock - 1
auxcon(0).Picture = auxcon(1).Picture
Case Is = 1
Xdock = Xdock + 1
auxcon(0).Picture = auxcon(2).Picture
Case Is = 2
Ydock = Ydock + 1
auxcon(0).Picture = auxcon(3).Picture
Case Is = 3
Xdock = Xdock - 1
auxcon(0).Picture = auxcon(4).Picture
End Select
X = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
'x = playSound("rcstrst.wav", 3, 0)
End Sub
Private Sub btnStart_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Dim rc As Long
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
StartGame
End If
End Sub
Private Sub cmdExit_Click()
' Shut down the WaveMix .DLL.
WAVMIX_Close
Unload Me
End Sub
Private Sub FOREREV_Click(Index As Integer)
Dim X As Integer
Select Case Index
Case Is = 0
Case Is = 1
End Select
X = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub Form_Load()
'------------------------------------------------------------
' Set up the form when its first loaded.
'------------------------------------------------------------
' Hide the scope and background PictureBoxes.
picBackground.Visible = False
'picScope.Visible = False
' Copy the cockpit "sprite" image into the background PictureBox.
picBackground.Picture = picPitSprite.Picture
' Center the form on the screen.
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
MouseButtonDown = NO_BUTTON
Rem --- %%% Initialize WaveMix DLL %%% ---
If Not WAVMIX_InitMixer() Then
MsgBox "Unable to Initialize WaveMix DLL"
End
End If
Xdock = 0
Ydock = 0
ldist = 125
's4b(1) = "D:\docking\dock\dock1.bmp"
's4b(2) = "D:\docking\dock\dock2.bmp"
's4b(3) = "D:\docking\dock\dock3.bmp"
's4b(4) = "D:\docking\dock\dock4.bmp"
's4b(5) = "D:\docking\dock\dock5.bmp"
's4b(6) = "D:\docking\dock\dock6.bmp"
's4b(7) = "D:\docking\dock\dock7.bmp"
's4b(8) = "D:\docking\dock\dock8.bmp"
's4b(9) = "D:\docking\dock\dock9.bmp"
's4b(10) = "D:\docking\dock\dock10.bmp"
's4b(11) = "D:\docking\dock\dock11.bmp"
's4b(12) = "D:\docking\dock\dock12.bmp"
's4b(13) = "D:\docking\dock\dock13.bmp"
's4b(14) = "D:\docking\dock\dock14.bmp"
's4b(15) = "D:\docking\dock\dock15.bmp"
's4b(16) = "D:\docking\dock\dock16.bmp"
's4b(17) = "D:\docking\dock\dock17.bmp"
's4b(18) = "D:\docking\dock\dock18.bmp"
's4b(19) = "D:\docking\dock\dock19.bmp"
's4b(20) = "D:\docking\dock\dock20.bmp"
's4b(21) = "D:\docking\dock\dock21.bmp"
's4b(22) = "D:\docking\dock\dock22.bmp"
's4b(23) = "D:\docking\dock\dock23.bmp"
's4b(24) = "D:\docking\dock\dock24.bmp"
's4b(25) = "D:\docking\dock\dock25.bmp"
's4b(26) = "D:\docking\dock\dock26.bmp"
's4b(27) = "D:\docking\dock\dock27.bmp"
's4b(28) = "D:\docking\dock\dock28.bmp"
's4b(29) = "D:\docking\dock\dock29.bmp"
's4b(30) = "D:\docking\dock\dock30.bmp"
's4b(31) = "D:\docking\dock\dock31.bmp"
's4b(32) = "D:\docking\dock\dock32.bmp"
's4b(33) = "D:\docking\dock\dock33.bmp"
's4b(34) = "D:\docking\dock\dock34.bmp"
's4b(35) = "D:\docking\dock\dock35.bmp"
's4b(36) = "D:\docking\dock\dock36.bmp"
's4b(37) = "D:\docking\dock\dock37.bmp"
's4b(38) = "D:\docking\dock\dock38.bmp"
's4b(39) = "D:\docking\dock\dock39.bmp"
's4b(40) = "D:\docking\dock\dock40.bmp"
's4b(41) = "D:\docking\dock\dock41.bmp"
's4b(42) = "D:\docking\dock\dock42.bmp"
's4b(43) = "D:\docking\dock\dock43.bmp"
's4b(44) = "D:\docking\dock\dock44.bmp"
's4b(45) = "D:\docking\dock\dock45.bmp"
's4b(46) = "D:\docking\dock\dock46.bmp"
's4b(47) = "D:\docking\dock\dock47.bmp"
's4b(48) = "D:\docking\dock\dock48.bmp"
's4b(49) = "D:\docking\dock\dock49.bmp"
's4b(50) = "D:\docking\dock\dock50.bmp"
'***********************************
Rem *************** masks *********
'*********************************
's4bmask(1) = "D:\docking\mask\m1.bmp"
's4bmask(2) = "D:\docking\mask\m2.bmp"
's4bmask(3) = "D:\docking\mask\m3.bmp"
's4bmask(4) = "D:\docking\mask\m4.bmp"
's4bmask(5) = "D:\docking\mask\m5.bmp"
's4bmask(6) = "D:\docking\mask\m6.bmp"
's4bmask(7) = "D:\docking\mask\m7.bmp"
's4bmask(8) = "D:\docking\mask\m8.bmp"
's4bmask(9) = "D:\docking\mask\m9.bmp"
's4bmask(10) = "D:\docking\mask\m10.bmp"
's4bmask(11) = "D:\docking\mask\m11.bmp"
's4bmask(12) = "D:\docking\mask\m12.bmp"
's4bmask(13) = "D:\docking\mask\m13.bmp"
's4bmask(14) = "D:\docking\mask\m14.bmp"
's4bmask(15) = "D:\docking\mask\m15.bmp"
's4bmask(16) = "D:\docking\mask\m16.bmp"
's4bmask(17) = "D:\docking\mask\m17.bmp"
's4bmask(18) = "D:\docking\mask\m18.bmp"
's4bmask(19) = "D:\docking\mask\m19.bmp"
's4bmask(20) = "D:\docking\mask\m20.bmp"
's4bmask(21) = "D:\docking\mask\m21.bmp"
's4bmask(22) = "D:\docking\mask\m22.bmp"
's4bmask(23) = "D:\docking\mask\m23.bmp"
's4bmask(24) = "D:\docking\mask\m24.bmp"
's4bmask(25) = "D:\docking\mask\m25.bmp"
's4bmask(26) = "D:\docking\mask\m26.bmp"
's4bmask(27) = "D:\docking\mask\m27.bmp"
's4bmask(28) = "D:\docking\mask\m28.bmp"
's4bmask(29) = "D:\docking\mask\m29.bmp"
's4bmask(30) = "D:\docking\mask\m30.bmp"
's4bmask(31) = "D:\docking\mask\m31.bmp"
's4bmask(32) = "D:\docking\mask\m32.bmp"
's4bmask(33) = "D:\docking\mask\m33.bmp"
's4bmask(34) = "D:\docking\mask\m34.bmp"
's4bmask(35) = "D:\docking\mask\m35.bmp"
's4bmask(36) = "D:\docking\mask\m36.bmp"
's4bmask(37) = "D:\docking\mask\m37.bmp"
's4bmask(38) = "D:\docking\mask\m38.bmp"
's4bmask(39) = "D:\docking\mask\m39.bmp"
's4bmask(40) = "D:\docking\mask\m40.bmp"
's4bmask(41) = "D:\docking\mask\m41.bmp"
's4bmask(42) = "D:\docking\mask\m42.bmp"
's4bmask(43) = "D:\docking\mask\m43.bmp"
's4bmask(44) = "D:\docking\mask\m44.bmp"
's4bmask(45) = "D:\docking\mask\m45.bmp"
's4bmask(46) = "D:\docking\mask\m46.bmp"
's4bmask(47) = "D:\docking\mask\m47.bmp"
's4bmask(48) = "D:\docking\mask\m48.bmp"
's4bmask(49) = "D:\docking\mask\m49.bmp"
's4bmask(50) = "D:\docking\mask\m50.bmp"
'***********************************
Rem ************ Temp *************
'***********************************
s4b(1) = "D:\tdock\dock\dock30.bmp"
s4b(2) = "D:\tdock\dock\dock31.bmp"
s4b(3) = "D:\tdock\dock\dock32.bmp"
s4b(4) = "D:\tdock\dock\dock33.bmp"
s4b(5) = "D:\tdock\dock\dock34.bmp"
s4b(6) = "D:\tdock\dock\dock35.bmp"
s4b(7) = "D:\tdock\dock\dock36.bmp"
s4b(8) = "D:\tdock\dock\dock37.bmp"
s4b(9) = "D:\tdock\dock\dock38.bmp"
s4b(10) = "D:\tdock\dock\dock39.bmp"
s4b(11) = "D:\tdock\dock\dock41.bmp"
s4b(12) = "D:\tdock\dock\dock42.bmp"
s4b(13) = "D:\tdock\dock\dock43.bmp"
s4b(14) = "D:\tdock\dock\dock44.bmp"
s4b(15) = "D:\tdock\dock\dock45.bmp"
Rem *********************************
s4bmask(1) = "D:\tdock\mask\mask30.bmp"
s4bmask(2) = "D:\tdock\mask\mask31.bmp"
s4bmask(3) = "D:\tdock\mask\mask32.bmp"
s4bmask(4) = "D:\tdock\mask\mask33.bmp"
s4bmask(5) = "D:\tdock\mask\mask34.bmp"
s4bmask(6) = "D:\tdock\mask\mask35.bmp"
s4bmask(7) = "D:\tdock\mask\mask36.bmp"
s4bmask(8) = "D:\tdock\mask\mask37.bmp"
s4bmask(9) = "D:\tdock\mask\mask38.bmp"
s4bmask(10) = "D:\tdock\mask\mask39.bmp"
s4bmask(11) = "D:\tdock\mask\mask41.bmp"
s4bmask(12) = "D:\tdock\mask\mask42.bmp"
s4bmask(13) = "D:\tdock\mask\mask43.bmp"
s4bmask(14) = "D:\tdock\mask\mask44.bmp"
s4bmask(15) = "D:\tdock\mask\mask45.bmp"
End Sub
Private Sub Form_Unload(Cancel As Integer)
WAVMIX_Close
Unload Me
End Sub
Private Sub Leave_Click()
' Shut down the WaveMix .DLL.
WAVMIX_Close
Unload Me
End
End Sub
Private Sub SSCommand1_Click(Index As Integer)
Dim X As Integer
Select Case Index
Case Is = 0
zcomponent = zcomponent - 1
Case Is = 1
zcomponent = zcomponent + 1
End Select
X = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub Start_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Dim rc As Long
Static NotFirstTime As Integer
' Me.Show
' Sprites only need to be initialized the first time
' the game is played.
' If Not NotFirstTime Then
' SpriteInit Ship(1).Sprite, Me, picImage, picmask , picWorkBG, 50
' Ship(1).Visible = 1
' Ship(1).MaxHits = 3
' NotFirstTime = True
' End If
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
StartGame
End If
End Sub
Private Sub Text1_Change()
End Sub
Private Sub Timer1_Timer()
'------------------------------------------------------------
' This routine is the heart of this game. It's a trifle
' monolithic, but that is in large part by design. By
' reducing the number of subroutines called from here, we
' can improve the game performance somewhat.
'
' Each pass through this routine, the game display is
' updated.
'------------------------------------------------------------
Static xpos, ypos As Integer
Dim tempd As Integer
Dim rc As Long
'lblZ = ldist
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
'calculate distance from s4sb
ldist = ldist + zcomponent
If ldist <= 4000 And ldist > 2500 Then tempd = 1
If ldist <= 2500 And ldist > 1700 Then tempd = 2
If ldist <= 1700 And ldist > 1200 Then tempd = 3
If ldist <= 1200 And ldist > 900 Then tempd = 4
If ldist <= 900 And ldist > 800 Then tempd = 5
If ldist <= 800 And ldist > 700 Then tempd = 6
If ldist <= 700 And ldist > 640 Then tempd = 7
If ldist <= 640 And ldist > 590 Then tempd = 8
If ldist <= 590 And ldist > 550 Then tempd = 9
If ldist <= 550 And ldist > 510 Then tempd = 10
If ldist <= 510 And ldist > 470 Then tempd = 12
If ldist <= 470 And ldist > 430 Then tempd = 13
If ldist <= 430 And ldist > 400 Then tempd = 14
If ldist <= 400 And ldist > 370 Then tempd = 15
If ldist <= 370 And ldist > 340 Then tempd = 16
If ldist <= 340 And ldist > 310 Then tempd = 17
If ldist <= 310 And ldist > 290 Then tempd = 18
If ldist <= 290 And ldist > 270 Then tempd = 19
If ldist <= 270 And ldist > 250 Then tempd = 20
If ldist <= 250 And ldist > 230 Then tempd = 21
If ldist <= 230 And ldist > 210 Then tempd = 22
If ldist <= 210 And ldist > 195 Then tempd = 23
If ldist <= 195 And ldist > 180 Then tempd = 24
If ldist <= 180 And ldist > 165 Then tempd = 25
If ldist <= 165 And ldist > 150 Then tempd = 26
If ldist <= 150 And ldist > 140 Then tempd = 27
If ldist <= 140 And ldist > 130 Then tempd = 28
If ldist <= 130 And ldist > 120 Then tempd = 29
If ldist <= 120 And ldist > 110 Then tempd = 30
If ldist <= 110 And ldist > 100 Then tempd = 31
If ldist <= 100 And ldist > 90 Then tempd = 32
If ldist <= 90 And ldist > 80 Then tempd = 33
If ldist <= 80 And ldist > 70 Then tempd = 34
If ldist <= 70 And ldist > 60 Then tempd = 35
If ldist <= 60 And ldist > 55 Then tempd = 36
If ldist <= 55 And ldist > 50 Then tempd = 37
If ldist <= 50 And ldist > 45 Then tempd = 38
If ldist <= 45 And ldist > 40 Then tempd = 39
If ldist <= 40 And ldist > 35 Then tempd = 40
' If ldist <= 35 And ldist > 30 Then tempd = 41
' If ldist <= 30 And ldist > 25 Then tempd = 42
' If ldist <= 25 And ldist > 17 Then tempd = 43
' If ldist <= 17 And ldist > 15 Then tempd = 44
' If ldist <= 15 And ldist > 13 Then tempd = 45
' If ldist <= 13 And ldist > 10 Then tempd = 46
' If ldist <= 10 And ldist > 7 Then tempd = 47
' If ldist <= 7 And ldist > 6 Then tempd = 48
' If ldist <= 6 And ldist > 5 Then tempd = 49
' If ldist <= 5 And ldist > 0 Then tempd = 50
'Select Case tempd
' Case Is = 1
' picImage = LoadPicture(s4b(1))
' picMask = LoadPicture(s4bmask(1))
' Case Is = 2
' picImage = LoadPicture(s4b(2))
' picMask = LoadPicture(s4bmask(2))
' Case Is = 3
' picImage = LoadPicture(s4b(3))
' picMask = LoadPicture(s4bmask(3))
' Case Is = 4
' picImage = LoadPicture(s4b(4))
' picMask = LoadPicture(s4bmask(4))
' Case Is = 5
' picImage = LoadPicture(s4b(5))
' picMask = LoadPicture(s4bmask(5))
' Case Is = 6
' picImage = LoadPicture(s4b(6))
' picMask = LoadPicture(s4bmask(6))
' Case Is = 7
' picImage = LoadPicture(s4b(7))
' picMask = LoadPicture(s4bmask(7))
' Case Is = 8
' picImage = LoadPicture(s4b(8))
' picMask = LoadPicture(s4bmask(8))
' Case Is = 9
' picImage = LoadPicture(s4b(9))
' picMask = LoadPicture(s4bmask(9))
' Case Is = 10
' picImage = LoadPicture(s4b(10))
' picMask = LoadPicture(s4bmask(10))
' Case Is = 11
' picImage = LoadPicture(s4b(11))
' picMask = LoadPicture(s4bmask(11))
' Case Is = 12
' picImage = LoadPicture(s4b(12))'
' picMask = LoadPicture(s4bmask(12))
' Case Is = 13
' picImage = LoadPicture(s4b(13))
' picMask = LoadPicture(s4bmask(13))
' Case Is = 14
' picImage = LoadPicture(s4b(14))
' picMask = LoadPicture(s4bmask(14))
' Case Is = 15
' picImage = LoadPicture(s4b(15))
' picMask = LoadPicture(s4bmask(15))
' Case Is = 16
' picImage = LoadPicture(s4b(16))
' picMask = LoadPicture(s4bmask(16))
' Case Is = 17
' picImage = LoadPicture(s4b(17))
' picMask = LoadPicture(s4bmask(17))
' Case Is = 18
' picImage = LoadPicture(s4b(18))
' picMask = LoadPicture(s4bmask(18))
' Case Is = 19
' picImage = LoadPicture(s4b(19))
' picMask = LoadPicture(s4bmask(19))
' Case Is = 20
' picImage = LoadPicture(s4b(20))
' picMask = LoadPicture(s4bmask(20))
' Case Is = 21
' picImage = LoadPicture(s4b(21))
' picMask = LoadPicture(s4bmask(21))
' Case Is = 22
' picImage = LoadPicture(s4b(22))
' picMask = LoadPicture(s4bmask(22))
' Case Is = 23
' picImage = LoadPicture(s4b(23))
' picMask = LoadPicture(s4bmask(23))
' Case Is = 24
' picImage = LoadPicture(s4b(24))
' picMask = LoadPicture(s4bmask(24))
' Case Is = 25
' picImage = LoadPicture(s4b(25))
' picMask = LoadPicture(s4bmask(25))
' Case Is = 26
' picImage = LoadPicture(s4b(26))
' picMask = LoadPicture(s4bmask(26))
' Case Is = 27
' picImage = LoadPicture(s4b(27))
' picMask = LoadPicture(s4bmask(27))
' Case Is = 28
' picImage = LoadPicture(s4b(28))
' picMask = LoadPicture(s4bmask(28))
' Case Is = 29
' picImage = LoadPicture(s4b(29))
' picMask = LoadPicture(s4bmask(29))
' Case Is = 30
' 'picImage = LoadPicture(s4b(30))
'picMask = LoadPicture(s4bmask(30))
' Case Is = 31
' picImage = LoadPicture(s4b(31))
' picMask = LoadPicture(s4bmask(31))
' Case Is = 32
' picImage = LoadPicture(s4b(32))
' picMask = LoadPicture(s4bmask(32))
' Case Is = 33
' picImage = LoadPicture(s4b(33))
' picMask = LoadPicture(s4bmask(33))
' Case Is = 34
' picImage = LoadPicture(s4b(34))
' picMask = LoadPicture(s4bmask(34))
' Case Is = 35
' picImage = LoadPicture(s4b(35))
' picMask = LoadPicture(s4bmask(35))
' Case Is = 36
' picImage = LoadPicture(s4b(36))
' picMask = LoadPicture(s4bmask(36))
' Case Is = 37
' picImage = LoadPicture(s4b(37))
' picMask = LoadPicture(s4bmask(37))
' Case Is = 38
' picImage = LoadPicture(s4b(38))
' picMask = LoadPicture(s4bmask(38))
' Case Is = 39
' picImage = LoadPicture(s4b(39))
' picMask = LoadPicture(s4bmask(39))
' Case Is = 40
' picImage = LoadPicture(s4b(40))
' picMask = LoadPicture(s4bmask(40))
' Case Is = 41
' picImage = LoadPicture(s4b(41))
' picMask = LoadPicture(s4bmask(41))
' Case Is = 42
' picImage = LoadPicture(s4b(42))
' picMask = LoadPicture(s4bmask(42))
' Case Is = 43
' picImage = LoadPicture(s4b(43))
' picMask = LoadPicture(s4bmask(43))
' Case Is = 44
' picImage = LoadPicture(s4b(44))
' picMask = LoadPicture(s4bmask(44))
' Case Is = 45
' picImage = LoadPicture(s4b(45))
' picMask = LoadPicture(s4bmask(45))
' Case Is = 46
' picImage = LoadPicture(s4b(46))
' picMask = LoadPicture(s4bmask(46))
' Case Is = 47
' picImage = LoadPicture(s4b(47))
' picMask = LoadPicture(s4bmask(47))
' Case Is = 48
' picImage = LoadPicture(s4b(48))
' picMask = LoadPicture(s4bmask(48))
' Case Is = 49
' picImage = LoadPicture(s4b(49))
' picMask = LoadPicture(s4bmask(49))
' Case Is = 50
' picImage = LoadPicture(s4b(50))
' picMask = LoadPicture(s4bmask(50))
' End Select
Rem **************** T E M P **********************
'************************************************
Select Case tempd
Case Is = 30
picImage = LoadPicture(s4b(1))
picMask = LoadPicture(s4bmask(1))
Case Is = 31
picImage = LoadPicture(s4b(2))
picMask = LoadPicture(s4bmask(2))
Case Is = 32
picImage = LoadPicture(s4b(3))
picMask = LoadPicture(s4bmask(3))
Case Is = 33
picImage = LoadPicture(s4b(4))
picMask = LoadPicture(s4bmask(4))
Case Is = 34
picImage = LoadPicture(s4b(5))
picMask = LoadPicture(s4bmask(5))
Case Is = 35
picImage = LoadPicture(s4b(6))
picMask = LoadPicture(s4bmask(6))
Case Is = 36
picImage = LoadPicture(s4b(7))
picMask = LoadPicture(s4bmask(7))
Case Is = 37
picImage = LoadPicture(s4b(8))
picMask = LoadPicture(s4bmask(8))
Case Is = 38
picImage = LoadPicture(s4b(9))
picMask = LoadPicture(s4bmask(9))
Case Is = 39
picImage = LoadPicture(s4b(10))
picMask = LoadPicture(s4bmask(10))
Case Is = 41
picImage = LoadPicture(s4b(11))
picMask = LoadPicture(s4bmask(11))
Case Is = 42
picImage = LoadPicture(s4b(12))
picMask = LoadPicture(s4bmask(12))
Case Is = 43
picImage = LoadPicture(s4b(13))
picMask = LoadPicture(s4bmask(13))
Case Is = 44
picImage = LoadPicture(s4b(14))
picMask = LoadPicture(s4bmask(14))
Case Is = 45
picImage = LoadPicture(s4b(15))
picMask = LoadPicture(s4bmask(15))
End Select
Rem ********************************************************************************
xpos = xpos - Xdock
closerate.Caption = tempd
ypos = ypos - Ydock
distance.Caption = ldist
' Update the background (starfield) based on the
' current speed and direction of the player's ship.
UpdateBackground
' Copy a section of the large bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, 0, 0, SRCCOPY)
' Copy the sprite work area onto the background.
'rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' Draw the sprite mask bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
'draw sprite into the work area
rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Draw the cockpit mask into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitMask.hDC, 0, 0, SRCAND)
'draw cockpit
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitSprite.hDC, 0, 0, SRCPAINT)
'FlickerlessSpriteMove
' Draw the whole thing back onto the screen.
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.Width, picBackground.Height, picWorkBG.hDC, 0, 0, SRCCOPY)
auxjoy(0).Visible = True
auxjoy(1).Visible = True
auxjoy(2).Visible = True
auxjoy(3).Visible = True
auxcon(0).Picture = auxcon(5).Picture
End Sub
Public Sub EndGame()
'------------------------------------------------------------
' Close everything down.
'------------------------------------------------------------
Dim rc As Long
' Shut down the WaveMix .DLL.
WAVMIX_Close
' Turn off the timer.
Timer1.Enabled = False
' Ready to start again?
btnStart.Caption = "&START"
Me.Refresh
' Wait a couple of seconds
Pause 5
picBackground.Visible = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'----------------------------------------------------------
' Set the module-level MouseButtonDown variable, so that
' the Mouse Control timer knows a button was pushed.
'----------------------------------------------------------
MouseButtonDown = Button
End Sub
Private Sub Pause(Seconds As Single)
'------------------------------------------------------------
' Delay for a specified number of seconds.
'------------------------------------------------------------
Dim Start As Single
Start = Timer
Do While (Timer - Start) < Seconds
DoEvents
Loop
End Sub
Private Sub StartGame()
'------------------------------------------------------------
' Initialize everything and start the game.
'------------------------------------------------------------
Dim rc As Integer
Dim i As Integer
Static NotFirstTime As Integer
Me.Show
picBackground.Visible = True
ScrollSpeed = 5
Timer1.Enabled = True
End Sub
Private Sub UpdateBackground()
'------------------------------------------------------------
' The first step in building a new view is to copy the
' next section of the original background onto the working
' background picture box.
'------------------------------------------------------------
'Static LastXdir As Integer
'Static LastYdir As Integer
' BGMove picWorkBG, picBGOriginal, LastXdir * 2, LastYdir * 2
BGMove picWorkBG, picBGOriginal, Xdock, Ydock
' End If
End Sub
Private Sub FlickerlessSpriteMove()
'-----------------------------------------------------
' Moving a sprite without flicker requires the use
' of an off-screen work area into which we copy a
' section of the background and sprite.
'-----------------------------------------------------
Dim rc As Integer
WorkWidth = 2090
WorkHeight = 2020
BackgroundX = SpriteX
BackgroundY = SpriteY
' Calculate the next position for the sprite, and any
' necessary direction changes.
GetNextPos picImage.ScaleWidth, picImage.ScaleHeight
' Copy a section of the large bitmap into the work area.
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY)
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBackground.hDC, (SpriteX), (SpriteY), SRCCOPY)
rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (SpriteX), (SpriteY), SRCCOPY)
' Draw the mask and sprite bitmaps into the work area.
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
'rc = BitBlt(picWork.hDC, 0, 0, picmask.ScaleWidth, picmask.ScaleHeight, picmask.hDC, 0, 0, SRCAND)
'rc = BitBlt(picWork.hDC, 0, 0, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Copy the work area onto the background.
' rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' rc = BitBlt(picBackground.hDC, 10, 10, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
DoEvents
End Sub
Private Sub GetNextPos(ByVal AWidth As Integer, ByVal AHeight As Integer)
'-----------------------------------------------------
' Calculate the next position for the sprite, and
' make any necessary direction changes.
'-----------------------------------------------------
xdir = Xdock
ydir = Ydock
' Calculate the new position for the sprite.
SpriteX = SpriteX + (xdir)
SpriteY = SpriteY + (ydir)
End Sub
DOCKING.LOG
Line 239: Class Threed.SSCommand of control SSCommand1 was not a loaded control class. Line 254: Class Threed.SSCommand of control SSCommand1 was not a loaded control class. Line 357: Class Threed.SSCommand of control Leave was not a loaded control class. Line 379: Class Threed.SSCommand of control start was not a loaded control class. Line 246: The property name _version in SSCommand1 is invalid. Line 247: The property name _extentx in SSCommand1 is invalid. Line 248: The property name _extenty in SSCommand1 is invalid. Line 249: The property name _stockprops in SSCommand1 is invalid. Line 250: The property name caption in SSCommand1 is invalid. Line 251: The property name bevelwidth in SSCommand1 is invalid. Line 252: The property name font3d in SSCommand1 is invalid. Line 261: The property name _version in SSCommand1 is invalid. Line 262: The property name _extentx in SSCommand1 is invalid. Line 263: The property name _extenty in SSCommand1 is invalid. Line 264: The property name _stockprops in SSCommand1 is invalid. Line 265: The property name caption in SSCommand1 is invalid. Line 266: The property name bevelwidth in SSCommand1 is invalid. Line 267: The property name font3d in SSCommand1 is invalid. Line 363: The property name _version in Leave is invalid. Line 364: The property name _extentx in Leave is invalid. Line 365: The property name _extenty in Leave is invalid. Line 366: The property name _stockprops in Leave is invalid. Line 367: The property name caption in Leave is invalid. Line 377: The property name font3d in Leave is invalid. Line 385: The property name _version in start is invalid. Line 386: The property name _extentx in start is invalid. Line 387: The property name _extenty in start is invalid. Line 388: The property name _stockprops in start is invalid. Line 389: The property name caption in start is invalid. Line 399: The property name font3d in start is invalid.
DOCKING2.FRM
VERSION 4.00
Begin VB.Form docking
Caption = "Docking with the Lunar Module"
ClientHeight = 6030
ClientLeft = 3975
ClientTop = 2115
ClientWidth = 6720
Height = 6435
Left = 3915
LinkTopic = "Form1"
ScaleHeight = 6030
ScaleWidth = 6720
Top = 1770
Width = 6840
Begin VB.PictureBox PicSave
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 8625
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 21
Top = 7305
Width = 1500
End
Begin VB.PictureBox PicWork
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 6975
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 20
Top = 7275
Width = 1500
End
Begin VB.PictureBox PicMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 2970
Picture = "DOCKING2.frx":0000
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 19
Top = 7440
Width = 1500
End
Begin VB.PictureBox PicImage
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1440
Left = 5295
Picture = "DOCKING2.frx":25CC
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 100
TabIndex = 18
Top = 7230
Width = 1500
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 5
Left = 2970
Picture = "DOCKING2.frx":4C14
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 10
Top = 2475
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 4
Left = 2340
Picture = "DOCKING2.frx":79E0
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 9
Top = 2505
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 3
Left = 1635
Picture = "DOCKING2.frx":A7B0
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 8
Top = 2505
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 2
Left = 1155
Picture = "DOCKING2.frx":D580
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 7
Top = 2460
Width = 1755
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 1
Left = 660
Picture = "DOCKING2.frx":10350
ScaleHeight = 1440
ScaleWidth = 1755
TabIndex = 6
Top = 2445
Width = 1755
End
Begin VB.PictureBox picWorkBG
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00400000&
DragIcon = "DOCKING2.frx":13120
ForeColor = &H80000008&
Height = 4860
Left = 2895
ScaleHeight = 322
ScaleMode = 3 'Pixel
ScaleWidth = 635
TabIndex = 5
Top = 7365
Width = 9555
End
Begin VB.PictureBox picBGoriginal
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 9015
Left = -7320
Picture = "DOCKING2.frx":1342A
ScaleHeight = 599
ScaleMode = 3 'Pixel
ScaleWidth = 799
TabIndex = 4
Top = 7215
Width = 12015
End
Begin VB.PictureBox picPitMask
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 9795
Picture = "DOCKING2.frx":88B6E
ScaleHeight = 5205
ScaleWidth = 9600
TabIndex = 3
Top = 6540
Width = 9600
End
Begin VB.PictureBox picPitSprite
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 5205
Left = 9765
Picture = "DOCKING2.frx":BEF3A
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 2
Top = 270
Width = 9600
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 55
Left = 9960
Top = 5865
End
Begin VB.PictureBox Picture4
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 7200
Left = 0
Picture = "DOCKING2.frx":F5396
ScaleHeight = 7200
ScaleWidth = 9600
TabIndex = 0
Top = 0
Width = 9600
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 0
Left = 4110
Picture = "DOCKING2.frx":1407DA
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 11
Top = 5520
Width = 1755
Begin Threed.SSCommand SSCommand1
Height = 330
Index = 1
Left = 1185
TabIndex = 15
Top = 1080
Width = 555
_version = 65536
_extentx = 979
_extenty = 582
_stockprops = 78
caption = "REV"
bevelwidth = 4
font3d = 4
End
Begin Threed.SSCommand SSCommand1
Height = 330
Index = 0
Left = 0
TabIndex = 14
Top = 1065
Width = 555
_version = 65536
_extentx = 979
_extenty = 582
_stockprops = 78
caption = "FWD"
bevelwidth = 4
font3d = 4
End
Begin VB.Image auxjoy
Height = 300
Index = 0
Left = 720
Picture = "DOCKING2.frx":1435A6
Top = 255
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 1
Left = 1035
Picture = "DOCKING2.frx":143706
Top = 570
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 2
Left = 720
Picture = "DOCKING2.frx":143902
Top = 885
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 3
Left = 405
Picture = "DOCKING2.frx":143AFE
Top = 570
Width = 300
End
End
Begin VB.PictureBox picBackground
Appearance = 0 'Flat
BackColor = &H00000000&
BorderStyle = 0 'None
DragIcon = "DOCKING2.frx":143CFA
ForeColor = &H80000008&
Height = 5205
Left = 0
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 1
Top = 120
Width = 9600
End
Begin VB.Label distance
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1410
TabIndex = 17
Top = 6420
Width = 600
End
Begin VB.Label closerate
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1395
TabIndex = 16
Top = 5805
Width = 600
End
Begin Threed.SSCommand Leave
Height = 360
Left = 6090
TabIndex = 13
Top = 6630
Width = 3105
_version = 65536
_extentx = 5477
_extenty = 635
_stockprops = 78
caption = "EXIT"
BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713}
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
font3d = 4
End
Begin Threed.SSCommand start
Height = 360
Left = 6105
TabIndex = 12
Top = 6225
Width = 3105
_version = 65536
_extentx = 5477
_extenty = 635
_stockprops = 78
caption = "START"
BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713}
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
font3d = 4
End
End
End
Attribute VB_Name = "docking"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim ScrollSpeed As Integer ' The ship's current turning speed
' Constants for mouse action.
Const NO_BUTTON = 0
Const LBUTTON = 1
Const RBUTTON = 2
' Constants for WaveMix channels
Const BACKGROUND = 0
Const MISSION_CONTROL = 1
Const BUTTONS = 2
Const EFFECTS = 3
Const WARNINGS = 4
Const MCSECOND = 5
Const LUPE = 1
Const NO_LUPE = 0
' Boolean that indicates if mouse button has been pressed down.
Dim MouseButtonDown As Integer
' Windows API calls
Private Declare Function GetPixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
Private Declare Function setpixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
Private Declare Function ellipse Lib "GDI" (ByVal hDC As Integer, ByVal nLeft As Integer, ByVal nTop As Integer, ByVal nRight As Integer, ByVal nBottom As Integer) As Long
Private Declare Function LineTo Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Integer
Private Declare Function Polyline Lib "GDI" (ByVal hDC As Integer, lpPoints As POINTAPI, ByVal nCount As Integer) As Integer
Private Declare Function MoveTo Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
'-----------------------------------------------------
' BITDEMO1.FRM
' This program demonstrates some of the methods used
' to display bitmaps and sprites.
'-----------------------------------------------------
' The number of pixels to offset the sprite
' each time it is moved.
Const INCREMENT = 1
' Constants for Raster Operations used by BitBlt function.
Const SRCAND = &H8800C6 ' dest = source AND dest
Const SRCCOPY = &HCC0020 ' dest = source
Const SRCPAINT = &HEE0086 ' dest = source OR dest
' The BitBlt Windows API call.
Private Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
'Dim Ship(1 To 4) As tShip
' The x and y coordinates for the Sprite
Dim SpriteX As Integer
Dim SpriteY As Integer
' The x and y coordinates for the upper left corner
' of the large bitmap (picBMP).
Dim BackgroundX As Integer
Dim BackgroundY As Integer
' The width and height of the work area bitmap (picWork).
Dim WorkWidth As Integer
Dim WorkHeight As Integer
Dim ldist As Integer
Dim zcomponent As Integer
Dim s4b(51) As String
Dim s4bmask(51) As String
Public Function playSound(sname As String, chan As Integer, lp As Integer)
Select Case lp
' don't loop
Case 0
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (False)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' loop
Case 1
Channel(chan).WaveFile = LCase$(sname)
Channel(chan).Loops = (True)
WAVMIX_SetFile Channel(chan).WaveFile, chan
WAVMIX_PlayChannel chan, Channel(chan).Loops
' stop loop
Case 2
WAVMIX_StopChannel chan
End Select
End Function
Private Sub auxjoy_Click(Index As Integer)
Dim X As Integer
auxjoy(0).Visible = False
auxjoy(1).Visible = False
auxjoy(2).Visible = False
auxjoy(3).Visible = False
Select Case Index
Case Is = 0
Yland = Yland - 1
auxcon(0).Picture = auxcon(1).Picture
Case Is = 1
Xland = Xland + 1
auxcon(0).Picture = auxcon(2).Picture
Case Is = 2
Yland = Yland + 1
auxcon(0).Picture = auxcon(3).Picture
Case Is = 3
Xland = Xland - 1
auxcon(0).Picture = auxcon(4).Picture
End Select
X = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
'x = playSound("rcstrst.wav", 3, 0)
End Sub
Private Sub btnStart_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Dim rc As Long
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
StartGame
End If
End Sub
Private Sub cmdExit_Click()
' Shut down the WaveMix .DLL.
WAVMIX_Close
Unload Me
End Sub
Private Sub FOREREV_Click(Index As Integer)
Dim X As Integer
Select Case Index
Case Is = 0
Case Is = 1
End Select
X = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub Form_Load()
'------------------------------------------------------------
' Set up the form when its first loaded.
'------------------------------------------------------------
' Hide the scope and background PictureBoxes.
picBackground.Visible = False
'picScope.Visible = False
' Copy the cockpit "sprite" image into the background PictureBox.
picBackground.Picture = picPitSprite.Picture
' Center the form on the screen.
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
MouseButtonDown = NO_BUTTON
Rem --- %%% Initialize WaveMix DLL %%% ---
If Not WAVMIX_InitMixer() Then
MsgBox "Unable to Initialize WaveMix DLL"
End
End If
Xland = 0
Yland = 0
ldist = 520
s4b(1) = "D:\docking\dock\dock1.bmp"
s4b(2) = "D:\docking\dock\dock2.bmp"
s4b(3) = "D:\docking\dock\dock3.bmp"
s4b(4) = "D:\docking\dock\dock4.bmp"
s4b(5) = "D:\docking\dock\dock5.bmp"
s4b(6) = "D:\docking\dock\dock6.bmp"
s4b(7) = "D:\docking\dock\dock7.bmp"
s4b(8) = "D:\docking\dock\dock8.bmp"
s4b(9) = "D:\docking\dock\dock9.bmp"
s4b(10) = "D:\docking\dock\dock10.bmp"
s4b(11) = "D:\docking\dock\dock11.bmp"
s4b(12) = "D:\docking\dock\dock12.bmp"
s4b(13) = "D:\docking\dock\dock13.bmp"
s4b(14) = "D:\docking\dock\dock14.bmp"
s4b(15) = "D:\docking\dock\dock15.bmp"
s4b(16) = "D:\docking\dock\dock16.bmp"
s4b(17) = "D:\docking\dock\dock17.bmp"
s4b(18) = "D:\docking\dock\dock18.bmp"
s4b(19) = "D:\docking\dock\dock19.bmp"
s4b(20) = "D:\docking\dock\dock20.bmp"
s4b(21) = "D:\docking\dock\dock21.bmp"
s4b(22) = "D:\docking\dock\dock22.bmp"
s4b(23) = "D:\docking\dock\dock23.bmp"
s4b(24) = "D:\docking\dock\dock24.bmp"
s4b(25) = "D:\docking\dock\dock25.bmp"
s4b(26) = "D:\docking\dock\dock26.bmp"
s4b(27) = "D:\docking\dock\dock27.bmp"
s4b(28) = "D:\docking\dock\dock28.bmp"
s4b(29) = "D:\docking\dock\dock29.bmp"
s4b(30) = "D:\docking\dock\dock30.bmp"
s4b(31) = "D:\docking\dock\dock31.bmp"
s4b(32) = "D:\docking\dock\dock32.bmp"
s4b(33) = "D:\docking\dock\dock33.bmp"
s4b(34) = "D:\docking\dock\dock34.bmp"
s4b(35) = "D:\docking\dock\dock35.bmp"
s4b(36) = "D:\docking\dock\dock36.bmp"
s4b(37) = "D:\docking\dock\dock37.bmp"
s4b(38) = "D:\docking\dock\dock38.bmp"
s4b(39) = "D:\docking\dock\dock39.bmp"
s4b(40) = "D:\docking\dock\dock40.bmp"
s4b(41) = "D:\docking\dock\dock41.bmp"
s4b(42) = "D:\docking\dock\dock42.bmp"
s4b(43) = "D:\docking\dock\dock43.bmp"
s4b(44) = "D:\docking\dock\dock44.bmp"
s4b(45) = "D:\docking\dock\dock45.bmp"
s4b(46) = "D:\docking\dock\dock46.bmp"
s4b(47) = "D:\docking\dock\dock47.bmp"
s4b(48) = "D:\docking\dock\dock48.bmp"
s4b(49) = "D:\docking\dock\dock49.bmp"
s4b(50) = "D:\docking\dock\dock50.bmp"
'************************************
Rem ************* masks *************
'************************************
s4bmask(1) = "D:\docking\mask\m1.bmp"
s4bmask(2) = "D:\docking\mask\m2.bmp"
s4bmask(3) = "D:\docking\mask\m3.bmp"
s4bmask(4) = "D:\docking\mask\m4.bmp"
s4bmask(5) = "D:\docking\mask\m5.bmp"
s4bmask(6) = "D:\docking\mask\m6.bmp"
s4bmask(7) = "D:\docking\mask\m7.bmp"
s4bmask(8) = "D:\docking\mask\m8.bmp"
s4bmask(9) = "D:\docking\mask\m9.bmp"
s4bmask(10) = "D:\docking\mask\m10.bmp"
s4bmask(11) = "D:\docking\mask\m11.bmp"
s4bmask(12) = "D:\docking\mask\m12.bmp"
s4bmask(13) = "D:\docking\mask\m13.bmp"
s4bmask(14) = "D:\docking\mask\m14.bmp"
s4bmask(15) = "D:\docking\mask\m15.bmp"
s4bmask(16) = "D:\docking\mask\m16.bmp"
s4bmask(17) = "D:\docking\mask\m17.bmp"
s4bmask(18) = "D:\docking\mask\m18.bmp"
s4bmask(19) = "D:\docking\mask\m19.bmp"
s4bmask(20) = "D:\docking\mask\m20.bmp"
s4bmask(21) = "D:\docking\mask\m21.bmp"
s4bmask(22) = "D:\docking\mask\m22.bmp"
s4bmask(23) = "D:\docking\mask\m23.bmp"
s4bmask(24) = "D:\docking\mask\m24.bmp"
s4bmask(25) = "D:\docking\mask\m25.bmp"
s4bmask(26) = "D:\docking\mask\m26.bmp"
s4bmask(27) = "D:\docking\mask\m27.bmp"
s4bmask(28) = "D:\docking\mask\m28.bmp"
s4bmask(29) = "D:\docking\mask\m29.bmp"
s4bmask(30) = "D:\docking\mask\m30.bmp"
s4bmask(31) = "D:\docking\mask\m31.bmp"
s4bmask(32) = "D:\docking\mask\m32.bmp"
s4bmask(33) = "D:\docking\mask\m33.bmp"
s4bmask(34) = "D:\docking\mask\m34.bmp"
s4bmask(35) = "D:\docking\mask\m35.bmp"
s4bmask(36) = "D:\docking\mask\m36.bmp"
s4bmask(37) = "D:\docking\mask\m37.bmp"
s4bmask(38) = "D:\docking\mask\m38.bmp"
s4bmask(39) = "D:\docking\mask\m39.bmp"
s4bmask(40) = "D:\docking\mask\m40.bmp"
s4bmask(41) = "D:\docking\mask\m41.bmp"
s4bmask(42) = "D:\docking\mask\m42.bmp"
s4bmask(43) = "D:\docking\mask\m43.bmp"
s4bmask(44) = "D:\docking\mask\m44.bmp"
s4bmask(45) = "D:\docking\mask\m45.bmp"
s4bmask(46) = "D:\docking\mask\m46.bmp"
s4bmask(47) = "D:\docking\mask\m47.bmp"
s4bmask(48) = "D:\docking\mask\m48.bmp"
s4bmask(49) = "D:\docking\mask\m49.bmp"
s4bmask(50) = "D:\docking\mask\m50.bmp"
End Sub
Private Sub Form_Unload(Cancel As Integer)
WAVMIX_Close
Unload Me
End Sub
Private Sub Leave_Click()
' Shut down the WaveMix .DLL.
WAVMIX_Close
Unload Me
End
End Sub
Private Sub SSCommand1_Click(Index As Integer)
Dim X As Integer
Select Case Index
Case Is = 0
zcomponent = zcomponent - 1
Case Is = 1
zcomponent = zcomponent + 1
End Select
X = playSound("rcstrst.wav", EFFECTS, NO_LUPE)
End Sub
Private Sub Start_Click()
'------------------------------------------------------------
' Pressing the Start button will either start, pause, or
' resume the game.
'------------------------------------------------------------
Static Paused As Integer
Dim rc As Long
Static NotFirstTime As Integer
' Me.Show
' Sprites only need to be initialized the first time
' the game is played.
' If Not NotFirstTime Then
' SpriteInit Ship(1).Sprite, Me, picImage, picmask , picWorkBG, 50
' Ship(1).Visible = 1
' Ship(1).MaxHits = 3
' NotFirstTime = True
' End If
' If the game is curently paused, then resume it.
If Paused Then
Paused = False
'btnStart.Caption = "&PAUSE"
'rc = WaveMixActivate(hWaveMix, True)
Timer1.Enabled = True
'If the game is in progress then pause it.
ElseIf Timer1.Enabled Then
' Paused = True
' btnStart.Caption = "&RESUME"
'rc = WaveMixActivate(hWaveMix, False)
Timer1.Enabled = False
'Otherwise, no game is in progress, so start one.
Else
'btnStart.Caption = "&PAUSE"
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
StartGame
End If
End Sub
Private Sub Text1_Change()
End Sub
Private Sub Timer1_Timer()
'------------------------------------------------------------
' This routine is the heart of this game. It's a trifle
' monolithic, but that is in large part by design. By
' reducing the number of subroutines called from here, we
' can improve the game performance somewhat.
'
' Each pass through this routine, the game display is
' updated.
'------------------------------------------------------------
Static xpos, ypos As Integer
Dim tempd As Integer
Dim rc As Long
'lblZ = ldist
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
'calculate distance from s4sb
ldist = ldist + zcomponent
If ldist <= 4000 And ldist > 2500 Then tempd = 1
If ldist <= 2500 And ldist > 1700 Then tempd = 2
If ldist <= 1700 And ldist > 1200 Then tempd = 3
If ldist <= 1200 And ldist > 900 Then tempd = 4
If ldist <= 900 And ldist > 800 Then tempd = 5
If ldist <= 800 And ldist > 700 Then tempd = 6
If ldist <= 700 And ldist > 640 Then tempd = 7
If ldist <= 640 And ldist > 590 Then tempd = 8
If ldist <= 590 And ldist > 550 Then tempd = 9
If ldist <= 550 And ldist > 510 Then tempd = 10
If ldist <= 510 And ldist > 470 Then tempd = 12
If ldist <= 470 And ldist > 430 Then tempd = 13
If ldist <= 430 And ldist > 400 Then tempd = 14
If ldist <= 400 And ldist > 370 Then tempd = 15
If ldist <= 370 And ldist > 340 Then tempd = 16
If ldist <= 340 And ldist > 310 Then tempd = 17
If ldist <= 310 And ldist > 290 Then tempd = 18
If ldist <= 290 And ldist > 270 Then tempd = 19
If ldist <= 270 And ldist > 250 Then tempd = 20
If ldist <= 250 And ldist > 230 Then tempd = 21
If ldist <= 230 And ldist > 210 Then tempd = 22
If ldist <= 210 And ldist > 195 Then tempd = 23
If ldist <= 195 And ldist > 180 Then tempd = 24
If ldist <= 180 And ldist > 165 Then tempd = 25
If ldist <= 165 And ldist > 150 Then tempd = 26
If ldist <= 150 And ldist > 140 Then tempd = 27
If ldist <= 140 And ldist > 130 Then tempd = 28
If ldist <= 130 And ldist > 120 Then tempd = 29
If ldist <= 120 And ldist > 110 Then tempd = 30
If ldist <= 110 And ldist > 100 Then tempd = 31
If ldist <= 100 And ldist > 90 Then tempd = 32
If ldist <= 90 And ldist > 80 Then tempd = 33
If ldist <= 80 And ldist > 70 Then tempd = 34
If ldist <= 70 And ldist > 60 Then tempd = 35
If ldist <= 60 And ldist > 55 Then tempd = 36
If ldist <= 55 And ldist > 50 Then tempd = 37
If ldist <= 50 And ldist > 45 Then tempd = 38
If ldist <= 45 And ldist > 40 Then tempd = 39
If ldist <= 40 And ldist > 35 Then tempd = 40
If ldist <= 35 And ldist > 30 Then tempd = 41
If ldist <= 30 And ldist > 25 Then tempd = 42
If ldist <= 25 And ldist > 17 Then tempd = 43
If ldist <= 17 And ldist > 15 Then tempd = 44
If ldist <= 15 And ldist > 13 Then tempd = 45
If ldist <= 13 And ldist > 10 Then tempd = 46
If ldist <= 10 And ldist > 7 Then tempd = 47
If ldist <= 7 And ldist > 6 Then tempd = 48
If ldist <= 6 And ldist > 5 Then tempd = 49
If ldist <= 5 And ldist > 0 Then tempd = 50
Select Case tempd
Case Is = 1
picImage = LoadPicture(s4b(1))
picMask = LoadPicture(s4bmask(1))
Case Is = 2
picImage = LoadPicture(s4b(2))
picMask = LoadPicture(s4bmask(2))
Case Is = 3
picImage = LoadPicture(s4b(3))
picMask = LoadPicture(s4bmask(3))
Case Is = 4
picImage = LoadPicture(s4b(4))
picMask = LoadPicture(s4bmask(4))
Case Is = 5
picImage = LoadPicture(s4b(5))
picMask = LoadPicture(s4bmask(5))
Case Is = 6
picImage = LoadPicture(s4b(6))
picMask = LoadPicture(s4bmask(6))
Case Is = 7
picImage = LoadPicture(s4b(7))
picMask = LoadPicture(s4bmask(7))
Case Is = 8
picImage = LoadPicture(s4b(8))
picMask = LoadPicture(s4bmask(8))
Case Is = 9
picImage = LoadPicture(s4b(9))
picMask = LoadPicture(s4bmask(9))
Case Is = 10
picImage = LoadPicture(s4b(10))
picMask = LoadPicture(s4bmask(10))
Case Is = 11
picImage = LoadPicture(s4b(11))
picMask = LoadPicture(s4bmask(11))
Case Is = 12
picImage = LoadPicture(s4b(12))
picMask = LoadPicture(s4bmask(12))
Case Is = 13
picImage = LoadPicture(s4b(13))
picMask = LoadPicture(s4bmask(13))
Case Is = 14
picImage = LoadPicture(s4b(14))
picMask = LoadPicture(s4bmask(14))
Case Is = 15
picImage = LoadPicture(s4b(15))
picMask = LoadPicture(s4bmask(15))
Case Is = 16
picImage = LoadPicture(s4b(16))
picMask = LoadPicture(s4bmask(16))
Case Is = 17
picImage = LoadPicture(s4b(17))
picMask = LoadPicture(s4bmask(17))
Case Is = 18
picImage = LoadPicture(s4b(18))
picMask = LoadPicture(s4bmask(18))
Case Is = 19
picImage = LoadPicture(s4b(19))
picMask = LoadPicture(s4bmask(19))
Case Is = 20
picImage = LoadPicture(s4b(20))
picMask = LoadPicture(s4bmask(20))
Case Is = 21
picImage = LoadPicture(s4b(21))
picMask = LoadPicture(s4bmask(21))
Case Is = 22
picImage = LoadPicture(s4b(22))
picMask = LoadPicture(s4bmask(22))
Case Is = 23
picImage = LoadPicture(s4b(23))
picMask = LoadPicture(s4bmask(23))
Case Is = 24
picImage = LoadPicture(s4b(24))
picMask = LoadPicture(s4bmask(24))
Case Is = 25
picImage = LoadPicture(s4b(25))
picMask = LoadPicture(s4bmask(25))
Case Is = 26
picImage = LoadPicture(s4b(26))
picMask = LoadPicture(s4bmask(26))
Case Is = 27
picImage = LoadPicture(s4b(27))
picMask = LoadPicture(s4bmask(27))
Case Is = 28
picImage = LoadPicture(s4b(28))
picMask = LoadPicture(s4bmask(28))
Case Is = 29
picImage = LoadPicture(s4b(29))
picMask = LoadPicture(s4bmask(29))
Case Is = 30
'picImage = LoadPicture(s4b(30))
'picMask = LoadPicture(s4bmask(30))
Case Is = 31
picImage = LoadPicture(s4b(31))
picMask = LoadPicture(s4bmask(31))
Case Is = 32
picImage = LoadPicture(s4b(32))
picMask = LoadPicture(s4bmask(32))
Case Is = 33
picImage = LoadPicture(s4b(33))
picMask = LoadPicture(s4bmask(33))
Case Is = 34
picImage = LoadPicture(s4b(34))
picMask = LoadPicture(s4bmask(34))
Case Is = 35
picImage = LoadPicture(s4b(35))
picMask = LoadPicture(s4bmask(35))
Case Is = 36
picImage = LoadPicture(s4b(36))
picMask = LoadPicture(s4bmask(36))
Case Is = 37
picImage = LoadPicture(s4b(37))
picMask = LoadPicture(s4bmask(37))
Case Is = 38
picImage = LoadPicture(s4b(38))
picMask = LoadPicture(s4bmask(38))
Case Is = 39
picImage = LoadPicture(s4b(39))
picMask = LoadPicture(s4bmask(39))
Case Is = 40
picImage = LoadPicture(s4b(40))
picMask = LoadPicture(s4bmask(40))
Case Is = 41
picImage = LoadPicture(s4b(41))
picMask = LoadPicture(s4bmask(41))
Case Is = 42
picImage = LoadPicture(s4b(42))
picMask = LoadPicture(s4bmask(42))
Case Is = 43
picImage = LoadPicture(s4b(43))
picMask = LoadPicture(s4bmask(43))
Case Is = 44
picImage = LoadPicture(s4b(44))
picMask = LoadPicture(s4bmask(44))
Case Is = 45
picImage = LoadPicture(s4b(45))
picMask = LoadPicture(s4bmask(45))
Case Is = 46
picImage = LoadPicture(s4b(46))
picMask = LoadPicture(s4bmask(46))
Case Is = 47
picImage = LoadPicture(s4b(47))
picMask = LoadPicture(s4bmask(47))
Case Is = 48
picImage = LoadPicture(s4b(48))
picMask = LoadPicture(s4bmask(48))
Case Is = 49
picImage = LoadPicture(s4b(49))
picMask = LoadPicture(s4bmask(49))
Case Is = 50
picImage = LoadPicture(s4b(50))
picMask = LoadPicture(s4bmask(50))
End Select
Rem ********************************************************************************
xpos = xpos - Xland
closerate.Caption = xpos
ypos = ypos - Yland
distance.Caption = ldist
' Update the background (starfield) based on the
' current speed and direction of the player's ship.
UpdateBackground
' Copy a section of the large bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, 0, 0, SRCCOPY)
' Copy the sprite work area onto the background.
'rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picWorkBG.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' Draw the sprite mask bitmap into the work area.
rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
'draw sprite into the work area
rc = BitBlt(picWorkBG.hDC, xpos + 80, ypos + 80, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Draw the cockpit mask into the work area.
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitMask.hDC, 0, 0, SRCAND)
'draw cockpit
rc = BitBlt(picWorkBG.hDC, 0, 0, picPitMask.Width, picPitMask.Height, picPitSprite.hDC, 0, 0, SRCPAINT)
'FlickerlessSpriteMove
' Draw the whole thing back onto the screen.
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.Width, picBackground.Height, picWorkBG.hDC, 0, 0, SRCCOPY)
auxjoy(0).Visible = True
auxjoy(1).Visible = True
auxjoy(2).Visible = True
auxjoy(3).Visible = True
auxcon(0).Picture = auxcon(5).Picture
End Sub
Public Sub EndGame()
'------------------------------------------------------------
' Close everything down.
'------------------------------------------------------------
Dim rc As Long
' Shut down the WaveMix .DLL.
WAVMIX_Close
' Turn off the timer.
Timer1.Enabled = False
' Ready to start again?
btnStart.Caption = "&START"
Me.Refresh
' Wait a couple of seconds
Pause 5
picBackground.Visible = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'----------------------------------------------------------
' Set the module-level MouseButtonDown variable, so that
' the Mouse Control timer knows a button was pushed.
'----------------------------------------------------------
MouseButtonDown = Button
End Sub
Private Sub Pause(Seconds As Single)
'------------------------------------------------------------
' Delay for a specified number of seconds.
'------------------------------------------------------------
Dim Start As Single
Start = Timer
Do While (Timer - Start) < Seconds
DoEvents
Loop
End Sub
Private Sub StartGame()
'------------------------------------------------------------
' Initialize everything and start the game.
'------------------------------------------------------------
Dim rc As Integer
Dim i As Integer
Static NotFirstTime As Integer
Me.Show
picBackground.Visible = True
ScrollSpeed = 5
Timer1.Enabled = True
End Sub
Private Sub UpdateBackground()
'------------------------------------------------------------
' The first step in building a new view is to copy the
' next section of the original background onto the working
' background picture box.
'------------------------------------------------------------
'Static LastXdir As Integer
'Static LastYdir As Integer
' BGMove picWorkBG, picBGOriginal, LastXdir * 2, LastYdir * 2
BGMove picWorkBG, picBGOriginal, Xland, Yland
' End If
End Sub
Private Sub FlickerlessSpriteMove()
'-----------------------------------------------------
' Moving a sprite without flicker requires the use
' of an off-screen work area into which we copy a
' section of the background and sprite.
'-----------------------------------------------------
Dim rc As Integer
WorkWidth = 2090
WorkHeight = 2020
BackgroundX = SpriteX
BackgroundY = SpriteY
' Calculate the next position for the sprite, and any
' necessary direction changes.
GetNextPos picImage.ScaleWidth, picImage.ScaleHeight
' Copy a section of the large bitmap into the work area.
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY)
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBackground.hDC, (SpriteX), (SpriteY), SRCCOPY)
rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBGOriginal.hDC, (SpriteX), (SpriteY), SRCCOPY)
' Draw the mask and sprite bitmaps into the work area.
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND)
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
'rc = BitBlt(picWork.hDC, 0, 0, picmask.ScaleWidth, picmask.ScaleHeight, picmask.hDC, 0, 0, SRCAND)
'rc = BitBlt(picWork.hDC, 0, 0, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT)
' Copy the work area onto the background.
' rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
' rc = BitBlt(picBackground.hDC, 10, 10, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
rc = BitBlt(picBackground.hDC, 0, 0, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
DoEvents
End Sub
Private Sub GetNextPos(ByVal AWidth As Integer, ByVal AHeight As Integer)
'-----------------------------------------------------
' Calculate the next position for the sprite, and
' make any necessary direction changes.
'-----------------------------------------------------
xdir = Xland
ydir = Yland
' Calculate the new position for the sprite.
SpriteX = SpriteX + (xdir)
SpriteY = SpriteY + (ydir)
End Sub
DOCKING2.LOG
Line 239: Class Threed.SSCommand of control SSCommand1 was not a loaded control class. Line 254: Class Threed.SSCommand of control SSCommand1 was not a loaded control class. Line 357: Class Threed.SSCommand of control Leave was not a loaded control class. Line 379: Class Threed.SSCommand of control start was not a loaded control class. Line 246: The property name _version in SSCommand1 is invalid. Line 247: The property name _extentx in SSCommand1 is invalid. Line 248: The property name _extenty in SSCommand1 is invalid. Line 249: The property name _stockprops in SSCommand1 is invalid. Line 250: The property name caption in SSCommand1 is invalid. Line 251: The property name bevelwidth in SSCommand1 is invalid. Line 252: The property name font3d in SSCommand1 is invalid. Line 261: The property name _version in SSCommand1 is invalid. Line 262: The property name _extentx in SSCommand1 is invalid. Line 263: The property name _extenty in SSCommand1 is invalid. Line 264: The property name _stockprops in SSCommand1 is invalid. Line 265: The property name caption in SSCommand1 is invalid. Line 266: The property name bevelwidth in SSCommand1 is invalid. Line 267: The property name font3d in SSCommand1 is invalid. Line 363: The property name _version in Leave is invalid. Line 364: The property name _extentx in Leave is invalid. Line 365: The property name _extenty in Leave is invalid. Line 366: The property name _stockprops in Leave is invalid. Line 367: The property name caption in Leave is invalid. Line 377: The property name font3d in Leave is invalid. Line 385: The property name _version in start is invalid. Line 386: The property name _extentx in start is invalid. Line 387: The property name _extenty in start is invalid. Line 388: The property name _stockprops in start is invalid. Line 389: The property name caption in start is invalid. Line 399: The property name font3d in start is invalid.
LANDING.FRM
VERSION 4.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 6030
ClientLeft = 1095
ClientTop = 1515
ClientWidth = 6720
Height = 6435
Left = 1035
LinkTopic = "Form1"
ScaleHeight = 8715
ScaleWidth = 12000
Top = 1170
Width = 6840
Begin VB.PictureBox Picture4
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 7200
Left = 0
Picture = "LANDING.frx":0000
ScaleHeight = 7200
ScaleWidth = 9600
TabIndex = 0
Top = 0
Width = 9600
Begin VB.PictureBox start
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 360
Left = 6105
ScaleHeight = 330
ScaleWidth = 3075
TabIndex = 6
Top = 6225
Width = 3105
End
Begin VB.PictureBox Leave
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 360
Left = 6090
ScaleHeight = 330
ScaleWidth = 3075
TabIndex = 5
Top = 6630
Width = 3105
End
Begin VB.PictureBox picBackground
Appearance = 0 'Flat
BackColor = &H00000000&
BorderStyle = 0 'None
DragIcon = "LANDING.frx":4B444
ForeColor = &H80000008&
Height = 5205
Left = 570
ScaleHeight = 347
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 4
Top = 855
Width = 9600
End
Begin VB.PictureBox auxcon
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1440
Index = 0
Left = 4170
Picture = "LANDING.frx":4B74E
ScaleHeight = 96
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 1
Top = 5475
Width = 1755
Begin VB.PictureBox SSCommand1
Height = 330
Index = 0
Left = 0
ScaleHeight = 300
ScaleWidth = 525
TabIndex = 3
Top = 1065
Width = 555
End
Begin VB.PictureBox SSCommand1
Height = 330
Index = 1
Left = 1185
ScaleHeight = 300
ScaleWidth = 525
TabIndex = 2
Top = 1080
Width = 555
End
Begin VB.Image auxjoy
Height = 300
Index = 3
Left = 405
Picture = "LANDING.frx":4E51A
Top = 570
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 2
Left = 720
Picture = "LANDING.frx":4E716
Top = 885
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 1
Left = 1035
Picture = "LANDING.frx":4E912
Top = 570
Width = 300
End
Begin VB.Image auxjoy
Height = 300
Index = 0
Left = 720
Picture = "LANDING.frx":4EB0E
Top = 255
Width = 300
End
End
Begin VB.Label closerate
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1395
TabIndex = 8
Top = 5805
Width = 600
End
Begin VB.Label distance
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1000"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 360
Left = 1410
TabIndex = 7
Top = 6420
Width = 600
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
\PCX
LANDING.FRM
VERSION 4.00
Begin VB.Form Form1
Caption = "landing trial"
ClientHeight = 5355
ClientLeft = 1095
ClientTop = 1530
ClientWidth = 4965
Height = 5760
Left = 1035
LinkTopic = "Form1"
ScaleHeight = 5355
ScaleWidth = 4965
Top = 1185
Width = 5085
Begin VB.CheckBox chkFlickerless
Caption = "flickerless"
Height = 510
Left = 2235
TabIndex = 10
Top = 60
Width = 1080
End
Begin VB.HScrollBar HScroll1
Height = 270
LargeChange = 12
Left = 795
TabIndex = 9
Top = 4965
Width = 480
End
Begin VB.VScrollBar VScroll1
Height = 640
LargeChange = 12
Left = 4560
TabIndex = 8
Top = 810
Width = 285
End
Begin VB.PictureBox picBackground
BackColor = &H00FFFFFF&
Height = 4110
Left = 630
ScaleHeight = 272
ScaleMode = 3 'Pixel
ScaleWidth = 245
TabIndex = 7
Top = 675
Width = 3705
End
Begin VB.PictureBox picWork
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 360
Left = 210
ScaleHeight = 24
ScaleMode = 3 'Pixel
ScaleWidth = 21
TabIndex = 6
Top = 2355
Width = 315
End
Begin VB.PictureBox picSave
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 345
Left = 210
ScaleHeight = 23
ScaleMode = 3 'Pixel
ScaleWidth = 22
TabIndex = 5
Top = 1785
Width = 330
End
Begin VB.Timer Timer2
Interval = 55
Left = 5145
Top = 90
End
Begin VB.Timer Timer1
Interval = 55
Left = 4605
Top = 90
End
Begin VB.PictureBox crosshairMask
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 285
Left = 210
Picture = "LANDING.frx":0000
ScaleHeight = 19
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 4
Top = 1320
Width = 285
End
Begin VB.PictureBox crosshair
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 285
Left = 240
Picture = "LANDING.frx":01C8
ScaleHeight = 19
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 3
Top = 855
Width = 285
End
Begin VB.CommandButton btnGo
Caption = "Move Sprite"
Height = 435
Left = 315
TabIndex = 2
Top = 135
Width = 1215
End
Begin VB.PictureBox landsite
AutoRedraw = -1 'True
AutoSize = -1 'True
ForeColor = &H0000FFFF&
Height = 7230
Left = 5775
Picture = "LANDING.frx":0394
ScaleHeight = 7200
ScaleWidth = 9600
TabIndex = 1
Top = 1035
Width = 9630
End
Begin VB.PictureBox landcompare
Height = 495
Left = 330
Picture = "LANDING.frx":4B7D4
ScaleHeight = 465
ScaleWidth = 1185
TabIndex = 0
Top = 6255
Width = 1215
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Primary Target"
ForeColor = &H0000FFFF&
Height = 255
Left = 3210
TabIndex = 12
Top = 4905
Width = 1080
End
Begin VB.Label AltReadOut
BackStyle = 0 'Transparent
Caption = "10000"
ForeColor = &H0000FFFF&
Height = 255
Left = 2160
TabIndex = 11
Top = 4950
Width = 600
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
'--------------------------------------------
' PROJLAND.FRM
' This program is test for graphics to be used in
' landing routines.
' displaying bitmaps and sprites.
' -------------------------------------------
' The number of pixels to offset the sprite
' each time it is moved.
Const INCREMENT = 3
' Constants for Raster Operations used by BitBlt function.
Const SRCAND = &H8800C6 ' dest = source AND dest
Const SRCCOPY = &HCC0020 ' dest = source
Const SRCPAINT = &HEE0086 ' dest = source OR dest
' The BitBlt Windows API call.
Private Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
' The x and y coordinates for the Sprite
Dim SpriteX As Integer
Dim SpriteY As Integer
' The x and y coordinates for the upper left corner
' of the large bitmap (landSite).
Dim BackgroundX As Integer
Dim BackgroundY As Integer
' The width and height of the work area bitmap (picWork).
Dim WorkWidth As Integer
Dim WorkHeight As Integer
Dim Hght As Integer
Private Sub btnGo_Click()
'-----------------------------------------------------
' Start the simple sprite demonstration when this
' button is pushed.
'-----------------------------------------------------
Dim rc As Integer
' We're running.
If Timer1.Enabled Then
Timer1.Enabled = False
' Restore BG
If chkFlickerless = 0 Then
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
Else
VScroll1_Change
End If
' We're stopped.
Else
' Save BG
If chkFlickerless = 0 Then rc = BitBlt(picSave.hDC, 0, 0, picSave.ScaleWidth, picSave.ScaleHeight, picBackground.hDC, SpriteX, SpriteY, SRCCOPY)
Timer1.Enabled = True
End If
End Sub
Private Sub Form_Load()
'-----------------------------------------------------
'
'-----------------------------------------------------
Dim rc As Integer
Me.Show
'chkAutoRedraw.Value = 1
' Set the limits of the scroll bars.
HScroll1.Max = landsite.ScaleWidth - picBackground.ScaleWidth
VScroll1.Max = landsite.ScaleHeight - picBackground.ScaleHeight
' Only enable the scrollers if landSite is larger than
' the picBackground bitmap.
If landsite.ScaleWidth <= picBackground.ScaleWidth Then HScroll1.Enabled = False
If landsite.ScaleHeight <= picBackground.ScaleHeight Then VScroll1.Enabled = False
' Save this initial section of the background. It may be
' needed for the flickering sprite demo.
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, landsite.hDC, HScroll1, VScroll1, SRCCOPY)
' Set the dimensions of the work bitmap.
WorkWidth = (crosshair.Width / 15) + (INCREMENT * 2)
WorkHeight = (crosshair.Height / 15) + (INCREMENT * 2)
picWork.Width = WorkWidth * 15
picWork.Height = WorkHeight * 15
Me.Refresh
Hght = 10000
End Sub
Public Sub AnimatedSpriteMove()
'-----------------------------------------------------
' Move the animated sprite to its next position.
'-----------------------------------------------------
Dim rc As Integer
Static SpriteNum As Integer
' Calculate the next position for the sprite, and any
' necessary direction changes.
'GetNextPos crosshairMask.ScaleWidth, crosshairMask.ScaleHeight
' Copy a section of the large bitmap into the work area.
'rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, landsite.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY)
' Draw the sprite mask into the work area.
'rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, crosshairMask.ScaleWidth, crosshairMask.ScaleHeight, crosshairMask.hDC, 0, 0, SRCAND)
' The picEarthSprites bitmap contains 8 "frames". Each frame
' is displayed in sequence to animate the object.
'rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, crosshairMask.ScaleWidth, crosshairMask.ScaleHeight, picEarthSprites.hDC, (SpriteNum \ 2) * 32, 0, SRCPAINT)
' Increment the Sprite Frame number.
'SpriteNum = (SpriteNum + 1) Mod 16
' Copy the work area onto the background.
'rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
'DoEvents
End Sub
Public Sub FlickerlessSpriteMove()
'-----------------------------------------------------
' Moving a sprite without flicker requires the use
' of an off-screen work area into which we copy a
' section of the background and sprite.
'-----------------------------------------------------
Dim rc As Integer
' Calculate the next position for the sprite, and any
' necessary direction changes.
GetNextPos crosshair.ScaleWidth, crosshair.ScaleHeight
' Copy a section of the large bitmap into the work area.
rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, landsite.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY)
' Draw the mask and sprite bitmaps into the work area.
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, crosshairMask.ScaleWidth, crosshairMask.ScaleHeight, crosshairMask.hDC, 0, 0, SRCAND)
rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, crosshair.ScaleWidth, crosshair.ScaleHeight, crosshair.hDC, 0, 0, SRCPAINT)
' Copy the work area onto the background.
rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY)
DoEvents
End Sub
Public Sub GetNextPos(ByVal AWidth As Integer, ByVal AHeight As Integer)
'-----------------------------------------------------
' Calculate the next position for the sprite, and
' make any necessary direction changes.
'-----------------------------------------------------
Static xdir As Integer
Static ydir As Integer
' If this is the first time into the routine,
' then initialize the x and y direction indicators.
If xdir = 0 Then
xdir = 1
ydir = 1
End If
' Calculate the new position for the sprite.
SpriteX = SpriteX + (INCREMENT * xdir)
SpriteY = SpriteY + (INCREMENT * ydir)
' Change direction of the sprite if it reaches the edge
' of the background bitmap.
If (SpriteX + AWidth) >= picBackground.ScaleWidth Then
xdir = -1
End If
If SpriteX <= 0 Then
xdir = 1
End If
If (SpriteY + AHeight) >= picBackground.ScaleHeight Then
ydir = -1
End If
If SpriteY <= 0 Then
ydir = 1
End If
End Sub
Public Sub SpriteMove()
'-----------------------------------------------------
' A simple method for displaying a sprite.
'-----------------------------------------------------
Dim rc As Integer
' Replace the background saved when sprite was
' last displayed.
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
' Calculate the next position for the sprite, and any
' necessary direction changes.
GetNextPos crosshair.ScaleWidth, crosshair.ScaleHeight
' Save the area of the background where the sprite is
' about to be drawn. This saved area will be used to
' "erase" the sprite before it is displayed at a new
' position.
rc = BitBlt(picSave.hDC, 0, 0, picSave.ScaleWidth, picSave.ScaleHeight, picBackground.hDC, SpriteX, SpriteY, SRCCOPY)
' Draw the sprite mask directly onto the background.
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, crosshairMask.ScaleWidth, crosshairMask.ScaleHeight, crosshairMask.hDC, 0, 0, SRCAND)
' Draw the sprite over top of the mask.
rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, crosshair.ScaleWidth, crosshair.ScaleHeight, crosshair.hDC, 0, 0, SRCPAINT)
DoEvents
End Sub
Private Sub HScroll1_Change()
'-----------------------------------------------------
' Move the background horizontally under scroller
' control.
'-----------------------------------------------------
Dim rc As Integer
BackgroundX = HScroll1
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, landsite.hDC, BackgroundX, BackgroundY, SRCCOPY)
End Sub
Private Sub Timer1_Timer()
'-----------------------------------------------------
' Depending on the value of the Flickerless check
' box, run one of the simple sprite move subroutines.
'-----------------------------------------------------
If chkFlickerless = 1 Then
FlickerlessSpriteMove
Else
SpriteMove
End If
Hght = Hght - 1
' AltReadOut.Left = BackgroundX
' AltReadOut.Top = BackgroundY
' AltReadOut.Caption = Height
End Sub
Private Sub Timer2_Timer()
'-----------------------------------------------------
' Move the animated sprite to its next position.
'-----------------------------------------------------
AnimatedSpriteMove
End Sub
Private Sub VScroll1_Change()
'-----------------------------------------------------
' Move the background vertically under scroller
' control.
'-----------------------------------------------------
Dim rc As Integer
BackgroundY = VScroll1
rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, landsite.hDC, BackgroundX, BackgroundY, SRCCOPY)
End Sub
LANDING.LOG
Line 2: The Form or MDIForm name Form1 is already in use; cannot load this form.
\LANDSITE
FTEST.FRM
VERSION 4.00
Begin VB.Form Form1
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
Caption = "Form1"
ClientHeight = 6030
ClientLeft = 1170
ClientTop = 1470
ClientWidth = 6720
ClipControls = 0 'False
DrawStyle = 6 'Inside Solid
FillStyle = 0 'Solid
ForeColor = &H0000FF00&
Height = 6435
Left = 1110
LinkTopic = "Form1"
ScaleHeight = 402
ScaleMode = 3 'Pixel
ScaleWidth = 448
Top = 1125
Width = 6840
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 3105
Left = 7095
Picture = "FTEST.frx":0000
ScaleHeight = 155.25
ScaleMode = 2 'Point
ScaleWidth = 81
TabIndex = 6
Top = 900
Width = 1620
End
Begin VB.PictureBox terrain
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 6030
Left = 9195
Picture = "FTEST.frx":5B98
ScaleHeight = 400
ScaleMode = 3 'Pixel
ScaleWidth = 150
TabIndex = 5
Top = 720
Width = 2280
End
Begin VB.PictureBox picWork
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00008000&
ForeColor = &H00000000&
Height = 3345
Left = 270
ScaleHeight = 221
ScaleMode = 3 'Pixel
ScaleWidth = 407
TabIndex = 4
Top = 315
Width = 6135
End
Begin VB.PictureBox vscreen
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00C0C0C0&
ClipControls = 0 'False
FillColor = &H0000FF00&
ForeColor = &H0000C000&
Height = 3345
Left = 285
ScaleHeight = 221
ScaleMode = 3 'Pixel
ScaleWidth = 407
TabIndex = 3
Top = 285
Width = 6135
End
Begin VB.CommandButton Command3
Caption = "&End"
Height = 495
Left = 4260
TabIndex = 2
Top = 4260
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "&Read"
Height = 495
Left = 2700
TabIndex = 1
Top = 4245
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "&Write"
Height = 495
Left = 1080
TabIndex = 0
Top = 4230
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
' Windows API calls
Private Declare Function GetPixel Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal y As Integer) As Long
Private Declare Function setpixel Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal crColor As Long) As Long
Private Declare Function ellipse Lib "GDI" (ByVal hDC As Integer, ByVal nLeft As Integer, ByVal nTop As Integer, ByVal nRight As Integer, ByVal nBottom As Integer) As Long
Private Declare Function LineTo Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal y As Integer) As Integer
Private Declare Function Polyline Lib "GDI" (ByVal hDC As Integer, lpPoints As POINTAPI, ByVal nCount As Integer) As Integer
Private Declare Function MoveTo Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal y As Integer) As Long
'-----------------------------------------------------
' BITDEMO1.FRM
' This program demonstrates some of the methods used
' to display bitmaps and sprites.
'-----------------------------------------------------
' The number of pixels to offset the sprite
' each time it is moved.
Const INCREMENT = 1
' Constants for Raster Operations used by BitBlt function.
Const SRCAND = &H8800C6 ' dest = source AND dest
Const SRCCOPY = &HCC0020 ' dest = source
Const SRCPAINT = &HEE0086 ' dest = source OR dest
' The BitBlt Windows API call.
Private Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
' The width and height of the work area bitmap (picWork).
Dim WorkWidth As Integer
Dim WorkHeight As Integer
'Scaling Constants
Const XSCALE = 5
Const YSCALE = 3
Private Sub Command1_Click()
Dim iOutNumber, linetok As Integer
Dim xpos, ypos(150) As Integer
Dim token(400) As String 'String to hold line
Dim color As Long
Static iRnd(2) As Integer, iCount As Integer
'frmWrite.Show
' Randomize
iOutNumber = FreeFile
Open "c:\vb\test.dat" For Output As iOutNumber
For linetok = 1 To 400
For iCount = 1 To 150
xpos = (iCount)
ypos(iCount) = linetok
color = GetPixel(terrain.hDC, xpos, ypos(iCount)) 'Mod 16
Select Case color
Case Is = 12320767
ypos(iCount) = 16
Case Is = 10222591
ypos(iCount) = 15
Case Is = 8125439
ypos(iCount) = 14
Case Is = 6028287
ypos(iCount) = 13
Case Is = 3930111
ypos(iCount) = 12
Case Is = 1832959
ypos(iCount) = 11
Case Is = 63487
ypos(iCount) = 10
Case Is = 57319
ypos(iCount) = 9
Case Is = 52175
ypos(iCount) = 8
Case Is = 46007
ypos(iCount) = 7
Case Is = 39839
ypos(iCount) = 6
Case Is = 34695
ypos(iCount) = 5
Case Is = 28527
ypos(iCount) = 4
Case Is = 23387
ypos(iCount) = 3
Case Is = 17219
ypos(iCount) = 2
Case Is = 16777215
ypos(iCount) = 1
End Select
'ypos = Int(color)
'Write #iOutNumber, xpos, ypos(iCount)
'iRnd(0) = Int(Rnd(1) * 100)
'iRnd(1) = Int(Rnd(1) * 100)
'Write #iOutNumber, iRnd(0), iRnd(1)
token(linetok) = token(linetok) + Str(ypos(iCount))
If iCount < 150 Then
token(linetok) = token(linetok) + ","
End If
Next
'Write #iOutNumber, ypos(1), ypos(2), ypos(3), ypos(4), ypos(5), ypos(6), ypos(7), ypos(8), ypos(9), ypos(10), ypos(11), ypos(12), ypos(13), ypos(14), ypos(15), ypos(16), ypos(17), ypos(18), ypos(19), ypos(20), ypos(21), ypos(22), ypos(23), ypos(24), ypos(25), ypos(26), ypos(27), ypos(28), ypos(29), ypos(30), ypos(31), ypos(32), ypos(33), ypos(34), ypos(35), ypos(36), ypos(37), ypos(38), ypos(39), ypos(40), ypos(41), ypos(42), ypos(43), ypos(44), ypos(45), ypos(46), ypos(47), ypos(48), ypos(49), ypos(50), ypos(51), ypos(52), ypos(53), ypos(54), ypos(55), ypos(56), ypos(57), ypos(58), ypos(59), ypos(60), ypos(5), ypos(6), ypos(7), ypos(8), ypos(9), ypos(10), ypos(11), ypos(12), ypos(13), ypos(14), ypos(15), ypos(2), ypos(3), ypos(4), ypos(5), ypos(6), ypos(7), ypos(8), ypos(9), ypos(10), ypos(11), ypos(12), ypos(13), ypos(14), ypos(15), ypos(2), ypos(3), ypos(4), ypos(5), ypos(6), ypos(7), ypos(8), ypos(9), ypos(10), ypos(11), ypos(12), ypos(13), ypos(14), ypos(15)
Write #iOutNumber, token(linetok)
Next
Close iOutNumber
End Sub
Private Sub Command2_Click()
Dim iAutoNumber As Integer
Dim k, LSx, LSy, LSoffset, ykount, lineNum As Integer
Dim LSxPrime, LSyPrime, MyPos, LastPos As Integer
Dim rc As Long
Static sInput(400, 150), token As String
Dim lineknt As Integer
k = 1
LSoffset = 25
lineNum = 5
iAutoNumber = FreeFile
Open "c:\vb\test.dat" For Input As iAutoNumber
'Input #iAutoNumber, sInput(1), sInput(2), sInput(3), sInput(4), sInput(5), sInput(6), sInput(7), sInput(8), sInput(9), sInput(10), sInput(11), sInput(12), sInput(13), sInput(14), sInput(15)
For lineknt = 1 To 100
Input #iAutoNumber, token
Next
For lineknt = 101 To 120
Input #iAutoNumber, token
LastPos = 1
For k = 1 To 150
MyPos = InStr(LastPos, token, ",")
sInput(lineknt, k) = Mid(token, LastPos, 1)
LastPos = MyPos + 2
'LastPos = MyPosf
Next
'Input #iAutoNumber, sInput(0), sInput(1)
LSyPrime = 4
'LSyPrime = 16 - Val(sInput(1))
picWork.ForeColor = QBColor(0)
LSx = 1
LSy = 16 - Val(sInput(lineknt, 1)) '16 is flat ground
picWork.Line (LSxPrime * XSCALE, LSyPrime * YSCALE + LSoffset)-(LSx * XSCALE, LSy * YSCALE + LSoffset + lineNum)
'Do While Not EOF(iAutoNumber)
'Input #iAutoNumber, sInput(0), sInput(1)
'Print k & ") " & sInput(0) & " , " & sInput(1)
For ykount = 2 To 150
LSx = ykount
LSy = Val(sInput(lineknt, ykount))
picWork.Line -(LSx * XSCALE, LSy * YSCALE + LSoffset)
k = k + 1
'lineNum = lineNum + 20
'picWork.Line (LSxPrime * XSCALE, LSy * YSCALE + LSoffset)-(LSx * XSCALE, LSy * YSCALE + LSoffset + lineNum)
Next
'Loop
LSoffset = LSoffset + 5
Next
Close iAutoNumber
' Draw the whole thing back onto the screen.
rc = BitBlt(vscreen.hDC, 0, 0, vscreen.Width, vscreen.Height, picWork.hDC, 0, 0, SRCCOPY)
'rc = BitBlt(picBackground.hDC, 0, 0, picBackground.Width, picBackground.Height, picWorkBG.hDC, 0, 0, SRCCOPY)
DoEvents
End Sub
Private Sub Command3_Click()
End
End Sub
\PANELS
\LM
FRMLANDE.FRM
VERSION 4.00
Begin VB.Form frmLander
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Lunar Landing"
ClientHeight = 4020
ClientLeft = 1095
ClientTop = 1485
ClientWidth = 7365
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 4425
Left = 1035
LinkTopic = "Form1"
ScaleHeight = 4020
ScaleWidth = 7365
Top = 1140
Width = 7485
End
Attribute VB_Name = "frmLander"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
\RADARLM
LMRADAR.FRM
VERSION 4.00
Begin VB.Form frmMain
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Caption = "Scrolling Background Example"
ClientHeight = 4950
ClientLeft = 1425
ClientTop = 1665
ClientWidth = 4770
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 5355
Left = 1365
LinkTopic = "Form1"
Picture = "LMRADAR.frx":0000
ScaleHeight = 4950
ScaleWidth = 4770
Top = 1320
Width = 4890
Begin VB.VScrollBar VScroll1
Height = 2055
Left = 2310
TabIndex = 2
Top = 1755
Width = 270
End
Begin VB.Timer Timer1
Left = 9015
Top = 135
End
Begin VB.PictureBox Picture2
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 6495
Left = 6240
Picture = "LMRADAR.frx":4B440
ScaleHeight = 6495
ScaleWidth = 2235
TabIndex = 1
Top = 15
Visible = 0 'False
Width = 2235
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1680
Left = 2715
ScaleHeight = 1650
ScaleWidth = 2445
TabIndex = 0
Top = 2055
Width = 2475
End
End
Attribute VB_Name = "frmMain"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Const SRCCOPY = &HCC0020
Const PIXELS = 3
Private Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
Private Sub Form_Load()
' Set the ScaleMode of both PictureBox controls to
' pixels, the units expected by the BitBlt function.
Picture1.ScaleMode = PIXELS
Picture2.ScaleMode = PIXELS
' Picture2 holds the entire background bitmap. Setting
' AutoSize lets the control resize itself to the same
' dimensions as the bitmap it contains.
Picture2.AutoSize = True
' Setting AutoRedraw to true creates a persistent bitmap,
' which can be BitBlted even if it's not visible in the
' window.
Picture2.AutoRedraw = True
' Make sure Picture1 is the same height as Picture2.
Picture1.Width = Picture2.Width
' The maximum scrolling rate will be 20 pixels at a time.
VScroll1.Max = 20
VScroll1.LargeChange = 2
Me.Width = (Me.Width - Me.ScaleWidth) + Picture1.Left + Picture1.Width + VScroll1.Left
' Setting the timer interval causes timer events to begin.
Timer1.Interval = 55
End Sub
Private Sub Timer1_Timer()
Static Y As Integer
Dim AHeight As Integer
Dim rc As Integer
' Calculate the next x position for Picture2.
Y = Y - VScroll1
'If Y > Picture2.ScaleHeight Then Y = 480
If Y < 0 Then Y = Picture2.ScaleHeight
If Y > (Picture2.ScaleHeight - Picture1.ScaleHeight) Then
AHeight = Picture2.ScaleHeight - Y
' When y gets close to the bottom edge of Picture2's bitmap,
' two sections of Picture2 need to be copied into Picture1.
' The first BitBlt copies whatever remains below
' position x in Picture2. The second BitBlt will copy from
' the top side of Picture2 to fill in the remaining
' area to the right of Picture1.
rc = BitBlt(Picture1.hDC, 0, 0, Picture2.ScaleWidth, AHeight, Picture2.hDC, 0, Y, SRCCOPY)
rc = BitBlt(Picture1.hDC, 0, AHeight, Picture2.ScaleWidth, Picture1.ScaleHeight - AHeight, Picture2.hDC, 0, 0, SRCCOPY)
Else
' Normally, only one BitBlt is required to copy the section
' of Picture2 into Picture1.
rc = BitBlt(Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture2.ScaleHeight, Picture2.hDC, 0, Y, SRCCOPY)
End If
End Sub
Directory Listings
A considerable number of folders have text files of directory listings too.
\DOCKING\DOCK
Volume in drive D has no label
Directory of D:\DOCKING\DOCK
. <DIR> 04-28-96 7:25p
.. <DIR> 04-28-96 7:25p
DOCK5 BMP 2,680 04-21-96 12:22p
DOCK4 BMP 1,744 04-21-96 12:23p
DOCK3 BMP 1,108 04-21-96 12:24p
DOCK2 BMP 664 04-21-96 12:25p
DOCK1 BMP 256 04-21-96 12:26p
DOCK10 BMP 9,788 04-21-96 12:28p
DOCK9 BMP 8,192 04-21-96 12:29p
DOCK8 BMP 6,348 04-21-96 12:29p
DOCK6 BMP 3,668 04-21-96 12:31p
DOCK15 BMP 22,076 04-21-96 12:33p
DOCK14 BMP 19,088 04-21-96 12:34p
DOCK13 BMP 16,688 04-21-96 12:35p
DOCK12 BMP 14,108 04-21-96 12:36p
DOCK11 BMP 12,060 04-21-96 12:37p
DOCK20 BMP 38,788 04-21-96 12:40p
DOCK19 BMP 35,324 04-21-96 12:41p
DOCK18 BMP 31,508 04-21-96 12:42p
DOCK17 BMP 28,396 04-21-96 12:42p
DOCK16 BMP 24,828 04-21-96 12:43p
DOCK25 BMP 61,172 04-21-96 12:46p
DOCK24 BMP 55,868 04-21-96 12:47p
DOCK23 BMP 51,692 04-21-96 12:48p
DOCK22 BMP 46,828 04-21-96 12:49p
DOCK21 BMP 43,012 04-21-96 12:50p
DOCK26 BMP 65,708 04-21-96 12:51p
DOCK30 BMP 86,888 04-21-96 12:55p
DOCK28 BMP 75,788 04-21-96 12:57p
DOCK27 BMP 70,908 04-21-96 12:58p
DOCK35 BMP 118,812 04-21-96 12:59p
DOCK34 BMP 111,368 04-21-96 1:00p
DOCK33 BMP 105,432 04-21-96 1:01p
DOCK32 BMP 99,044 04-21-96 1:02p
DOCK31 BMP 93,476 04-21-96 1:03p
DOCK40 BMP 154,188 04-21-96 1:04p
DOCK39 BMP 147,580 04-21-96 1:04p
DOCK38 BMP 139,268 04-21-96 1:05p
DOCK37 BMP 132,620 04-21-96 1:06p
DOCK36 BMP 125,108 04-21-96 1:06p
DOCK45 BMP 195,904 04-21-96 1:08p
DOCK44 BMP 187,188 04-21-96 1:09p
DOCK43 BMP 179,468 04-21-96 1:09p
DOCK42 BMP 170,288 04-21-96 1:10p
DOCK41 BMP 162,928 04-21-96 1:11p
DOCK50 BMP 240,188 04-21-96 1:12p
DOCK49 BMP 231,428 04-21-96 1:13p
DOCK48 BMP 220,988 04-21-96 1:14p
DOCK47 BMP 212,588 04-21-96 1:14p
DOCK46 BMP 202,588 04-21-96 1:15p
DOCK7 BMP 5,760 04-21-96 2:41p
DOCK29 BMP 81,656 04-21-96 3:01p
DIR TXT 0 06-07-96 11:32p
53 file(s) 4,153,044 bytes
234,725,376 bytes free
TEMP.txt is the same, except with this additional entry:
TEMP TXT 0 06-07-96 11:44p
54 file(s) 4,155,582 bytes
234,700,800 bytes free
\DOCKING\MASK
Volume in drive D has no label
Volume Serial Number is 1457-16CF
Directory of D:\DOCKING\MASK
. <DIR> 06-08-96 6:43a
.. <DIR> 06-08-96 6:43a
MASK TXT 0 07-14-96 8:09p
S4B1M BMP 206,740 07-14-96 7:20p
S4B2M BMP 193,356 07-14-96 7:22p
S4B3M BMP 168,768 07-14-96 7:25p
S4B4M BMP 147,380 07-14-96 7:27p
S4B5M BMP 129,240 07-14-96 7:29p
S4B6M BMP 113,640 07-14-96 7:31p
S4B7M BMP 98,424 07-14-96 7:33p
S4B8M BMP 77,240 07-14-96 7:34p
S4B9M BMP 65,080 07-14-96 7:36p
S4B10M BMP 53,512 07-14-96 7:38p
S4B11M BMP 44,116 07-14-96 7:39p
S4B12M BMP 35,832 07-14-96 7:41p
S4B13M BMP 27,456 07-14-96 7:43p
S4B14M BMP 20,664 07-14-96 7:45p
S4B15M BMP 14,760 07-14-96 7:47p
S4B16M BMP 5,704 07-14-96 7:48p
S4B17M BMP 4,272 07-14-96 7:50p
S4B18M BMP 2,072 07-14-96 7:51p
21 file(s) 1,408,256 bytes
933,150,720 bytes free
\DOCKING\S4B
Volume in drive D has no label
Volume Serial Number is 1457-16CF
Directory of D:\DOCKING\S4B
. <DIR> 07-14-96 8:05p
.. <DIR> 07-14-96 8:05p
S4B TXT 0 07-14-96 8:07p
S4B1 BMP 206,740 07-14-96 6:47p
S4B2 BMP 193,356 07-14-96 6:45p
S4B3 BMP 168,768 07-14-96 6:49p
S4B4 BMP 147,380 07-14-96 6:51p
S4B5 BMP 129,240 07-14-96 6:54p
S4B6 BMP 113,640 07-14-96 6:56p
S4B7 BMP 98,424 07-14-96 6:59p
S4B8 BMP 77,240 07-14-96 7:01p
S4B9 BMP 65,080 07-14-96 7:03p
S4B10 BMP 53,512 07-14-96 7:05p
S4B11 BMP 44,116 07-14-96 7:06p
S4B12 BMP 35,832 07-14-96 7:08p
S4B13 BMP 27,456 07-14-96 7:09p
S4B14 BMP 20,664 07-14-96 7:10p
S4B15 BMP 14,760 07-14-96 7:12p
S4B16 BMP 5,704 07-14-96 7:14p
S4B17 BMP 4,272 07-14-96 7:16p
S4B18 BMP 2,072 07-14-96 7:17p
21 file(s) 1,408,256 bytes
933,167,104 bytes free
\PANELS\CAMERA
Volume in drive D has no label
Volume Serial Number is 1457-16CF
Directory of D:\PANELS\CAMERA
. <DIR> 08-26-96 6:53p
.. <DIR> 08-26-96 6:53p
2DAYROCK BMP 77,880 08-26-96 7:02p
3TALLROC BMP 77,880 08-26-96 7:04p
4CSM BMP 77,880 08-26-96 7:04p
5WHITERM BMP 77,240 08-26-96 7:05p
6DAYROCK BMP 77,880 08-26-96 7:05p
7ROCKLOW BMP 77,880 08-26-96 7:06p
2NITROCK BMP 77,880 08-26-96 7:02p
8WHITEOT BMP 77,880 08-26-96 7:07p
9S4BPAD BMP 77,880 08-26-96 7:08p
ARM5 BMP 77,880 08-26-96 7:09p
9HOLDOWN BMP 77,880 08-26-96 7:08p
CAM TXT 0 08-26-96 7:18p
ARM1 BMP 77,880 08-26-96 7:11p
ARM4 BMP 77,880 08-26-96 7:10p
ARM2 BMP 77,880 08-26-96 7:11p
GAMEPAL ACT 768 08-12-96 4:04p
1ENGINE BMP 77,880 08-26-96 7:01p
19 file(s) 1,168,328 bytes
921,845,760 bytes free
\PANELS\CBUTTONS\CSM2
Volume in drive C has no label
Volume Serial Number is 1125-14F5
Directory of C:\PANELS\CBUTTONS\CSM2
. <DIR> 09-18-95 7:16p
.. <DIR> 09-18-95 7:16p
CSM2-1A BMP 3,416 08-10-95 11:03a
CSM2-2A BMP 3,416 08-10-95 11:09a
TEMP TXT 0 02-20-96 4:05p
CSM2-1C BMP 3,416 08-10-95 11:30a
CSM2-2C BMP 3,416 08-10-95 11:37a
CSM2-3A BMP 3,416 08-10-95 11:39a
CSM2-3C BMP 3,416 08-10-95 11:44a
CSM2-4A BMP 3,416 08-10-95 11:46a
CSM2-4C BMP 7,076 09-25-95 7:46p
CSM2-5A BMP 3,416 08-10-95 11:50a
CSM2-5C BMP 3,416 08-10-95 11:52a
CSM2-6A BMP 3,416 08-10-95 11:53a
CSM2-6C BMP 3,416 08-10-95 11:55a
CSM2-7A BMP 3,416 08-10-95 12:00p
CSM2-7C BMP 3,416 08-10-95 12:07p
CSM2-8A BMP 3,416 08-10-95 12:08p
CSM2-8C BMP 3,416 08-10-95 12:17p
CSM2-9A BMP 3,416 08-10-95 12:19p
CSM2-9C BMP 3,416 08-10-95 12:22p
CSM2-10A BMP 3,416 08-10-95 1:16p
CSM2-10C BMP 3,416 08-10-95 1:25p
CSM2-11A BMP 3,416 08-10-95 1:31p
CSM2-11C BMP 3,416 08-10-95 1:36p
CSM2-12A BMP 3,416 08-10-95 1:38p
CSM2-12C BMP 3,416 08-10-95 1:48p
CSM2-13A BMP 3,416 08-10-95 1:50p
CSM2-13C BMP 3,416 08-10-95 1:52p
CSM2-14A BMP 3,416 08-10-95 1:53p
CSM2-14C BMP 3,416 08-10-95 1:56p
CSM2-15A BMP 3,416 08-10-95 1:57p
CSM2-15C BMP 3,416 08-10-95 1:59p
CSM2-16A BMP 3,416 08-10-95 2:08p
CSM2-16C BMP 3,416 08-10-95 2:11p
CSM2-17A BMP 3,416 08-10-95 2:12p
CSM2-17C BMP 3,416 08-10-95 2:15p
CSM2-18A BMP 3,416 08-10-95 2:17p
CSM2-18C BMP 3,416 08-10-95 2:18p
CSM2-19A BMP 3,416 08-10-95 2:39p
CSM2-19C BMP 3,416 08-10-95 2:42p
CSM2-20A BMP 3,416 08-10-95 2:43p
CSM2-20C BMP 3,416 08-10-95 2:46p
CSM2-21A BMP 3,416 08-10-95 3:18p
CSM2-21C BMP 3,416 08-10-95 3:20p
CSM2-22A BMP 3,416 08-10-95 3:21p
CSM2-22C BMP 3,416 08-10-95 3:25p
CSM2-23A BMP 3,416 08-10-95 3:26p
CSM2-23C BMP 3,416 08-10-95 3:29p
CSM2-24A BMP 3,416 08-10-95 3:30p
CSM2-24C BMP 3,416 08-10-95 3:32p
CSM2-25A BMP 3,416 08-10-95 3:40p
CSM2-25C BMP 3,416 08-10-95 3:43p
CSM2-26A TMP 3,416 09-20-95 2:58p
CSM2-26C TMP 3,416 09-20-95 3:00p
CSM2-27A TMP 3,416 08-10-95 3:44p
CSM2-28A TMP 3,416 08-10-95 3:49p
CSM2-28C TMP 3,416 08-10-95 3:54p
CSM2-A2 BMP 3,416 08-10-95 4:04p
CSM2-B2 BMP 3,416 08-10-95 4:06p
CSM2-C2 BMP 3,416 08-10-95 4:10p
CSM22A2 BMP 3,416 08-10-95 4:16p
CSM22C2 BMP 3,416 08-10-95 4:26p
CSM23A2 BMP 3,416 08-10-95 4:35p
CSM23C2 BMP 3,416 08-10-95 4:54p
CSM24A2 BMP 3,416 08-10-95 5:01p
CSM24C2 BMP 3,416 08-10-95 5:03p
CSM25A2 BMP 3,416 08-10-95 5:04p
CSM25C2 BMP 3,416 08-10-95 5:13p
CSM26A2 BMP 3,416 08-10-95 5:14p
CSM26C2 BMP 3,416 08-10-95 5:20p
CSM27A2 BMP 3,416 08-10-95 5:21p
CSM27C2 BMP 3,416 08-10-95 5:29p
CSM28A2 BMP 3,416 08-10-95 5:31p
CSM28C2 BMP 3,416 08-10-95 5:35p
CSM29A2 BMP 3,416 08-10-95 5:40p
CSM29C2 BMP 3,416 08-10-95 5:42p
CSM210A2 BMP 3,416 08-10-95 5:44p
CSM211A2 BMP 3,416 08-10-95 5:49p
CSM211C2 BMP 3,416 08-10-95 5:51p
CSM212A2 BMP 3,416 08-10-95 5:52p
CSM212C2 BMP 3,416 08-10-95 5:55p
CSM213A2 BMP 3,416 08-10-95 5:56p
CSM213C2 BMP 3,416 08-10-95 5:59p
CSM2-27C TMP 3,416 09-20-95 3:07p
CSM2-29A TMP 3,416 09-20-95 3:12p
CSM2-29C TMP 3,416 09-20-95 3:15p
CSM2-30A TMP 3,416 09-20-95 3:15p
CSM2-30C TMP 3,416 09-20-95 3:18p
CSM2-31A TMP 3,416 09-20-95 3:20p
CSM2-31C TMP 3,416 09-20-95 3:21p
CSM2-32A TMP 3,416 09-20-95 3:23p
CSM2-32C TMP 3,416 09-20-95 3:25p
CSM2-33A TMP 3,416 09-20-95 3:26p
CSM2-33C TMP 3,416 09-20-95 3:27p
CSM2-34A TMP 3,416 09-20-95 3:28p
CSM2-34C TMP 3,416 09-20-95 3:30p
CSM2-35A TMP 3,416 09-20-95 3:33p
CSM2-35C TMP 3,416 09-20-95 3:34p
CSM2-36A TMP 3,416 09-20-95 3:35p
CSM2-36C TMP 3,416 09-20-95 3:37p
CSM2-37A TMP 3,416 09-20-95 3:37p
CSM2-37C TMP 3,416 09-20-95 3:40p
CSM2-38A TMP 3,416 09-20-95 3:41p
CSM2-38C TMP 3,416 09-20-95 3:43p
CSM2-39A TMP 3,416 09-20-95 3:45p
CSM2-39C TMP 3,416 09-20-95 3:47p
MASTALRM BMP 6,920 09-25-95 5:29p
EMERG2 BMP 98,864 09-26-95 12:24p
CSM2-26A BMP 3,416 08-10-95 3:44p
CSM2-26C BMP 3,416 09-20-95 3:07p
CSM2-27A BMP 3,416 08-10-95 3:49p
CSM2-27C BMP 3,416 08-10-95 3:54p
CSM2-30A BMP 3,416 09-20-95 3:12p
CSM2-30C BMP 3,416 09-20-95 3:15p
CSM2-31A BMP 3,416 09-20-95 3:15p
CSM2-31C BMP 3,416 09-20-95 3:18p
CSM2-32A BMP 3,416 09-20-95 3:20p
CSM2-32C BMP 3,416 09-20-95 3:21p
CSM2-33A BMP 3,416 09-20-95 3:23p
CSM2-33C BMP 3,416 09-20-95 3:25p
CSM2-34A BMP 3,416 09-20-95 3:26p
CSM2-34C BMP 3,416 09-20-95 3:27p
CSM2-35A BMP 3,416 09-20-95 3:28p
CSM2-35C BMP 3,416 09-20-95 3:30p
CSM2-36A BMP 3,416 09-20-95 3:33p
CSM2-36C BMP 3,416 09-20-95 3:34p
CSM2-37A BMP 3,416 09-20-95 3:35p
CSM2-37C BMP 3,416 09-20-95 3:37p
CSM2-38A BMP 3,416 09-20-95 3:37p
CSM2-38C BMP 3,416 09-20-95 3:40p
CSM2-39A BMP 3,416 09-20-95 3:41p
CSM2-39C BMP 3,416 09-20-95 3:43p
CSM2-28 BMP 3,416 08-10-95 4:10p
CSM2-28A BMP 3,416 08-10-95 4:04p
CSM2-28C BMP 3,416 08-10-95 4:10p
CSM2-29A BMP 3,416 08-10-95 4:16p
CSM2-29B BMP 3,416 08-10-95 4:24p
CSM2-29C BMP 3,416 08-10-95 4:26p
CSM2-40A BMP 3,416 09-20-95 3:45p
CSM2-40C BMP 3,416 09-20-95 3:47p
FIX BAT 1,225 02-13-96 4:20p
FIX BAK 1,021 02-13-96 4:19p
143 file(s) 576,266 bytes
174,309,376 bytes free
\PANELS\LMWARN
Volume in drive C has no label
Directory of C:\PANELS\LMWARN
LM1W1A BMP 2,588 08-15-95 11:21a
LM1W1B BMP 2,588 08-15-95 11:22a
LM1W2A BMP 2,588 08-15-95 11:23a
LM1WARN BMP 2,588 08-15-95 11:25a
LM1W3A BMP 2,588 08-15-95 11:47a
LM1W3B BMP 2,588 08-15-95 11:50a
LM1W2B BMP 2,588 08-15-95 11:53a
LM1W4A BMP 2,588 08-15-95 11:54a
LM1W4B BMP 2,588 08-15-95 11:55a
LM1W5A BMP 2,588 08-15-95 11:55a
LM1W5B BMP 2,588 08-15-95 11:56a
LM1W6A BMP 2,588 08-15-95 12:00p
LM1W6B BMP 2,588 08-15-95 12:01p
LM1W7A BMP 2,588 08-15-95 12:02p
LM1W7B BMP 2,588 08-15-95 12:03p
LM1W8A BMP 2,588 08-15-95 12:05p
LM1W8B BMP 2,588 08-15-95 12:07p
17 file(s) 43,996 bytes
342,245,376 bytes free
\PANELS\RADARCSM
Volume in drive C has no label
Directory of C:\PANELS\RADARCSM
. <DIR> 01-27-96 4:35p
.. <DIR> 01-27-96 4:35p
GNCS <DIR> 01-29-96 8:25p
CSMINPUT BMP 56,964 01-26-96 5:57p
DPSDSPY BMP 57,540 01-27-96 5:19p
ECSDSPY BMP 57,540 01-02-96 9:02p
RADAR BMP 57,500 01-30-96 7:15p
CSMSIGHT BMP 171,448 01-02-96 8:51p
CLEARSCN BMP 57,648 01-02-96 9:11p
EXTCAM BMP 57,540 01-02-96 9:13p
CSD1 BMP 29,212 01-29-96 7:14p
GNCSTAR BMP 57,500 01-29-96 9:22p
GIMBDSPY BMP 56,120 01-30-96 6:49p
_BACKUP_ PCX 13,352 01-30-96 7:08p
GIMBDSPY PCX 19,397 01-30-96 6:44p
RADAR PCX 13,320 01-30-96 7:13p
TARGET BMP 57,540 01-28-96 4:44p
TEMPDIR 0 03-01-96 12:38p
18 file(s) 762,621 bytes
172,457,984 bytes free
\TMINUS
Volume in drive D has no label
Volume Serial Number is 1457-16CF
Directory of D:\TMINUS
. <DIR> 04-21-96 4:35p
.. <DIR> 04-21-96 4:35p
T-415 WAV 17,326 04-21-96 9:27a
T-345 WAV 18,846 04-21-96 9:28a
T-325 WAV 11,694 04-21-96 9:30a
T-315 WAV 17,230 04-21-96 9:31a
T-300 WAV 6,494 04-21-96 9:32a
T-245 WAV 12,046 04-21-96 9:33a
T-230 WAV 15,502 04-21-96 9:35a
T-215 WAV 10,142 04-21-96 9:36a
T-200 WAV 8,862 04-21-96 9:38a
T-140 WAV 11,614 04-21-96 9:39a
T-090 WAV 10,958 04-21-96 9:40a
T-100 WAV 6,446 04-21-96 9:41a
T-045 WAV 13,134 04-21-96 9:42a
T-030 WAV 10,662 04-21-96 9:43a
T-010 WAV 104,366 04-21-96 9:45a
T-30CHCK WAV 190,458 04-20-96 10:56p
AUTOARM WAV 34,936 04-20-96 10:32p
GUIDINT WAV 7,102 04-20-96 9:29p
LANCHSEQ WAV 17,562 04-20-96 10:59p
LNCHSTRT WAV 26,424 04-20-96 10:27p
NOTANK WAV 49,914 04-20-96 10:31p
PRESTART WAV 22,648 04-20-96 10:33p
LBKGND1 WAV 122,490 04-20-96 11:04p
LBKGND2 WAV 40,440 04-20-96 11:06p
LBKGND3 WAV 73,720 04-20-96 11:08p
LBKGND4 WAV 20,600 04-20-96 11:09p
LBKGND5 WAV 32,122 04-20-96 11:12p
STAGEBK1 WAV 130,936 04-20-96 11:15p
TEMP TXT 0 04-21-96 4:39p
31 file(s) 1,044,674 bytes
972,898,304 bytes free
\WARNINGS
Volume in drive C has no label
Volume Serial Number is 1125-14F5
Directory of C:\WARNINGS
. <DIR> 02-08-96 1:29p
.. <DIR> 02-08-96 1:29p
WARNFCEL WAV 39,066 02-03-96 8:16p
WARNVELC WAV 40,090 02-03-96 8:13p
WARNCRSE WAV 43,162 02-03-96 8:10p
WARNPULL WAV 35,450 02-03-96 8:05p
WARNRCS WAV 69,498 02-03-96 8:02p
WARNFUEL WAV 52,602 02-03-96 7:59p
WARN1O2 WAV 86,190 02-03-96 9:20p
WARNSPJT WAV 23,002 02-03-96 9:18p
WARNLMJT WAV 17,370 02-03-96 9:12p
WARNPYRO WAV 19,770 02-03-96 9:07p
WARNGIMB WAV 10,170 02-03-96 9:04p
WARNGEAR WAV 11,754 02-03-96 9:01p
WARNLES WAV 32,442 02-03-96 8:58p
WARNJETT WAV 27,386 02-03-96 8:42p
WARNELEC WAV 29,498 02-03-96 8:39p
WARNIMU WAV 38,394 02-03-96 8:36p
WARNCOLL WAV 51,130 02-03-96 8:33p
WARNABRT WAV 25,434 02-03-96 8:30p
WARNCOMP WAV 29,050 02-03-96 8:24p
WARNENGF WAV 84,858 02-03-96 8:22p
TEMP TXT 0 02-08-96 1:42p
23 file(s) 766,316 bytes
204,210,176 bytes free
