Master 95 #1/MASTER95_1.iso/microsof/vbasic4/vb4-6.cab/gravtest.frm

Visual Basic Form | 1995-07-26 | 5.4 KB | 153 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "Ball Trajectory"
   ClientHeight    =   6480
   ClientLeft      =   1788
   ClientTop       =   2400
   ClientWidth     =   8112
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   1
      weight          =   700
      size            =   9.6
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   6900
   Left            =   1740
   LinkTopic       =   "Form1"
   ScaleHeight     =   6480
   ScaleWidth      =   8112
   Top             =   2028
   Width           =   8208
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Left            =   315
      Top             =   4200
   End
   Begin VB.CommandButton Command1
      Caption         =   "Throw"
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   1
         weight          =   700
         size            =   7.8
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   420
      Left            =   6780
      TabIndex        =   0
      Top             =   120
      Width           =   1170
   End
   Begin VB.Label Label2
      Caption         =   "The length of the line represents the vertical and horizontal velocity vectors of the ball.  To throw the ball, click the Throw button. "
      Height          =   1170
      Left            =   105
      TabIndex        =   2
      Top             =   1470
      Width           =   6630
   End
   Begin VB.Shape Shape1
      BorderStyle     =   3  'Dot
      Height          =   972
      Left            =   120
      Top             =   5400
      Width           =   972
   End
   Begin VB.Label Label1
      Caption         =   "To map the trajectory of a ball, place the mouse pointer at the starting point of the trajectory, drag the pointer in the direction you want to throw the ball, and then release the mouse button. (You can drag the mouse in the small outlined area for your first attempts.)"
      Height          =   1365
      Left            =   105
      TabIndex        =   1
      Top             =   105
      Width           =   6495
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' **************************************************************************
' GRAVTEST.MAK demonstrates how to use OLE Automation to manipulate other
' applications' objects.
' It should be used with GRAVITY.MAK.  GRAVTEST.MAK is the
' controlling application, and GRAVITY.MAK is the object application.
' Open and run GRAVITY.MAK in Visual Basic, and then open and run
' GRAVTEST.MAK in a second instance of Visual Basic.  GRAVTEST.MAK uses
' the Ball object that is defined in GRAVITY.MAK.
' **************************************************************************
Dim oT As Object
Dim dblStartDistance As Double
Dim dblStartHeight As Double
Dim dblStartXVelocity As Double
Dim dblStartYVelocity As Double
Dim X0 As Single
Dim Y0 As Single
Dim mblnDragging As Boolean
' Use the throw method to calculate the height and distance of the ball.
Private Sub Command1_Click()
    oT.throw dblStartXVelocity, -dblStartYVelocity
    Timer1.Interval = 500
    Timer1.Enabled = True
    Command1.Visible = False
    Command1.Enabled = False
    Label1.Visible = False
    Label2.Visible = False
    Shape1.Visible = False
    Me.Cls
    Me.Circle (dblStartDistance, dblStartHeight), 50
End Sub
' Set oT to the gravity.ball class, defined in GRAVITY.MAK.
Private Sub Form_Load()
    Set oT = CreateObject("gravity.ball")
End Sub
' This procedure starts the throw.
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    X0 = X
    Y0 = Y
    mblnDragging = True
End Sub
' This procedure draws the throw.
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If mblnDragging Then
        Me.Line (X0, Y0)-(X, Y)
    End If
End Sub
' This  procedure sets the start location and velocity, and turns off
' dragging.
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.Cls
    Me.Line (X0, Y0)-(X, Y)
    dblStartDistance = X0
    dblStartHeight = Y0
    dblStartXVelocity = X - X0
    dblStartYVelocity = Y - Y0
    mblnDragging = False
End Sub
' Calculate the ball position at each timer interval.
Private Sub Timer1_Timer()
    Dim dblNow As Double
    Dim dblHeight As Double
    Dim dblDistance As Double
    Dim mtti As Long
    mtti = timeGetTime() ' TimerCount mtti
    dblNow = CDbl(mtti) / 1000
    dblHeight = oT.Height(dblNow)
    dblDistance = oT.distance(dblNow)
    ' When the ball travels off the screen, stop drawing, and beep.
    If (dblStartHeight - dblHeight < Me.ScaleHeight) And (dblStartDistance + dblDistance < Me.ScaleWidth) Then
        Me.Circle (dblStartDistance + dblDistance, dblStartHeight - dblHeight), 50
    Else
        Timer1.Enabled = False
        Command1.Visible = True
        Command1.Enabled = True
        Label1.Visible = True
        Label2.Visible = True
        Shape1.Visible = True
        Beep
    End If
End Sub