You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
279 lines
14 KiB
279 lines
14 KiB
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
END
|
|
Attribute VB_Name = "ssSprite"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
'-----------------------------------------------------------------
|
|
' Public Variables
|
|
'-----------------------------------------------------------------
|
|
Public Index As Long ' Global array index value
|
|
Public idxMin As Long ' Minimum sprite frame index value
|
|
Public idxMax As Long ' Maximum sprite frame index value
|
|
Public xUnits As Long ' # of horizontal sprite frames
|
|
Public yUnits As Long ' # of virtical sprite frames
|
|
Public uWidth As Long ' sprite frame width in pixels
|
|
Public uHeight As Long ' sprite frame height in pixels
|
|
Public DestHDC As Long ' destination window hdc
|
|
Public hBitmap As Long ' handle to animation bitmap
|
|
Public hDisplayBack As Long ' handle to background bitmap
|
|
Public TRACERS As Boolean ' use tracers flag
|
|
Public MASKCOLOR As Long ' transparency blt color mask
|
|
Public SprtH As Long ' animation bitmap height in pixels
|
|
Public SprtW As Long ' animation bitmap width in pixels
|
|
Public Mass As Long ' sprite mass(virtual)
|
|
|
|
'-----------------------------------------------------------------
|
|
' AutoMove Programmable Variables
|
|
'-----------------------------------------------------------------
|
|
Public x As Long ' sprite's current screen x coordinate
|
|
Public y As Long ' sprite's current screen y coordinate
|
|
Public BdrX As Long ' border width
|
|
Public BdrY As Long ' border height
|
|
Public Dx As Long ' current x velosity
|
|
Public Dy As Long ' current y velosity
|
|
Public DDx As Long ' current x acceleration (= 1 not currently used)
|
|
Public DDy As Long ' current Y acceleration (= 1 not currently used)
|
|
Public ScreenW As Long ' width of screen
|
|
Public ScreenH As Long ' height of screen
|
|
Public bmpIdx As Long ' current animated bitmap frame index
|
|
|
|
'-----------------------------------------------------------------
|
|
' Private Variables
|
|
'-----------------------------------------------------------------
|
|
Private LastX As Long ' previous x coordinate
|
|
Private LastY As Long ' previous y coordinate
|
|
|
|
'-----------------------------------------------------------------
|
|
Public Function CollisionTest(Sprite As ssSprite) As Boolean
|
|
'-----------------------------------------------------------------
|
|
Dim l1 As Long, r1 As Long, t1 As Long, b1 As Long ' left, right, top, bottom... positions of sprite
|
|
Dim l2 As Long, r2 As Long, t2 As Long, b2 As Long ' left, right, top, bottom... positions of sprite
|
|
'-----------------------------------------------------------------
|
|
If (Sprite Is Me) Then Exit Function ' don't compare sprite with itself
|
|
|
|
With Me ' current sprite
|
|
l1 = .x
|
|
t1 = .y
|
|
r1 = l1 + .uWidth
|
|
b1 = t1 + .uHeight
|
|
End With
|
|
With Sprite ' other sprite
|
|
l2 = .x
|
|
t2 = .y
|
|
r2 = l2 + .uWidth
|
|
b2 = t2 + .uHeight
|
|
End With
|
|
|
|
' Test for sprite collision
|
|
CollisionTest = (((l2 <= l1) And (l1 <= r2)) Or _
|
|
((l2 <= r1) And (r1 <= r2))) And _
|
|
(((t2 <= t1) And (t1 <= b2)) Or _
|
|
((t2 <= b1) And (b1 <= b2)))
|
|
'-----------------------------------------------------------------
|
|
End Function
|
|
'-----------------------------------------------------------------
|
|
|
|
'-----------------------------------------------------------------
|
|
Private Function Atn2(y As Double, x As Double) As Double
|
|
'-----------------------------------------------------------------
|
|
'- VB implementation of the C runtime ATan2(x,y) function...
|
|
'-----------------------------------------------------------------
|
|
If (x <> 0) Then ' Prevent divide by zero
|
|
Atn2 = Atn(y / x) ' Atan2(y,x) = Atn(y/x) when x <> 0
|
|
Else ' Handle special case
|
|
Atn2 = 2 * Atn(Sgn(y)) ' as N ~> infinity Atn(N) ~> (sign(N)*PI/2) = 2 * Atn(Sgn(y))
|
|
End If
|
|
'-----------------------------------------------------------------
|
|
End Function
|
|
'-----------------------------------------------------------------
|
|
|
|
'-----------------------------------------------------------------
|
|
Public Function ResolveCollision() As Boolean
|
|
'-----------------------------------------------------------------
|
|
''' Dim Sprite As ssSprite
|
|
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
|
|
Dim a As Double, cos_a As Double, sin_a As Double
|
|
Dim vn1 As Double, vn2 As Double, vp1 As Double, vp2 As Double
|
|
Dim vx1 As Long, vx2 As Long, vy1 As Long, vy2 As Long
|
|
Dim m1 As Double, m2 As Double, k As Double, e As Double
|
|
Dim vn2p1 As Double, vn2p2 As Double, temp1 As Double
|
|
Dim Idx As Integer, First As Integer, Last As Integer
|
|
'-----------------------------------------------------------------
|
|
''' For Each Sprite In gSpriteCollection ' For each sprite check for...
|
|
First = Me.Index + 1
|
|
Last = UBound(gSSprite)
|
|
|
|
For Idx = First To Last
|
|
''' Set Sprite = gSprite(Idx)
|
|
''' If CollisionTest(Sprite) Then ' Check for Collision
|
|
If CollisionTest(gSSprite(Idx)) Then ' Check for Collision
|
|
With gSSprite(Idx)
|
|
' Compute the coordinates of the centers of the objects.
|
|
x1 = Me.x + (Me.uWidth \ 2)
|
|
y1 = Me.y + (Me.uHeight \ 2)
|
|
x2 = .x + (.uWidth \ 2)
|
|
y2 = .y + (.uHeight \ 2)
|
|
|
|
' Compute the angle of the line joining the centers.
|
|
' a = atan2((double)(y2 - y1), (double)(x2 - x1)) (C implementation)
|
|
a = Atn2((y2 - y1), (x2 - x1)) ' (VB implementation)
|
|
cos_a = Cos(a)
|
|
sin_a = Sin(a)
|
|
|
|
' Compute the velocities normal and perpendicular
|
|
' to the center line.
|
|
vx1 = Me.Dx: vy1 = Me.Dy
|
|
vx2 = .Dx: vy2 = .Dy
|
|
vn1 = (vx1 * cos_a) + (vy1 * sin_a)
|
|
vp1 = (vy1 * cos_a) - (vx1 * sin_a)
|
|
|
|
vn2 = (vx2 * cos_a) + (vy2 * sin_a)
|
|
vp2 = (vy2 * cos_a) - (vx2 * sin_a)
|
|
|
|
' Compute the momentum along the center line.
|
|
m1 = Me.Mass
|
|
m2 = .Mass
|
|
k = (m1 * vn1) + (m2 * vn2)
|
|
|
|
' Compute the energy.
|
|
e = 0.5 * ((m1 * vn1 ^ 2) + (m2 * vn2 ^ 2))
|
|
|
|
' There are two possible solutions to the equations.
|
|
' Compute both and choose.
|
|
' <<<***Convert to long to fix Floating Point Error Bug.***>>>
|
|
temp1 = Sqr(Fix(k ^ 2 - ((m1 / m2) + 1) * (-2 * e * m1 + k ^ 2)))
|
|
vn2p1 = (k + temp1) / (m1 + m2)
|
|
vn2p2 = (k - temp1) / (m1 + m2)
|
|
|
|
' Choose the solution that is not the current state.
|
|
If (vn2p1 = vn2) Then
|
|
vn2 = vn2p2
|
|
Else
|
|
vn2 = vn2p1
|
|
End If
|
|
|
|
' Compute the new vn1 value.
|
|
vn1 = (k - m2 * vn2) / m1
|
|
|
|
' Compute the new x and y velocities.
|
|
vx1 = (vn1 * cos_a) - (vp1 * sin_a)
|
|
vy1 = (vn1 * sin_a) + (vp1 * cos_a)
|
|
vx2 = (vn2 * cos_a) - (vp2 * sin_a)
|
|
vy2 = (vn2 * sin_a) + (vp2 * cos_a)
|
|
|
|
Me.Dx = vx1 ' Save new change in x velosity
|
|
Me.Dy = vy1 ' Save new change in Y velosity
|
|
.Dx = vx2 ' Save new change in x velosity
|
|
.Dy = vy2 ' Save new change in Y velosity
|
|
|
|
' Move the sprites until they are no longer in collision.
|
|
If ((vx1 <> 0) Or (vy1 <> 0) Or (vx2 <> 0) Or (vy2 <> 0)) Then
|
|
''' Do While CollisionTest(Sprite)
|
|
Do While CollisionTest(gSSprite(Idx))
|
|
If ((Dx <> 0) Or (Dy <> 0)) Then ' if 0 then update wont matter
|
|
UpdatePosition ' Move sprite out of the way
|
|
ElseIf ((.Dx <> 0) Or (.Dy <> 0)) Then ' if 0 then update wont matter
|
|
.UpdatePosition ' Move sprite out of the way
|
|
Else
|
|
Exit Do ' Exit to avoid dead lock(infinite loop)
|
|
End If
|
|
Loop
|
|
End If
|
|
ResolveCollision = True ' Return success
|
|
End With
|
|
End If
|
|
Next
|
|
'-----------------------------------------------------------------
|
|
End Function
|
|
'-----------------------------------------------------------------
|
|
|
|
'-----------------------------------------------------------------
|
|
Public Sub UpdatePosition()
|
|
'-----------------------------------------------------------------
|
|
x = x + Dx ' Update x position
|
|
y = y + Dy ' Update y position
|
|
|
|
If (x < 0) Then Dx = Abs(Dx) ' reverse direction when hitting a border.
|
|
If (x > BdrX) Then Dx = -1 * Abs(Dx)
|
|
If (y < 0) Then Dy = Abs(Dy)
|
|
If (y > BdrY) Then Dy = -1 * Abs(Dy)
|
|
|
|
Dx = Dx * DDx ' acceleration sprite x velocity
|
|
Dy = Dy * DDy ' acceleration sprite y velocity
|
|
'-----------------------------------------------------------------
|
|
End Sub
|
|
'-----------------------------------------------------------------
|
|
|
|
'-----------------------------------------------------------------
|
|
Public Sub AutoMove()
|
|
'-----------------------------------------------------------------
|
|
DrawNext x, y ' Move sprite to next coordinate
|
|
If Not ResolveCollision Then UpdatePosition ' Check for collision or update current position
|
|
'-----------------------------------------------------------------
|
|
End Sub
|
|
'-----------------------------------------------------------------
|
|
|
|
'-----------------------------------------------------------------
|
|
Public Sub DrawNext(PosX As Long, PosY As Long)
|
|
'-----------------------------------------------------------------
|
|
Dim rc As Long
|
|
Dim x As Long, y As Long ' Source indexed bmp coordinates...
|
|
Dim x1 As Long, y1 As Long, w1 As Long, h1 As Long ' Repaint Rectangle # 1 screen coordinates
|
|
Dim x2 As Long, y2 As Long, w2 As Long, h2 As Long ' Repaint Rectangle # 2 screen coordinates
|
|
'-----------------------------------------------------------------
|
|
x = CLng((bmpIdx Mod xUnits) * (SprtW / xUnits)) ' Get next indexed bmp x coordinate
|
|
y = CLng((bmpIdx \ xUnits) * (SprtH / yUnits)) ' Get next indexed bmp y coordinate
|
|
|
|
If (TRACERS) Then ' Tracers? don't clean up previous blt
|
|
DrawTransparentBitmap DestHDC, hBitmap, MASKCOLOR, PosX, PosY, uWidth, uHeight, x, y
|
|
Else ' Clean up & calculate unused sprite space
|
|
Select Case PosX
|
|
Case Is < LastX ' PosX <=== LastX
|
|
x1 = PosX + uWidth: w1 = LastX - PosX
|
|
x2 = LastX: w2 = uWidth
|
|
Case LastX ' PosX ==== LastX
|
|
x2 = LastX: w2 = uWidth
|
|
Case Is > LastX ' PosX ===> LastX
|
|
x1 = LastX: w1 = PosX - LastX
|
|
x2 = LastX: w2 = uWidth
|
|
End Select
|
|
|
|
Select Case PosY
|
|
Case Is < LastY ' PosY <=== LastY
|
|
y1 = LastY: h1 = uHeight - (LastY - PosY)
|
|
y2 = PosY + uHeight: h2 = uHeight - h1
|
|
Case LastY ' PosY ==== LastY
|
|
y1 = LastY: h1 = uHeight
|
|
Case Is > LastY ' PosY ===> LastY
|
|
y1 = PosY: h1 = uHeight - (PosY - LastY)
|
|
y2 = LastY: h2 = uHeight - h1
|
|
End Select
|
|
|
|
' paint sprite in new position...
|
|
DrawTransparentBitmap DestHDC, hBitmap, MASKCOLOR, PosX, PosY, uWidth, uHeight, x, y, hDisplayBack
|
|
|
|
If ((LastX <> PosX) Or (LastY <> PosY)) Then ' If sprite has moved...
|
|
' Repaint previous unoccupied positions...
|
|
If ((w1 > 0) And (h1 > 0)) Then BitBlt DestHDC, x1, y1, w1, h1, hDisplayBack, x1, y1, vbSrcCopy
|
|
If ((w2 > 0) And (h2 > 0)) Then BitBlt DestHDC, x2, y2, w2, h2, hDisplayBack, x2, y2, vbSrcCopy
|
|
End If
|
|
End If
|
|
|
|
LastX = PosX ' Save previous x position
|
|
LastY = PosY ' Save previous y position
|
|
|
|
If (bmpIdx < idxMax) Then ' Increment bitmap frame index
|
|
bmpIdx = bmpIdx + 1
|
|
Else ' Reset to beginning
|
|
bmpIdx = idxMin
|
|
End If
|
|
'-----------------------------------------------------------------
|
|
End Sub
|
|
'-----------------------------------------------------------------
|