home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Visual Basic.60 / COMMON / TOOLS / VB / UNSUPPRT / SSAVER / SSSPRITE.CLS < prev   
Encoding:
Visual Basic class definition  |  1997-01-16  |  14.5 KB  |  279 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ssSprite"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. '-----------------------------------------------------------------
  13. ' Public Variables
  14. '-----------------------------------------------------------------
  15. Public Index As Long                                ' Global array index value
  16. Public idxMin As Long                               ' Minimum sprite frame index value
  17. Public idxMax As Long                               ' Maximum sprite frame index value
  18. Public xUnits As Long                               ' # of horizontal sprite frames
  19. Public yUnits As Long                               ' # of virtical sprite frames
  20. Public uWidth As Long                               ' sprite frame width in pixels
  21. Public uHeight As Long                              ' sprite frame height in pixels
  22. Public DestHDC  As Long                             ' destination window hdc
  23. Public hBitmap As Long                              ' handle to animation bitmap
  24. Public hDisplayBack As Long                         ' handle to background bitmap
  25. Public TRACERS As Boolean                           ' use tracers flag
  26. Public MASKCOLOR As Long                            ' transparency blt color mask
  27. Public SprtH As Long                                ' animation bitmap height in pixels
  28. Public SprtW As Long                                ' animation bitmap width in pixels
  29. Public Mass As Long                                 ' sprite mass(virtual)
  30.  
  31. '-----------------------------------------------------------------
  32. ' AutoMove Programmable Variables
  33. '-----------------------------------------------------------------
  34. Public x As Long                                    ' sprite's current screen x coordinate
  35. Public y As Long                                    ' sprite's current screen y coordinate
  36. Public BdrX As Long                                 ' border width
  37. Public BdrY As Long                                 ' border height
  38. Public Dx As Long                                   ' current x velosity
  39. Public Dy As Long                                   ' current y velosity
  40. Public DDx As Long                                  ' current x acceleration (= 1 not currently used)
  41. Public DDy As Long                                  ' current Y acceleration (= 1 not currently used)
  42. Public ScreenW As Long                              ' width of screen
  43. Public ScreenH As Long                              ' height of screen
  44. Public bmpIdx As Long                               ' current animated bitmap frame index
  45.  
  46. '-----------------------------------------------------------------
  47. ' Private Variables
  48. '-----------------------------------------------------------------
  49. Private LastX As Long                               ' previous x coordinate
  50. Private LastY As Long                               ' previous y coordinate
  51.  
  52. '-----------------------------------------------------------------
  53. Public Function CollisionTest(Sprite As ssSprite) As Boolean
  54. '-----------------------------------------------------------------
  55.     Dim l1 As Long, r1 As Long, t1 As Long, b1 As Long ' left, right, top, bottom... positions of sprite
  56.     Dim l2 As Long, r2 As Long, t2 As Long, b2 As Long ' left, right, top, bottom... positions of sprite
  57. '-----------------------------------------------------------------
  58.     If (Sprite Is Me) Then Exit Function            ' don't compare sprite with itself
  59.         
  60.     With Me                                         ' current sprite
  61.         l1 = .x
  62.         t1 = .y
  63.         r1 = l1 + .uWidth
  64.         b1 = t1 + .uHeight
  65.     End With
  66.     With Sprite                                     ' other sprite
  67.         l2 = .x
  68.         t2 = .y
  69.         r2 = l2 + .uWidth
  70.         b2 = t2 + .uHeight
  71.     End With
  72.     
  73.     ' Test for sprite collision
  74.     CollisionTest = (((l2 <= l1) And (l1 <= r2)) Or _
  75.                      ((l2 <= r1) And (r1 <= r2))) And _
  76.                     (((t2 <= t1) And (t1 <= b2)) Or _
  77.                      ((t2 <= b1) And (b1 <= b2)))
  78. '-----------------------------------------------------------------
  79. End Function
  80. '-----------------------------------------------------------------
  81.  
  82. '-----------------------------------------------------------------
  83. Private Function Atn2(y As Double, x As Double) As Double
  84. '-----------------------------------------------------------------
  85. '-  VB implementation of the C runtime ATan2(x,y) function...
  86. '-----------------------------------------------------------------
  87.     If (x <> 0) Then                    ' Prevent divide by zero
  88.         Atn2 = Atn(y / x)               ' Atan2(y,x) = Atn(y/x) when x <> 0
  89.     Else                                ' Handle special case
  90.         Atn2 = 2 * Atn(Sgn(y))          ' as N ~> infinity Atn(N) ~> (sign(N)*PI/2) = 2 * Atn(Sgn(y))
  91.     End If
  92. '-----------------------------------------------------------------
  93. End Function
  94. '-----------------------------------------------------------------
  95.  
  96. '-----------------------------------------------------------------
  97. Public Function ResolveCollision() As Boolean
  98. '-----------------------------------------------------------------
  99. '''    Dim Sprite As ssSprite
  100.     Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
  101.     Dim a As Double, cos_a As Double, sin_a As Double
  102.     Dim vn1 As Double, vn2 As Double, vp1 As Double, vp2 As Double
  103.     Dim vx1 As Long, vx2 As Long, vy1 As Long, vy2 As Long
  104.     Dim m1 As Double, m2 As Double, k As Double, e As Double
  105.     Dim vn2p1 As Double, vn2p2 As Double, temp1 As Double
  106.     Dim Idx As Integer, First As Integer, Last As Integer
  107. '-----------------------------------------------------------------
  108. '''    For Each Sprite In gSpriteCollection    ' For each sprite check for...
  109.     First = Me.Index + 1
  110.     Last = UBound(gSSprite)
  111.     
  112.     For Idx = First To Last
  113. '''        Set Sprite = gSprite(Idx)
  114. '''        If CollisionTest(Sprite) Then       ' Check for Collision
  115.         If CollisionTest(gSSprite(Idx)) Then     ' Check for Collision
  116.             With gSSprite(Idx)
  117.                 ' Compute the coordinates of the centers of the objects.
  118.                 x1 = Me.x + (Me.uWidth \ 2)
  119.                 y1 = Me.y + (Me.uHeight \ 2)
  120.                 x2 = .x + (.uWidth \ 2)
  121.                 y2 = .y + (.uHeight \ 2)
  122.             
  123.                 ' Compute the angle of the line joining the centers.
  124.                 ' a = atan2((double)(y2 - y1), (double)(x2 - x1)) (C implementation)
  125.                 a = Atn2((y2 - y1), (x2 - x1))                 ' (VB implementation)
  126.                 cos_a = Cos(a)
  127.                 sin_a = Sin(a)
  128.             
  129.                 ' Compute the velocities normal and perpendicular
  130.                 ' to the center line.
  131.                 vx1 = Me.Dx:    vy1 = Me.Dy
  132.                 vx2 = .Dx:      vy2 = .Dy
  133.                 vn1 = (vx1 * cos_a) + (vy1 * sin_a)
  134.                 vp1 = (vy1 * cos_a) - (vx1 * sin_a)
  135.                 
  136.                 vn2 = (vx2 * cos_a) + (vy2 * sin_a)
  137.                 vp2 = (vy2 * cos_a) - (vx2 * sin_a)
  138.     
  139.                 ' Compute the momentum along the center line.
  140.                 m1 = Me.Mass
  141.                 m2 = .Mass
  142.                 k = (m1 * vn1) + (m2 * vn2)
  143.             
  144.                 ' Compute the energy.
  145.                 e = 0.5 * ((m1 * vn1 ^ 2) + (m2 * vn2 ^ 2))
  146.                 
  147.                 ' There are two possible solutions to the equations.
  148.                 ' Compute both and choose.
  149.                 ' <<<***Convert to long to fix Floating Point Error Bug.***>>>
  150.                 temp1 = Sqr(Fix(k ^ 2 - ((m1 / m2) + 1) * (-2 * e * m1 + k ^ 2)))
  151.                 vn2p1 = (k + temp1) / (m1 + m2)
  152.                 vn2p2 = (k - temp1) / (m1 + m2)
  153.             
  154.                 ' Choose the solution that is not the current state.
  155.                 If (vn2p1 = vn2) Then
  156.                     vn2 = vn2p2
  157.                 Else
  158.                     vn2 = vn2p1
  159.                 End If
  160.             
  161.                 ' Compute the new vn1 value.
  162.                 vn1 = (k - m2 * vn2) / m1
  163.                 
  164.                 ' Compute the new x and y velocities.
  165.                 vx1 = (vn1 * cos_a) - (vp1 * sin_a)
  166.                 vy1 = (vn1 * sin_a) + (vp1 * cos_a)
  167.                 vx2 = (vn2 * cos_a) - (vp2 * sin_a)
  168.                 vy2 = (vn2 * sin_a) + (vp2 * cos_a)
  169.             
  170.                 Me.Dx = vx1                                     ' Save new change in x velosity
  171.                 Me.Dy = vy1                                     ' Save new change in Y velosity
  172.                 .Dx = vx2                                       ' Save new change in x velosity
  173.                 .Dy = vy2                                       ' Save new change in Y velosity
  174.  
  175.                 ' Move the sprites until they are no longer in collision.
  176.                 If ((vx1 <> 0) Or (vy1 <> 0) Or (vx2 <> 0) Or (vy2 <> 0)) Then
  177. '''                    Do While CollisionTest(Sprite)
  178.                     Do While CollisionTest(gSSprite(Idx))
  179.                         If ((Dx <> 0) Or (Dy <> 0)) Then        ' if 0 then update wont matter
  180.                             UpdatePosition                      ' Move sprite out of the way
  181.                         ElseIf ((.Dx <> 0) Or (.Dy <> 0)) Then  ' if 0 then update wont matter
  182.                             .UpdatePosition                     ' Move sprite out of the way
  183.                         Else
  184.                             Exit Do                             ' Exit to avoid dead lock(infinite loop)
  185.                         End If
  186.                     Loop
  187.                 End If
  188.                 ResolveCollision = True                         ' Return success
  189.             End With
  190.         End If
  191.     Next
  192. '-----------------------------------------------------------------
  193. End Function
  194. '-----------------------------------------------------------------
  195.  
  196. '-----------------------------------------------------------------
  197. Public Sub UpdatePosition()
  198. '-----------------------------------------------------------------
  199.     x = x + Dx                                          ' Update x position
  200.     y = y + Dy                                          ' Update y position
  201.     
  202.     If (x < 0) Then Dx = Abs(Dx)                        ' reverse direction when hitting a border.
  203.     If (x > BdrX) Then Dx = -1 * Abs(Dx)
  204.     If (y < 0) Then Dy = Abs(Dy)
  205.     If (y > BdrY) Then Dy = -1 * Abs(Dy)
  206.     
  207.     Dx = Dx * DDx                                       ' acceleration sprite x velocity
  208.     Dy = Dy * DDy                                       ' acceleration sprite y velocity
  209. '-----------------------------------------------------------------
  210. End Sub
  211. '-----------------------------------------------------------------
  212.  
  213. '-----------------------------------------------------------------
  214. Public Sub AutoMove()
  215. '-----------------------------------------------------------------
  216.     DrawNext x, y                                       ' Move sprite to next coordinate
  217.     If Not ResolveCollision Then UpdatePosition         ' Check for collision or update current position
  218. '-----------------------------------------------------------------
  219. End Sub
  220. '-----------------------------------------------------------------
  221.  
  222. '-----------------------------------------------------------------
  223. Public Sub DrawNext(PosX As Long, PosY As Long)
  224. '-----------------------------------------------------------------
  225.     Dim rc As Long
  226.     Dim x As Long, y As Long                            ' Source indexed bmp coordinates...
  227.     Dim x1 As Long, y1 As Long, w1 As Long, h1 As Long  ' Repaint Rectangle # 1 screen coordinates
  228.     Dim x2 As Long, y2 As Long, w2 As Long, h2 As Long  ' Repaint Rectangle # 2 screen coordinates
  229. '-----------------------------------------------------------------
  230.     x = CLng((bmpIdx Mod xUnits) * (SprtW / xUnits))    ' Get next indexed bmp x coordinate
  231.     y = CLng((bmpIdx \ xUnits) * (SprtH / yUnits))      ' Get next indexed bmp y coordinate
  232.     
  233.     If (TRACERS) Then                                   ' Tracers? don't clean up previous blt
  234.         DrawTransparentBitmap DestHDC, hBitmap, MASKCOLOR, PosX, PosY, uWidth, uHeight, x, y
  235.     Else                                                ' Clean up & calculate unused sprite space
  236.         Select Case PosX
  237.         Case Is < LastX                                                     ' PosX <=== LastX
  238.             x1 = PosX + uWidth:     w1 = LastX - PosX
  239.             x2 = LastX:             w2 = uWidth
  240.         Case LastX                                                          ' PosX ==== LastX
  241.             x2 = LastX:             w2 = uWidth
  242.         Case Is > LastX                                                     ' PosX ===> LastX
  243.             x1 = LastX:             w1 = PosX - LastX
  244.             x2 = LastX:             w2 = uWidth
  245.         End Select
  246.         
  247.         Select Case PosY
  248.         Case Is < LastY                                                     ' PosY <=== LastY
  249.             y1 = LastY:             h1 = uHeight - (LastY - PosY)
  250.             y2 = PosY + uHeight:    h2 = uHeight - h1
  251.         Case LastY                                                          ' PosY ==== LastY
  252.             y1 = LastY:             h1 = uHeight
  253.         Case Is > LastY                                                     ' PosY ===> LastY
  254.             y1 = PosY:              h1 = uHeight - (PosY - LastY)
  255.             y2 = LastY:             h2 = uHeight - h1
  256.         End Select
  257.     
  258.         ' paint sprite in new position...
  259.         DrawTransparentBitmap DestHDC, hBitmap, MASKCOLOR, PosX, PosY, uWidth, uHeight, x, y, hDisplayBack
  260.     
  261.         If ((LastX <> PosX) Or (LastY <> PosY)) Then ' If sprite has moved...
  262.             ' Repaint previous unoccupied positions...
  263.             If ((w1 > 0) And (h1 > 0)) Then BitBlt DestHDC, x1, y1, w1, h1, hDisplayBack, x1, y1, vbSrcCopy
  264.             If ((w2 > 0) And (h2 > 0)) Then BitBlt DestHDC, x2, y2, w2, h2, hDisplayBack, x2, y2, vbSrcCopy
  265.         End If
  266.     End If
  267.     
  268.     LastX = PosX                                        ' Save previous x position
  269.     LastY = PosY                                        ' Save previous y position
  270.     
  271.     If (bmpIdx < idxMax) Then                           ' Increment bitmap frame index
  272.         bmpIdx = bmpIdx + 1
  273.     Else                                                ' Reset to beginning
  274.         bmpIdx = idxMin
  275.     End If
  276. '-----------------------------------------------------------------
  277. End Sub
  278. '-----------------------------------------------------------------
  279.