Cannon.frm
Option
Explicit
Private
Const DISTANCE_SCALE = 10
Private
Const CANNON_SCALE = 10
Private
TargetX As Single
Private
BitmapWid As Long
Private
BitmapHgt As Long
Private
BitmapNumBytes As Long
Private
Bytes() As Byte
'
------------------
'
Bitmap Information
'
------------------
Private
Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End
Type
Private
Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long,
ByVal dwCount As Long, lpBits As Any) As Long
Private
Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long,
ByVal dwCount As Long, lpBits As Any) As Long
Private
Declare Function GetObject Lib "gdi32" Alias "GetObjectA"
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
'
Get the initial velocity components from the
'
speed and angle.
Private
Sub GetInitialVelocity(ByRef vx As Single, ByRef vy As Single)
Const
PI = 3.14159365
Dim
angle As Single
Dim
speed As Single
' Get the angle in radians and the speed.
On Error Resume Next
angle = CSng(txtAngle.Text) * PI / 180
speed = CSng(txtSpeed.Text)
vx = Cos(angle) * speed / DISTANCE_SCALE
vy = -Sin(angle) * speed / DISTANCE_SCALE
End
Sub
'
Start the animation.
Private
Sub PlayImages()
Const
MS_PER_FRAME = 50
Const
SCALED_F = 16 / DISTANCE_SCALE
Dim
X As Single
Dim
Y As Single
Dim
hitx As Single
Dim
hity As Single
Dim
dhity As Single
Dim
not_hit As Boolean
Dim
vx As Single
Dim
vy As Single
Dim
dist As Single
Dim
next_time As Long
Dim
test_color As Long
' Get the initial velocity and position.
GetInitialVelocity vx, vy
' Start the point at the end of the cannon.
dist = Sqr(vx * vx + vy * vy)
X = vx / dist * CANNON_SCALE
Y = BitmapHgt + vy / dist * CANNON_SCALE
not_hit = True
next_time = GetTickCount()
Do
' Subtract the force of gravity from
the
' Y velocity component.
vy = vy + SCALED_F
' Restore the background.
SetBitmapBits picCanvas.Image,
BitmapNumBytes, Bytes(1, 1)
' See if we will hit the house.
If not_hit Then
dhity = vy / vx
hity = Y
For hitx = X To X + vx
' See if (hitx, hity) is a hit.
test_color =
picCanvas.Point(hitx, hity)
If (test_color > 0) And _
(test_color <>
picCanvas.BackColor) _
Then
not_hit = False
picCanvas.PaintPicture _
picHouseHit.Picture,
TargetX, _
picCanvas.ScaleHeight -
picHouseOk.ScaleHeight
DoEvents
' Save the new background.
SaveBackground
Beep
Exit For
End If
hity = hity + dhity
Next hitx
End If
' Calculate the next position.
X = X + vx
Y = Y + vy
' Draw the projectile.
picCanvas.PSet (X, Y), vbBlue
' Wait until it's time for the next
frame.
next_time = next_time + MS_PER_FRAME
WaitTill next_time
Loop While Y < BitmapHgt + 3
End
Sub
'
Start the animation.
Private
Sub cmdFire_Click()
DrawBackground
PlayImages
End
Sub
'
Move the target.
Private
Sub cmdReset_Click()
TargetX = picCanvas.ScaleWidth * (0.3 + Rnd
* 0.6)
DrawBackground
cmdFire.SetFocus
End
Sub
Private
Sub Form_Load()
Randomize
Show
picCanvas.AutoRedraw = True
picCanvas.ScaleMode = vbPixels
picCanvas.DrawWidth = 3
picCanvas.FillStyle = vbSolid
picCanvas.BackColor = &HC0C0C0
picHouseOk.ScaleMode = vbPixels
picHouseHit.ScaleMode = vbPixels
cmdReset_Click
End
Sub
'
Save the background bitmap data.
Private
Sub SaveBackground()
Dim
bm As BITMAP
GetObject picCanvas.Image, Len(bm), bm
BitmapWid = bm.bmWidthBytes
BitmapHgt = bm.bmHeight
BitmapNumBytes = BitmapWid * BitmapHgt
ReDim Bytes(1 To bm.bmWidthBytes, 1 To
bm.bmHeight)
GetBitmapBits picCanvas.Image,
BitmapNumBytes, Bytes(1, 1)
End
Sub
'
Draw the target and the cannon pointed in the
'
direction of the current angle.
Private
Sub DrawBackground()
Dim
vx As Single
Dim
vy As Single
Dim
dist As Single
Dim
bm As BITMAP
' Clear the canvas.
picCanvas.Line (0,
0)-(picCanvas.ScaleWidth, picCanvas.ScaleHeight), picCanvas.BackColor, BF
' Get the initial velocity components.
GetInitialVelocity vx, vy
' Draw the target.
picCanvas.PaintPicture _
picHouseOk.Picture, TargetX, _
picCanvas.ScaleHeight -
picHouseOk.ScaleHeight
' Draw the cannon.
dist = Sqr(vx * vx + vy * vy)
vx = vx / dist
vy = vy / dist
picCanvas.Line (0,
picCanvas.ScaleHeight)-Step(vx * CANNON_SCALE, vy * CANNON_SCALE), vbBlack
' Save the background bitmap data.
SaveBackground
End
Sub
Private
Sub txtAngle_Change()
DrawBackground
End
Sub
WaitTill.bas
Option
Explicit
Declare
Function GetTickCount Lib "kernel32" () As Long
'
Pause until GetTickCount shows the indicated
'
time. This is accurate to within one clock tick
'
(55 ms), not counting variability in DoEvents
'
and Windows itself.
Public
Sub WaitTill(next_time As Long)
Do
DoEvents
Loop While GetTickCount() < next_time
End
Sub
