VERSION 5.00 Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX" Begin VB.Form frmMain BackColor = &H00C0C0C0& Caption = "Projectile Motion Lab" ClientHeight = 9975 ClientLeft = 2625 ClientTop = 1650 ClientWidth = 11325 LinkTopic = "Form1" ScaleHeight = 9975 ScaleWidth = 11325 Begin VB.TextBox GateTime4 Height = 375 Left = 6960 Locked = -1 'True TabIndex = 52 Top = 9000 Width = 855 End Begin VB.TextBox GateTime3 Height = 375 Left = 5880 Locked = -1 'True TabIndex = 51 Top = 9000 Width = 855 End Begin VB.TextBox GateTime2 Height = 375 Left = 4800 Locked = -1 'True TabIndex = 50 Top = 9000 Width = 855 End Begin VB.TextBox GateTime1 Height = 375 Left = 3720 Locked = -1 'True TabIndex = 49 Top = 9000 Width = 855 End Begin VB.TextBox TestGatesTime BackColor = &H00800000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 2520 TabIndex = 48 Text = "Gate Times" Top = 9000 Width = 1095 End Begin VB.TextBox Text5 BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 9000 Locked = -1 'True TabIndex = 44 Text = "m" Top = 6840 Width = 495 End Begin VB.TextBox Text4 BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 5040 Locked = -1 'True TabIndex = 43 Text = "s" Top = 6840 Width = 375 End Begin VB.TextBox Text3 BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 9600 Locked = -1 'True TabIndex = 42 Text = "m/s" Top = 6000 Width = 735 End Begin VB.TextBox Text2 BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 6600 Locked = -1 'True TabIndex = 41 Text = "m/s" Top = 6000 Width = 735 End Begin VB.TextBox txtAngleUnits BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 4560 Locked = -1 'True TabIndex = 40 Text = "deg" Top = 4560 Width = 615 End Begin VB.TextBox SpeedBit2 Height = 285 Left = 6000 Locked = -1 'True TabIndex = 39 Top = 8040 Width = 375 End Begin VB.TextBox XSpeed BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 5640 Locked = -1 'True TabIndex = 38 Top = 6000 Width = 855 End Begin VB.TextBox VsubX BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 4680 TabIndex = 37 Text = "V(x)" Top = 6000 Width = 855 End Begin VB.TextBox YSpeed BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 8520 Locked = -1 'True TabIndex = 36 Top = 6000 Width = 975 End Begin VB.TextBox TFlight BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 570 Left = 3840 TabIndex = 35 Top = 6840 Width = 1095 End Begin VB.TextBox VsubY BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 7560 TabIndex = 34 Text = "V(y)" Top = 6000 Width = 855 End Begin VB.TextBox FlightTime BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 1560 TabIndex = 33 Text = "Flight Time" Top = 6840 Width = 2175 End Begin VB.TextBox CartPosition BackColor = &H00800000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 6720 TabIndex = 32 Text = "CartPosition" Top = 8040 Width = 1215 End Begin VB.TextBox Range BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 6360 TabIndex = 31 Text = "Range" Top = 6840 Width = 1335 End Begin VB.TextBox PositionText Height = 285 Left = 8040 TabIndex = 30 Top = 8040 Width = 735 End Begin VB.TextBox RangeText BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 7800 Locked = -1 'True TabIndex = 29 Top = 6840 Width = 1095 End Begin VB.CommandButton ReleaseTest Caption = "Test" Height = 375 Left = 8280 TabIndex = 28 Top = 8520 Width = 495 End Begin VB.TextBox TestRelease BackColor = &H00800000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 7320 TabIndex = 27 Text = "Release " Top = 8520 Width = 855 End Begin VB.Timer Update Left = 9840 Top = 2160 End Begin VB.TextBox DelX BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 5400 TabIndex = 26 Text = "Catcher" Top = 4560 Width = 1215 End Begin VB.TextBox SpdBit BackColor = &H00800000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 4440 TabIndex = 25 Text = "Speedbits" Top = 8040 Width = 975 End Begin VB.Frame Frame1 Caption = "Frame1" Height = 135 Left = 1320 TabIndex = 24 Top = 3480 Width = 15 End Begin VB.TextBox txtHeightUnits BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 4560 Locked = -1 'True TabIndex = 23 Text = "pos" Top = 3960 Width = 615 End Begin VB.TextBox txtSpeed BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 3720 Locked = -1 'True TabIndex = 22 Text = "m/s" Top = 6000 Width = 735 End Begin VB.TextBox BallSpeed BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 615 Left = 1200 Locked = -1 'True TabIndex = 21 Text = "Speed" Top = 6000 Width = 1335 End Begin VB.TextBox Speed BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 2640 Locked = -1 'True TabIndex = 20 Top = 6000 Width = 975 End Begin VB.TextBox SpeedBit1 Height = 285 Left = 5520 Locked = -1 'True TabIndex = 19 Top = 8040 Width = 375 End Begin VB.TextBox DeltaX BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 6840 Locked = -1 'True TabIndex = 18 Top = 4560 Width = 1095 End Begin VB.CommandButton SoundTest Caption = "Test" Height = 375 Left = 6480 TabIndex = 17 Top = 8520 Width = 495 End Begin VB.TextBox TestSound BackColor = &H00800000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 5640 TabIndex = 16 Text = "Sound " Top = 8520 Width = 735 End Begin VB.TextBox Status Height = 285 Left = 3360 Locked = -1 'True TabIndex = 15 Top = 8040 Width = 615 End Begin VB.TextBox LabStatus BackColor = &H00800000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 2520 TabIndex = 14 Text = "Status" Top = 8040 Width = 735 End Begin VB.ComboBox cboBall BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 420 ItemData = "frmMain.frx":0000 Left = 6840 List = "frmMain.frx":0013 Style = 2 'Dropdown List TabIndex = 13 Top = 3960 Width = 1095 End Begin VB.TextBox BallType BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 5400 Locked = -1 'True TabIndex = 12 Text = "Ball Type" Top = 3960 Width = 1215 End Begin VB.CommandButton Launch BackColor = &H000000FF& Caption = "Launch" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 8400 MaskColor = &H00FFFFFF& Style = 1 'Graphical TabIndex = 11 Top = 4440 Width = 1335 End Begin VB.PictureBox LabGraphic Height = 3015 Left = 2520 Picture = "frmMain.frx":0039 ScaleHeight = 2955 ScaleWidth = 5955 TabIndex = 10 Top = 0 Width = 6015 End Begin VB.CommandButton CartTest Caption = "Test" Height = 375 Left = 3240 TabIndex = 9 Top = 8520 Width = 495 End Begin VB.CommandButton RampTest BackColor = &H00800000& Caption = "Test" Height = 375 Left = 4800 MaskColor = &H00800000& TabIndex = 8 Top = 8520 Width = 495 End Begin VB.TextBox HeightText BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 3600 Locked = -1 'True TabIndex = 7 Top = 3960 Width = 855 End Begin VB.ComboBox cboAngle BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 420 ItemData = "frmMain.frx":3A9FB Left = 3480 List = "frmMain.frx":3AA17 Style = 2 'Dropdown List TabIndex = 6 Top = 4560 Width = 975 End Begin VB.TextBox TestCart BackColor = &H00800000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 2520 TabIndex = 5 Text = "Cart " Top = 8520 Width = 615 End Begin VB.TextBox TestRamp BackColor = &H00800000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 4080 TabIndex = 4 Text = "Ramp " Top = 8520 Width = 615 End Begin VB.TextBox LaunchReady BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 1005 Left = 8280 TabIndex = 3 Top = 3960 Width = 1575 End Begin VB.TextBox LaunchAngle BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Index = 0 Left = 1920 Locked = -1 'True TabIndex = 2 Text = "Ramp Angle" Top = 4560 Width = 1575 End Begin VB.TextBox LaunchHeight BackColor = &H00FF0000& BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000009& Height = 375 Left = 1920 Locked = -1 'True TabIndex = 1 Text = "Start Height" Top = 3960 Width = 1575 End Begin ComctlLib.StatusBar sbStatusBar Align = 2 'Align Bottom Height = 270 Left = 0 TabIndex = 0 Top = 9705 Width = 11325 _ExtentX = 19976 _ExtentY = 476 SimpleText = "" _Version = 327682 BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} NumPanels = 3 BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} AutoSize = 1 Object.Width = 14420 Text = "Status" TextSave = "Status" Object.Tag = "" EndProperty BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} Style = 6 AutoSize = 2 TextSave = "4/8/2003" Object.Tag = "" EndProperty BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} Style = 5 AutoSize = 2 TextSave = "5:02 PM" Object.Tag = "" EndProperty EndProperty End Begin VB.Line Line3 X1 = 1680 X2 = 10440 Y1 = 7560 Y2 = 7560 End Begin VB.Line Line2 X1 = 960 X2 = 9720 Y1 = 5400 Y2 = 5400 End Begin VB.Line Line1 X1 = 960 X2 = 9720 Y1 = 3360 Y2 = 3360 End Begin VB.Label InitialData BackColor = &H00FFFF00& BorderStyle = 1 'Fixed Single Caption = "Initial Conditions" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1080 TabIndex = 47 Top = 3480 Width = 1935 End Begin VB.Label ProjectileData BackColor = &H00FFFF00& BorderStyle = 1 'Fixed Single Caption = "Flight Parameters" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1080 TabIndex = 46 Top = 5520 Width = 1935 End Begin VB.Label TestLabel BackColor = &H00808080& BorderStyle = 1 'Fixed Single Caption = "Diagnostic Data and Test" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 255 Left = 1080 TabIndex = 45 Top = 7680 Width = 2295 End Begin ComctlLib.ImageList imlIcons Left = 9720 Top = 1080 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 327682 BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} NumListImages = 13 BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3AA3B Key = "" EndProperty BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3AD8D Key = "" EndProperty BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3B0DF Key = "" EndProperty BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3B431 Key = "" EndProperty BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3B783 Key = "" EndProperty BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3BAD5 Key = "" EndProperty BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3BE27 Key = "" EndProperty BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3C179 Key = "" EndProperty BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3C4CB Key = "" EndProperty BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3C81D Key = "" EndProperty BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3CB6F Key = "" EndProperty BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3CEC1 Key = "" EndProperty BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":3D213 Key = "" EndProperty EndProperty End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuHelpContents Caption = "&Contents" End Begin VB.Menu mnuHelpSearch Caption = "&Search For Help On..." End Begin VB.Menu mnuHelpBar1 Caption = "-" End Begin VB.Menu mnuHelpAbout Caption = "&About MProject1..." End End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'Declarations 'dll for direct control of parallel port - WIN95IO.DLL Private Declare Sub vbOut Lib "WIN95IO.DLL" (ByVal nPort As Integer, ByVal nData As Integer) Private Declare Sub vbOutw Lib "WIN95IO.DLL" (ByVal nPort As Integer, ByVal nData As Integer) Private Declare Function vbInp Lib "WIN95IO.DLL" (ByVal nPort As Integer) As Integer Private Declare Function vbInpw Lib "WIN95IO.DLL" (ByVal nPort As Integer) As Integer 'force explicit declarations Option Explicit 'parameters for Windows .wav file player API - WINMM.DLL Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long Const SND_ASYNC = &H1 'interrupt currently playing waves Const SND_LOOP = &H8 'play wave file in a loop Const SND_NODEFAULT = &H2 'if the wave file specified cannot be found then no other sound will be played Const SND_SYNC = &H0 'does not return control to the program until the wave file has finished Const SND_NOSTOP = &H10 'if a wave file is already playing, our wave file will not interrupt it Const SND_MEMORY = &H4 'plays a wave file that has already been stored in memory (in string) with Get command Private Declare Function GetTickCount Lib "kernel32" () As Long Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any) Dim intCartPosition, intState, intBitPosition As Byte Dim intDataPort, intStatusPort, intControlPort, intPortWord, intSpare As Integer Dim sngAvgSpeed, sngBallSpeed, sngRampRadians, sngSpeedX, sngSpeedY, sngFlightT As Single Dim sngMinRange, sngRange, sngMaxRange As Single Dim intBallHeight, intDeltaX, intReleaseBit, intSpeedBit1, intSpeedBit2 As Integer Dim intRampPosition, intLastPosition, intMaxPosition, intRampDegrees As Integer Dim PortBits(3 To 7) As Integer Dim blnReleaseBit, blnBallRelease As Boolean Dim Time1, Time2, Time3, Time4 As Long Private Sub Form_Load() Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000) Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000) Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500) Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500) 'prevent multiple instances of Lab from running If App.PrevInstance = True Then MsgBox "Only one instance of this program may run at one time" End End If 'initialize Lab interface ports intDataPort = 888 intStatusPort = 889 intControlPort = 890 cboAngle.ListIndex = 2 cboBall.ListIndex = 4 'set lab variables to initial values, cart left end, ramp 45 degrees, ball locked Update.Interval = 500 'set Timer interval 'cart settings intCartPosition = 255 'initial position closest to ramp intMaxPosition = 255 'maximum extent of servo (up to 255) 'ramp settings intRampPosition = 255 'Fix(intMaxPosition / 2) initial position intLastPosition = 254 Call SetCart(intCartPosition) Call cboAngle_Click blnReleaseBit = False 'read status of ball height, delta X, ball loaded Call GetStatus 'display initial status byte Call DisplayStatus 'set cart to initial position 'Call SetCart(intCartPosition) 'set ramp to 45 degrees 'Call SetAngle(intRampPosition) 'engage ball lock Call BallRelease(blnReleaseBit) End Sub Private Sub Form_Unload(Cancel As Integer) Dim i As Integer 'close all sub forms For i = Forms.Count - 1 To 1 Step -1 Unload Forms(i) Next If Me.WindowState <> vbMinimized Then SaveSetting App.Title, "Settings", "MainLeft", Me.Left SaveSetting App.Title, "Settings", "MainTop", Me.Top SaveSetting App.Title, "Settings", "MainWidth", Me.Width SaveSetting App.Title, "Settings", "MainHeight", Me.Height End If End Sub Private Sub Update_Timer() Call GetStatus Call DisplayStatus Call SetAngle(intRampPosition) End Sub Private Sub cboAngle_Click() Select Case cboAngle.ListIndex Case 0 intRampPosition = 0 '35 deg Case 1 intRampPosition = 55 '40 deg Case 2 intRampPosition = 78 '45 deg Case 3 intRampPosition = 102 '50 deg Case 4 intRampPosition = 129 '55 deg Case 5 intRampPosition = 162 '60 deg Case 6 intRampPosition = 197 '65 deg Case 7 intRampPosition = 255 '70 deg End Select intRampDegrees = (35 + (cboAngle.ListIndex * 5)) 'convert list index (0-8) to degrees (15-75) sngRampRadians = (intRampDegrees) * (3.1416 / 180) 'angle in radians End Sub Private Sub GetStatus() 'There are several switch contacts on the lab equipment that are detected as the '5 status bits of the parallel port input status word: 'S0 is SpeedBit1, first gate of the speed trap; 1 when clear, 0 when blocked 'S1 is SpeedBit2, second gate of the speed trap 'S2 is the Delta X; 0 catcher near ramp, 1 far 'S3 is Ball Height; 1 if low position, 0 if high position 'S4 is spare (wired into printer port from buffer on PC board but no connection further) 'parse input and set variables for ball height (intBallHeight),position of 'catcher relative to ramp (intDeltaX), and speed gate (intSpeedBit1,2) intSpeedBit1 = BitStatus(3) intSpeedBit2 = BitStatus(4) intDeltaX = BitStatus(5) intBallHeight = BitStatus(6) intSpare = BitStatus(7) 'not used End Sub Function BitStatus(intBitPosition) As Integer 'detect ball present, ball height and delta X; also checks speed sensor for clear path 'intPortWord is the 8 bits of the Status Port 'however the bits we want bits 4-7 of the byte with bits 0-2 read as ?. 'set up PortBits array with 5 individual bits of status Dim i As Integer intPortWord = (Fix(vbInp(intStatusPort) / 8)) 'zero out bits 0-2 For i = 3 To 7 PortBits(i) = intPortWord Mod 2 intPortWord = Fix(intPortWord / 2) Next i BitStatus = PortBits(intBitPosition) End Function Private Sub DisplayStatus() Status.Text = (Fix(vbInp(intStatusPort) / 8)) 'decimal representation of 5 bit status word SpeedBit1.Text = intSpeedBit1 SpeedBit2.Text = intSpeedBit2 DeltaX.Text = intDeltaX GateTime1.Text = Time1 GateTime2.Text = Time2 GateTime3.Text = Time3 GateTime4.Text = Time4 RangeText.Text = sngRange If intBallHeight = 0 Then HeightText.Text = "High" Else HeightText.Text = "Low" End If If intDeltaX = 0 Then DeltaX.Text = "Near" Else DeltaX.Text = "Far" End If Speed.Text = sngBallSpeed XSpeed.Text = sngSpeedX YSpeed.Text = sngSpeedY TFlight.Text = sngFlightT PositionText.Text = intCartPosition LaunchReady.Text = " Ready" End Sub Private Sub Launch_Click() Call GetStatus If intDeltaX = 0 Then 'max distance of cart from ramp depends on position of ramp sngMaxRange = 0.5 sngMinRange = 0.05 Else sngMaxRange = 0.7 sngMinRange = 0.25 End If If intRampDegrees > 60 And intDeltaX = 1 And intBallHeight = 1 Then Call PlaySound(5) 'range too short to catch Exit Sub End If If intRampDegrees < 55 And intDeltaX = 0 And intBallHeight = 0 Then Call PlaySound(6) 'range too long to catch Exit Sub End If If intSpeedBit1 = 1 And intSpeedBit2 = 1 Then 'release ball Call BallRelease(True) If intRampDegrees < 50 And intBallHeight = 0 Then Call SetCart(128) End If 'get ball speed Call SpeedTrap sngBallSpeed = sngBallSpeed * (1 + ((1 - intRampDegrees / 75) * 0.175)) 'calculate impact location (refine calculations once model complete) sngRange = Fix(100 * (sngBallSpeed ^ 2 * Sin(2 * sngRampRadians)) / 9.8) / 100 'error check If sngRange < sngMinRange Then Call PlaySound(1) sngSpeedX = sngBallSpeed * Cos(sngRampRadians) sngSpeedY = sngBallSpeed * Sin(sngRampRadians) sngFlightT = (2 * sngBallSpeed * Sin(sngRampRadians)) / 9.8 Exit Sub End If If sngRange > sngMaxRange Then sngRange = sngMaxRange End If 'move cart to catch ball intCartPosition = Fix((1 - ((sngRange - sngMinRange) / (sngMaxRange - sngMinRange))) * 255) Call SetCart(intCartPosition) 'calculate and display Vx, Vy, and flight time T sngSpeedX = sngBallSpeed * Cos(sngRampRadians) sngSpeedY = sngBallSpeed * Sin(sngRampRadians) sngFlightT = Fix(100 * (2 * sngBallSpeed * Sin(sngRampRadians)) / 9.8) / 100 Call DelayTime(Fix(sngFlightT * 1000)) 'sound effect If Rnd Mod 2 = 0 Then Call PlaySound(3) Else Call PlaySound(4) End If 'return cart to start position Call SetCart(255) Else LaunchReady.Text = "Error!" Call PlaySound(1) End If End Sub Private Sub SetCart(intCartPosition) Dim SelectA, WriteA, DeSelect As Integer If blnBallRelease = False Then SelectA = 3 WriteA = 11 DeSelect = 0 Else SelectA = 7 WriteA = 15 DeSelect = 4 End If 'set position data on DataPort vbOut intDataPort, intCartPosition 'set DAC Chip Select, select DAC for Cart vbOut intControlPort, SelectA 'write to DAC vbOut intControlPort, WriteA Call DelayTime(10) 'deselect Chip, DAC vbOut intControlPort, DeSelect 'Call DelayTime(10) vbOut intDataPort, 0 Call DelayTime(10) End Sub Private Sub SetAngle(intRampPosition) Dim i, SelectB, WriteB, DeSelect As Integer If blnBallRelease = False Then SelectB = 2 WriteB = 10 DeSelect = 0 Else SelectB = 6 WriteB = 14 DeSelect = 4 End If If intRampPosition = intLastPosition Then Exit Sub End If For i = intLastPosition To intRampPosition Step Sgn(intRampPosition - intLastPosition) 'set position data on DataPort vbOut intDataPort, i 'Call DelayTime(10) 'set DAC Chip Select, select DAC for Ramp vbOut intControlPort, SelectB 'write to DAC Call DelayTime(1) vbOut intControlPort, WriteB 'deselect Chip, DAC vbOut intControlPort, DeSelect 'clear DataPort Next i intLastPosition = intRampPosition vbOut intDataPort, 0 'Call DelayTime(10) End Sub Private Sub DelayTime(msTime) 'causes a time delay in program execution of approximately (msTime) milliseconds Dim TempTime As Long TempTime = GetTickCount() Do Until msTime < GetTickCount() - TempTime 'nothing Loop End Sub Private Sub BallRelease(blnReleaseBit) If blnReleaseBit = True Then Call PlaySound(2) LaunchReady.Text = "Launch!" vbOut intControlPort, 4 'pulse release solenoid Call DelayTime(100) vbOut intControlPort, 0 'reset ball release Call DelayTime(200) Else vbOut intControlPort, 0 'reset ball release End If End Sub Private Sub SpeedTrap() intSpeedBit1 = 1 'initialize gate intSpeedBit2 = 1 'two sensors pull individual line to ground so we are expecting 1-0-1 transition on each 'wait for first sensor Do Until intSpeedBit1 = 0 intSpeedBit1 = BitStatus(3) Loop Time1 = GetTickCount() Do Until intSpeedBit1 = 1 intSpeedBit1 = BitStatus(3) Loop Time2 = GetTickCount() Do Until intSpeedBit2 = 0 intSpeedBit2 = BitStatus(4) Loop Time3 = GetTickCount() Do Until intSpeedBit2 = 1 intSpeedBit2 = BitStatus(4) Loop Time4 = GetTickCount() 'calculate Speed in meters/sec (or millimeters per millisecond) for 60mm between sensors sngAvgSpeed = 60 / (((Time4 - Time2) + (Time3 - Time1)) / 2) sngBallSpeed = sngAvgSpeed * 0.9 ' (Fix(100 * ((Time2 - Time1) / (Time4 - Time3)) * sngAvgSpeed)) / 100 End Sub Private Sub ReleaseTest_Click() vbOut intControlPort, 4 Call DelayTime(100) vbOut intControlPort, 0 Call DelayTime(100) Call SpeedTrap 'calculate impact location (refine calculations once model complete) sngRange = (sngBallSpeed ^ 2 * Sin(2 * sngRampRadians)) / 9.8 'calculate and display Vx, Vy, and flight time T sngSpeedX = sngBallSpeed * Cos(sngRampRadians) sngSpeedY = sngBallSpeed * Sin(sngRampRadians) sngFlightT = (2 * sngSpeedY) / 9.8 End Sub Private Sub RampTest_Click() Dim i As Integer For i = intRampPosition To 0 Step -1 Call SetAngle(i) Next For i = 1 To intMaxPosition Step 1 Call SetAngle(i) Next For i = (intMaxPosition - 1) To intRampPosition Step -1 Call SetAngle(i) Next End Sub Private Sub CartTest_Click() Dim i As Integer 'move cart from present position to far left, far right and back to initial position Call SetCart(0) Call DelayTime(500) Call SetCart(255) Call DelayTime(500) Call SetCart(0) Call DelayTime(500) For i = intCartPosition To 0 Step -1 Call SetCart(i) Next For i = 1 To 255 Step 1 Call SetCart(i) Next For i = 254 To intCartPosition Step -1 Call SetCart(i) 'Call DisplayStatus Next End Sub Private Sub SoundTest_Click() Dim k As Integer For k = 1 To 6 Call PlaySound(k) Next k End Sub Private Sub PlaySound(Effect) 'wav file API call example 'sndPlaySound App.Path & "\file.wav", SND_LOOP Select Case Effect Case 1 sndPlaySound App.Path & "\anykey.wav", SND_SYNC Case 2 sndPlaySound App.Path & "\drumroll.wav", SND_SYNC Case 3 sndPlaySound App.Path & "\yeah.wav", SND_SYNC Case 4 sndPlaySound App.Path & "\wuhoo2.wav", SND_SYNC Case 5 sndPlaySound App.Path & "\tooclose.wav", SND_SYNC Case 6 sndPlaySound App.Path & "\toofar.wav", SND_SYNC End Select End Sub Private Sub mnuHelpAbout_Click() frmAbout.Show vbModal, Me End Sub Private Sub mnuHelpContents_Click() Dim nRet As Integer 'if there is no helpfile for this project display a message to the user 'you can set the HelpFile for your application in the 'Project Properties dialog If Len(App.HelpFile) = 0 Then MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption Else On Error Resume Next nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0) If Err Then MsgBox Err.Description End If End If End Sub Private Sub mnuHelpSearch_Click() Dim nRet As Integer 'if there is no helpfile for this project display a message to the user 'you can set the HelpFile for your application in the 'Project Properties dialog If Len(App.HelpFile) = 0 Then MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption Else On Error Resume Next nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0) If Err Then MsgBox Err.Description End If End If End Sub