API tools faq
paste
Advertisement
MirageGaming

vbGore Particle Effects

MirageGaming
Oct 30th, 2022
2,004
1
Never
1
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VBScript 64.77 KB | None | 1 0
raw download clone embed print report
  1. Option Explicit
  2. Private Type Effect
  3.     X As Single                 'Location of effect
  4.    Y As Single
  5.     GoToX As Single             'Location to move to
  6.    GoToY As Single
  7.     KillWhenAtTarget As Boolean     'If the effect is at its target (GoToX/Y), then Progression is set to 0
  8.    KillWhenTargetLost As Boolean   'Kill the effect if the target is lost (sets progression = 0)
  9.    Gfx As Byte                 'Particle texture used
  10.    Used As Boolean             'If the effect is in use
  11.    EffectNum As Byte           'What number of effect that is used
  12.    Modifier As Integer         'Misc variable (depends on the effect)
  13.    FloatSize As Long           'The size of the particles
  14.    Direction As Integer        'Misc variable (depends on the effect)
  15.    Particles() As Particle     'Information on each particle
  16.    Progression As Single       'Progression state, best to design where 0 = effect ends
  17.    PartVertex() As TLVERTEX    'Used to point render particles
  18.    PreviousFrame As Long       'Tick time of the last frame
  19.    ParticleCount As Integer    'Number of particles total
  20.    ParticlesLeft As Integer    'Number of particles left - only for non-repetitive effects
  21.    BindToChar As Integer       'Setting this value will bind the effect to move towards the character
  22.    BindSpeed As Single         'How fast the effect moves towards the character
  23.    BoundToMap As Byte          'If the effect is bound to the map or not (used only by the map editor)
  24. End Type
  25. Public NumEffects As Byte   'Maximum number of effects at once
  26. Public Effect() As Effect   'List of all the active effects
  27.  
  28. 'Constants With The Order Number For Each Effect
  29. Public Const EffectNum_Fire As Byte = 1             'Burn baby, burn! Flame from a central point that blows in a specified direction
  30. Public Const EffectNum_Snow As Byte = 2             'Snow that covers the screen - weather effect
  31. Public Const EffectNum_Heal As Byte = 3             'Healing effect that can bind to a character, ankhs float up and fade
  32. Public Const EffectNum_Bless As Byte = 4            'Following three effects are same: create a circle around the central point
  33. Public Const EffectNum_Protection As Byte = 5       ' (often the character) and makes the given particle on the perimeter
  34. Public Const EffectNum_Strengthen As Byte = 6       ' which float up and fade out
  35. Public Const EffectNum_Rain As Byte = 7             'Exact same as snow, but moves much faster and more alpha value - weather effect
  36. Public Const EffectNum_EquationTemplate As Byte = 8 'Template for creating particle effects through equations - a page with some equations can be found here: http://www.vbgore.com/modules.php?name=Forums&file=viewtopic&t=221
  37. Public Const EffectNum_Waterfall As Byte = 9        'Waterfall effect
  38. Public Const EffectNum_Summon As Byte = 10          'Summon effect
  39.  
  40. Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)
  41.  
  42. Function Effect_EquationTemplate_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer, Optional ByVal Progression As Single = 1) As Integer
  43. '*****************************************************************
  44. 'Particle effect template for effects as described on the
  45. 'wiki page: http://www.vbgore.com/Particle_effect_equations
  46. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_EquationTemplate_Begin
  47. '*****************************************************************
  48. Dim EffectIndex As Integer
  49. Dim LoopC As Long
  50.  
  51.     'Get the next open effect slot
  52.    EffectIndex = Effect_NextOpenSlot
  53.     If EffectIndex = -1 Then Exit Function
  54.  
  55.     'Return the index of the used slot
  56.    Effect_EquationTemplate_Begin = EffectIndex
  57.  
  58.     'Set The Effect's Variables
  59.    Effect(EffectIndex).EffectNum = EffectNum_EquationTemplate  'Set the effect number
  60.    Effect(EffectIndex).ParticleCount = Particles       'Set the number of particles
  61.    Effect(EffectIndex).Used = True                     'Enable the effect
  62.    Effect(EffectIndex).X = X                           'Set the effect's X coordinate
  63.    Effect(EffectIndex).Y = Y                           'Set the effect's Y coordinate
  64.    Effect(EffectIndex).Gfx = Gfx                       'Set the graphic
  65.    Effect(EffectIndex).Progression = Progression       'If we loop the effect
  66.  
  67.     'Set the number of particles left to the total avaliable
  68.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  69.  
  70.     'Set the float variables
  71.    Effect(EffectIndex).FloatSize = Effect_FToDW(8)    'Size of the particles
  72.  
  73.     'Redim the number of particles
  74.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  75.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  76.  
  77.     'Create the particles
  78.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  79.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  80.         Effect(EffectIndex).Particles(LoopC).Used = True
  81.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  82.         Effect_EquationTemplate_Reset EffectIndex, LoopC
  83.     Next LoopC
  84.  
  85.     'Set The Initial Time
  86.    Effect(EffectIndex).PreviousFrame = timeGetTime
  87.  
  88. End Function
  89.  
  90. Private Sub Effect_EquationTemplate_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)
  91. '*****************************************************************
  92. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_EquationTemplate_Reset
  93. '*****************************************************************
  94. Dim X As Single
  95. Dim Y As Single
  96. Dim R As Single
  97.    
  98.     Effect(EffectIndex).Progression = Effect(EffectIndex).Progression + 0.1
  99.     R = (Index / 20) * EXP(Index / Effect(EffectIndex).Progression Mod 3)
  100.     X = R * Cos(Index)
  101.     Y = R * Sin(Index)
  102.    
  103.     'Reset the particle
  104.    Effect(EffectIndex).Particles(Index).ResetIt Effect(EffectIndex).X + X, Effect(EffectIndex).Y + Y, 0, 0, 0, 0
  105.     Effect(EffectIndex).Particles(Index).ResetColor 1, 1, 1, 1, 0.2 + (Rnd * 0.2)
  106.  
  107. End Sub
  108.  
  109. Private Sub Effect_EquationTemplate_Update(ByVal EffectIndex As Integer)
  110. '*****************************************************************
  111. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_EquationTemplate_Update
  112. '*****************************************************************
  113. Dim ElapsedTime As Single
  114. Dim LoopC As Long
  115.  
  116.     'Calculate The Time Difference
  117.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  118.     Effect(EffectIndex).PreviousFrame = timeGetTime
  119.  
  120.     'Go Through The Particle Loop
  121.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  122.  
  123.         'Check If Particle Is In Use
  124.        If Effect(EffectIndex).Particles(LoopC).Used Then
  125.  
  126.             'Update The Particle
  127.            Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
  128.  
  129.             'Check if the particle is ready to die
  130.            If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
  131.  
  132.                 'Check if the effect is ending
  133.                If Effect(EffectIndex).Progression > 0 Then
  134.  
  135.                     'Reset the particle
  136.                    Effect_EquationTemplate_Reset EffectIndex, LoopC
  137.  
  138.                 Else
  139.  
  140.                     'Disable the particle
  141.                    Effect(EffectIndex).Particles(LoopC).Used = False
  142.  
  143.                     'Subtract from the total particle count
  144.                    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
  145.  
  146.                     'Check if the effect is out of particles
  147.                    If Effect(EffectIndex).ParticlesLeft = 0 Then Effect(EffectIndex).Used = False
  148.  
  149.                     'Clear the color (dont leave behind any artifacts)
  150.                    Effect(EffectIndex).PartVertex(LoopC).Color = 0
  151.  
  152.                 End If
  153.  
  154.             Else
  155.  
  156.                 'Set the particle information on the particle vertex
  157.                Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
  158.                 Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
  159.                 Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
  160.  
  161.             End If
  162.  
  163.         End If
  164.  
  165.     Next LoopC
  166.  
  167. End Sub
  168.  
  169. Function Effect_Bless_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer, Optional ByVal Size As Byte = 30, Optional ByVal Time As Single = 10) As Integer
  170. '*****************************************************************
  171. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Bless_Begin
  172. '*****************************************************************
  173. Dim EffectIndex As Integer
  174. Dim LoopC As Long
  175.  
  176.     'Get the next open effect slot
  177.    EffectIndex = Effect_NextOpenSlot
  178.     If EffectIndex = -1 Then Exit Function
  179.  
  180.     'Return the index of the used slot
  181.    Effect_Bless_Begin = EffectIndex
  182.  
  183.     'Set The Effect's Variables
  184.    Effect(EffectIndex).EffectNum = EffectNum_Bless     'Set the effect number
  185.    Effect(EffectIndex).ParticleCount = Particles       'Set the number of particles
  186.    Effect(EffectIndex).Used = True             'Enabled the effect
  187.    Effect(EffectIndex).X = X                   'Set the effect's X coordinate
  188.    Effect(EffectIndex).Y = Y                   'Set the effect's Y coordinate
  189.    Effect(EffectIndex).Gfx = Gfx               'Set the graphic
  190.    Effect(EffectIndex).Modifier = Size         'How large the circle is
  191.    Effect(EffectIndex).Progression = Time      'How long the effect will last
  192.  
  193.     'Set the number of particles left to the total avaliable
  194.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  195.  
  196.     'Set the float variables
  197.    Effect(EffectIndex).FloatSize = Effect_FToDW(20)    'Size of the particles
  198.  
  199.     'Redim the number of particles
  200.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  201.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  202.  
  203.     'Create the particles
  204.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  205.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  206.         Effect(EffectIndex).Particles(LoopC).Used = True
  207.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  208.         Effect_Bless_Reset EffectIndex, LoopC
  209.     Next LoopC
  210.  
  211.     'Set The Initial Time
  212.    Effect(EffectIndex).PreviousFrame = timeGetTime
  213.  
  214. End Function
  215.  
  216. Private Sub Effect_Bless_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)
  217. '*****************************************************************
  218. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Bless_Reset
  219. '*****************************************************************
  220. Dim a As Single
  221. Dim X As Single
  222. Dim Y As Single
  223.  
  224.     'Get the positions
  225.    a = Rnd * 360 * DegreeToRadian
  226.     X = Effect(EffectIndex).X - (Sin(a) * Effect(EffectIndex).Modifier)
  227.     Y = Effect(EffectIndex).Y + (Cos(a) * Effect(EffectIndex).Modifier)
  228.  
  229.     'Reset the particle
  230.    Effect(EffectIndex).Particles(Index).ResetIt X, Y, 0, Rnd * -1, 0, -2
  231.     Effect(EffectIndex).Particles(Index).ResetColor 1, 1, 0.2, 0.6 + (Rnd * 0.4), 0.06 + (Rnd * 0.2)
  232.  
  233. End Sub
  234.  
  235. Private Sub Effect_Bless_Update(ByVal EffectIndex As Integer)
  236. '*****************************************************************
  237. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Bless_Update
  238. '*****************************************************************
  239. Dim ElapsedTime As Single
  240. Dim LoopC As Long
  241.  
  242.     'Calculate The Time Difference
  243.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  244.     Effect(EffectIndex).PreviousFrame = timeGetTime
  245.  
  246.     'Update the life span
  247.    If Effect(EffectIndex).Progression > 0 Then Effect(EffectIndex).Progression = Effect(EffectIndex).Progression - ElapsedTime
  248.  
  249.     'Go Through The Particle Loop
  250.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  251.  
  252.         'Check If Particle Is In Use
  253.        If Effect(EffectIndex).Particles(LoopC).Used Then
  254.  
  255.             'Update The Particle
  256.            Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
  257.  
  258.             'Check if the particle is ready to die
  259.            If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
  260.  
  261.                 'Check if the effect is ending
  262.                If Effect(EffectIndex).Progression > 0 Then
  263.  
  264.                     'Reset the particle
  265.                    Effect_Bless_Reset EffectIndex, LoopC
  266.  
  267.                 Else
  268.  
  269.                     'Disable the particle
  270.                    Effect(EffectIndex).Particles(LoopC).Used = False
  271.  
  272.                     'Subtract from the total particle count
  273.                    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
  274.  
  275.                     'Check if the effect is out of particles
  276.                    If Effect(EffectIndex).ParticlesLeft = 0 Then Effect(EffectIndex).Used = False
  277.  
  278.                     'Clear the color (dont leave behind any artifacts)
  279.                    Effect(EffectIndex).PartVertex(LoopC).Color = 0
  280.  
  281.                 End If
  282.  
  283.             Else
  284.  
  285.                 'Set the particle information on the particle vertex
  286.                Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
  287.                 Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
  288.                 Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
  289.  
  290.             End If
  291.  
  292.         End If
  293.  
  294.     Next LoopC
  295.  
  296. End Sub
  297.  
  298. Function Effect_Fire_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer, Optional ByVal Direction As Integer = 180, Optional ByVal Progression As Single = 1) As Integer
  299. '*****************************************************************
  300. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Fire_Begin
  301. '*****************************************************************
  302. Dim EffectIndex As Integer
  303. Dim LoopC As Long
  304.  
  305.     'Get the next open effect slot
  306.    EffectIndex = Effect_NextOpenSlot
  307.     If EffectIndex = -1 Then Exit Function
  308.  
  309.     'Return the index of the used slot
  310.    Effect_Fire_Begin = EffectIndex
  311.  
  312.     'Set The Effect's Variables
  313.    Effect(EffectIndex).EffectNum = EffectNum_Fire      'Set the effect number
  314.    Effect(EffectIndex).ParticleCount = Particles       'Set the number of particles
  315.    Effect(EffectIndex).Used = True     'Enabled the effect
  316.    Effect(EffectIndex).X = X           'Set the effect's X coordinate
  317.    Effect(EffectIndex).Y = Y           'Set the effect's Y coordinate
  318.    Effect(EffectIndex).Gfx = Gfx       'Set the graphic
  319.    Effect(EffectIndex).Direction = Direction       'The direction the effect is animat
  320.    Effect(EffectIndex).Progression = Progression   'Loop the effect
  321.  
  322.     'Set the number of particles left to the total avaliable
  323.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  324.  
  325.     'Set the float variables
  326.    Effect(EffectIndex).FloatSize = Effect_FToDW(15)    'Size of the particles
  327.  
  328.     'Redim the number of particles
  329.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  330.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  331.  
  332.     'Create the particles
  333.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  334.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  335.         Effect(EffectIndex).Particles(LoopC).Used = True
  336.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  337.         Effect_Fire_Reset EffectIndex, LoopC
  338.     Next LoopC
  339.  
  340.     'Set The Initial Time
  341.    Effect(EffectIndex).PreviousFrame = timeGetTime
  342.  
  343. End Function
  344.  
  345. Private Sub Effect_Fire_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)
  346. '*****************************************************************
  347. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Fire_Reset
  348. '*****************************************************************
  349.  
  350.     'Reset the particle
  351.    Effect(EffectIndex).Particles(Index).ResetIt Effect(EffectIndex).X - 10 + Rnd * 20, Effect(EffectIndex).Y - 10 + Rnd * 20, -Sin((Effect(EffectIndex).Direction + (Rnd * 70) - 35) * DegreeToRadian) * 8, Cos((Effect(EffectIndex).Direction + (Rnd * 70) - 35) * DegreeToRadian) * 8, 0, 0
  352.     Effect(EffectIndex).Particles(Index).ResetColor 1, 0.2, 0.2, 0.4 + (Rnd * 0.2), 0.03 + (Rnd * 0.07)
  353.  
  354. End Sub
  355.  
  356. Private Sub Effect_Fire_Update(ByVal EffectIndex As Integer)
  357. '*****************************************************************
  358. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Fire_Update
  359. '*****************************************************************
  360. Dim ElapsedTime As Single
  361. Dim LoopC As Long
  362.  
  363.     'Calculate The Time Difference
  364.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  365.     Effect(EffectIndex).PreviousFrame = timeGetTime
  366.  
  367.     'Go Through The Particle Loop
  368.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  369.  
  370.         'Check If Particle Is In Use
  371.        If Effect(EffectIndex).Particles(LoopC).Used Then
  372.  
  373.             'Update The Particle
  374.            Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
  375.  
  376.             'Check if the particle is ready to die
  377.            If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
  378.  
  379.                 'Check if the effect is ending
  380.                If Effect(EffectIndex).Progression <> 0 Then
  381.  
  382.                     'Reset the particle
  383.                    Effect_Fire_Reset EffectIndex, LoopC
  384.  
  385.                 Else
  386.  
  387.                     'Disable the particle
  388.                    Effect(EffectIndex).Particles(LoopC).Used = False
  389.  
  390.                     'Subtract from the total particle count
  391.                    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
  392.  
  393.                     'Check if the effect is out of particles
  394.                    If Effect(EffectIndex).ParticlesLeft = 0 Then Effect(EffectIndex).Used = False
  395.  
  396.                     'Clear the color (dont leave behind any artifacts)
  397.                    Effect(EffectIndex).PartVertex(LoopC).Color = 0
  398.  
  399.                 End If
  400.  
  401.             Else
  402.  
  403.                 'Set the particle information on the particle vertex
  404.                Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
  405.                 Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
  406.                 Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
  407.  
  408.             End If
  409.  
  410.         End If
  411.  
  412.     Next LoopC
  413.  
  414. End Sub
  415.  
  416. Private Function Effect_FToDW(F As Single) As Long
  417. '*****************************************************************
  418. 'Converts a float to a D-Word, or in Visual Basic terms, a Single to a Long
  419. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_FToDW
  420. '*****************************************************************
  421. Dim Buf As D3DXBuffer
  422.  
  423.     'Converts a single into a long (Float to DWORD)
  424.    Set Buf = D3DX.CreateBuffer(4)
  425.     D3DX.BufferSetData Buf, 0, 4, 1, F
  426.     D3DX.BufferGetData Buf, 0, 4, 1, Effect_FToDW
  427.  
  428. End Function
  429.  
  430. Function Effect_Heal_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer, Optional ByVal Progression As Single = 1) As Integer
  431. '*****************************************************************
  432. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Heal_Begin
  433. '*****************************************************************
  434. Dim EffectIndex As Integer
  435. Dim LoopC As Long
  436.  
  437.     'Get the next open effect slot
  438.    EffectIndex = Effect_NextOpenSlot
  439.     If EffectIndex = -1 Then Exit Function
  440.  
  441.     'Return the index of the used slot
  442.    Effect_Heal_Begin = EffectIndex
  443.  
  444.     'Set The Effect's Variables
  445.    Effect(EffectIndex).EffectNum = EffectNum_Heal      'Set the effect number
  446.    Effect(EffectIndex).ParticleCount = Particles       'Set the number of particles
  447.    Effect(EffectIndex).Used = True     'Enabled the effect
  448.    Effect(EffectIndex).X = X           'Set the effect's X coordinate
  449.    Effect(EffectIndex).Y = Y           'Set the effect's Y coordinate
  450.    Effect(EffectIndex).Gfx = Gfx       'Set the graphic
  451.    Effect(EffectIndex).Progression = Progression   'Loop the effect
  452.    Effect(EffectIndex).KillWhenAtTarget = True     'End the effect when it reaches the target (progression = 0)
  453.    Effect(EffectIndex).KillWhenTargetLost = True   'End the effect if the target is lost (progression = 0)
  454.    
  455.     'Set the number of particles left to the total avaliable
  456.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  457.  
  458.     'Set the float variables
  459.    Effect(EffectIndex).FloatSize = Effect_FToDW(16)    'Size of the particles
  460.  
  461.     'Redim the number of particles
  462.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  463.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  464.  
  465.     'Create the particles
  466.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  467.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  468.         Effect(EffectIndex).Particles(LoopC).Used = True
  469.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  470.         Effect_Heal_Reset EffectIndex, LoopC
  471.     Next LoopC
  472.  
  473.     'Set The Initial Time
  474.    Effect(EffectIndex).PreviousFrame = timeGetTime
  475.  
  476. End Function
  477.  
  478. Private Sub Effect_Heal_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)
  479. '*****************************************************************
  480. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Heal_Reset
  481. '*****************************************************************
  482.  
  483.     'Reset the particle
  484.    Effect(EffectIndex).Particles(Index).ResetIt Effect(EffectIndex).X - 10 + Rnd * 20, Effect(EffectIndex).Y - 10 + Rnd * 20, -Sin((180 + (Rnd * 90) - 45) * 0.0174533) * 8 + (Rnd * 3), Cos((180 + (Rnd * 90) - 45) * 0.0174533) * 8 + (Rnd * 3), 0, 0
  485.     Effect(EffectIndex).Particles(Index).ResetColor 0.8, 0.2, 0.2, 0.6 + (Rnd * 0.2), 0.01 + (Rnd * 0.5)
  486.    
  487. End Sub
  488.  
  489. Private Sub Effect_Heal_Update(ByVal EffectIndex As Integer)
  490. '*****************************************************************
  491. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Heal_Update
  492. '*****************************************************************
  493. Dim ElapsedTime As Single
  494. Dim LoopC As Long
  495. Dim i As Integer
  496.  
  497.     'Calculate the time difference
  498.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  499.     Effect(EffectIndex).PreviousFrame = timeGetTime
  500.    
  501.     'Go through the particle loop
  502.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  503.  
  504.         'Check If Particle Is In Use
  505.        If Effect(EffectIndex).Particles(LoopC).Used Then
  506.  
  507.             'Update The Particle
  508.            Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
  509.  
  510.             'Check if the particle is ready to die
  511.            If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
  512.  
  513.                 'Check if the effect is ending
  514.                If Effect(EffectIndex).Progression <> 0 Then
  515.  
  516.                     'Reset the particle
  517.                    Effect_Heal_Reset EffectIndex, LoopC
  518.  
  519.                 Else
  520.  
  521.                     'Disable the particle
  522.                    Effect(EffectIndex).Particles(LoopC).Used = False
  523.  
  524.                     'Subtract from the total particle count
  525.                    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
  526.  
  527.                     'Check if the effect is out of particles
  528.                    If Effect(EffectIndex).ParticlesLeft = 0 Then Effect(EffectIndex).Used = False
  529.  
  530.                     'Clear the color (dont leave behind any artifacts)
  531.                    Effect(EffectIndex).PartVertex(LoopC).Color = 0
  532.  
  533.                 End If
  534.  
  535.             Else
  536.                
  537.                 'Set the particle information on the particle vertex
  538.                Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
  539.                 Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
  540.                 Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
  541.  
  542.             End If
  543.  
  544.         End If
  545.  
  546.     Next LoopC
  547.  
  548. End Sub
  549.  
  550. Sub Effect_Kill(ByVal EffectIndex As Integer, Optional ByVal KillAll As Boolean = False)
  551. '*****************************************************************
  552. 'Kills (stops) a single effect or all effects
  553. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Kill
  554. '*****************************************************************
  555. Dim LoopC As Long
  556.  
  557.     'Check If To Kill All Effects
  558.    If KillAll = True Then
  559.  
  560.         'Loop Through Every Effect
  561.        For LoopC = 1 To NumEffects
  562.  
  563.             'Stop The Effect
  564.            Effect(LoopC).Used = False
  565.  
  566.         Next
  567.        
  568.     Else
  569.  
  570.         'Stop The Selected Effect
  571.        Effect(EffectIndex).Used = False
  572.        
  573.     End If
  574.  
  575. End Sub
  576.  
  577. Private Function Effect_NextOpenSlot() As Integer
  578. '*****************************************************************
  579. 'Finds the next open effects index
  580. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_NextOpenSlot
  581. '*****************************************************************
  582. Dim EffectIndex As Integer
  583.  
  584.     'Find The Next Open Effect Slot
  585.    Do
  586.         EffectIndex = EffectIndex + 1   'Check The Next Slot
  587.        If EffectIndex > NumEffects Then    'Dont Go Over Maximum Amount
  588.            Effect_NextOpenSlot = -1
  589.             Exit Function
  590.         End If
  591.     Loop While Effect(EffectIndex).Used = True    'Check Next If Effect Is In Use
  592.  
  593.     'Return the next open slot
  594.    Effect_NextOpenSlot = EffectIndex
  595.  
  596.     'Clear the old information from the effect
  597.    Erase Effect(EffectIndex).Particles()
  598.     Erase Effect(EffectIndex).PartVertex()
  599.     ZeroMemory Effect(EffectIndex), LenB(Effect(EffectIndex))
  600.     Effect(EffectIndex).GoToX = -30000
  601.     Effect(EffectIndex).GoToY = -30000
  602.  
  603. End Function
  604.  
  605. Function Effect_Protection_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer, Optional ByVal Size As Byte = 30, Optional ByVal Time As Single = 10) As Integer
  606. '*****************************************************************
  607. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Protection_Begin
  608. '*****************************************************************
  609. Dim EffectIndex As Integer
  610. Dim LoopC As Long
  611.  
  612.     'Get the next open effect slot
  613.    EffectIndex = Effect_NextOpenSlot
  614.     If EffectIndex = -1 Then Exit Function
  615.  
  616.     'Return the index of the used slot
  617.    Effect_Protection_Begin = EffectIndex
  618.  
  619.     'Set The Effect's Variables
  620.    Effect(EffectIndex).EffectNum = EffectNum_Protection    'Set the effect number
  621.    Effect(EffectIndex).ParticleCount = Particles           'Set the number of particles
  622.    Effect(EffectIndex).Used = True             'Enabled the effect
  623.    Effect(EffectIndex).X = X                   'Set the effect's X coordinate
  624.    Effect(EffectIndex).Y = Y                   'Set the effect's Y coordinate
  625.    Effect(EffectIndex).Gfx = Gfx               'Set the graphic
  626.    Effect(EffectIndex).Modifier = Size         'How large the circle is
  627.    Effect(EffectIndex).Progression = Time      'How long the effect will last
  628.  
  629.     'Set the number of particles left to the total avaliable
  630.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  631.  
  632.     'Set the float variables
  633.    Effect(EffectIndex).FloatSize = Effect_FToDW(20)    'Size of the particles
  634.  
  635.     'Redim the number of particles
  636.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  637.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  638.  
  639.     'Create the particles
  640.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  641.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  642.         Effect(EffectIndex).Particles(LoopC).Used = True
  643.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  644.         Effect_Protection_Reset EffectIndex, LoopC
  645.     Next LoopC
  646.  
  647.     'Set The Initial Time
  648.    Effect(EffectIndex).PreviousFrame = timeGetTime
  649.  
  650. End Function
  651.  
  652. Private Sub Effect_Protection_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)
  653. '*****************************************************************
  654. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Protection_Reset
  655. '*****************************************************************
  656. Dim a As Single
  657. Dim X As Single
  658. Dim Y As Single
  659.  
  660.     'Get the positions
  661.    a = Rnd * 360 * DegreeToRadian
  662.     X = Effect(EffectIndex).X - (Sin(a) * Effect(EffectIndex).Modifier)
  663.     Y = Effect(EffectIndex).Y + (Cos(a) * Effect(EffectIndex).Modifier)
  664.  
  665.     'Reset the particle
  666.    Effect(EffectIndex).Particles(Index).ResetIt X, Y, 0, Rnd * -1, 0, -2
  667.     Effect(EffectIndex).Particles(Index).ResetColor 0.1, 0.1, 0.9, 0.6 + (Rnd * 0.4), 0.06 + (Rnd * 0.2)
  668.  
  669. End Sub
  670.  
  671. Private Sub Effect_UpdateOffset(ByVal EffectIndex As Integer)
  672. '***************************************************
  673. 'Update an effect's position if the screen has moved
  674. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_UpdateOffset
  675. '***************************************************
  676.  
  677.     Effect(EffectIndex).X = Effect(EffectIndex).X + (LastOffsetX - ParticleOffsetX)
  678.     Effect(EffectIndex).Y = Effect(EffectIndex).Y + (LastOffsetY - ParticleOffsetY)
  679.  
  680. End Sub
  681.  
  682. Private Sub Effect_UpdateBinding(ByVal EffectIndex As Integer)
  683.  
  684. '***************************************************
  685. 'Updates the binding of a particle effect to a target, if
  686. 'the effect is bound to a character
  687. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_UpdateBinding
  688. '***************************************************
  689. Dim TargetI As Integer
  690. Dim TargetA As Single
  691.  
  692.     'Update position through character binding
  693.    If Effect(EffectIndex).BindToChar > 0 Then
  694.  
  695.         'Store the character index
  696.        TargetI = Effect(EffectIndex).BindToChar
  697.  
  698.         'Check for a valid binding index
  699.        If TargetI > LastChar Then
  700.             Effect(EffectIndex).BindToChar = 0
  701.             If Effect(EffectIndex).KillWhenTargetLost Then
  702.                 Effect(EffectIndex).Progression = 0
  703.                 Exit Sub
  704.             End If
  705.         ElseIf CharList(TargetI).Active = 0 Then
  706.             Effect(EffectIndex).BindToChar = 0
  707.             If Effect(EffectIndex).KillWhenTargetLost Then
  708.                 Effect(EffectIndex).Progression = 0
  709.                 Exit Sub
  710.             End If
  711.         Else
  712.  
  713.             'Calculate the X and Y positions
  714.            Effect(EffectIndex).GoToX = Engine_TPtoSPX(CharList(Effect(EffectIndex).BindToChar).Pos.X) + 16
  715.             Effect(EffectIndex).GoToY = Engine_TPtoSPY(CharList(Effect(EffectIndex).BindToChar).Pos.Y)
  716.  
  717.         End If
  718.  
  719.     End If
  720.  
  721.     'Move to the new position if needed
  722.    If Effect(EffectIndex).GoToX > -30000 Or Effect(EffectIndex).GoToY > -30000 Then
  723.         If Effect(EffectIndex).GoToX <> Effect(EffectIndex).X Or Effect(EffectIndex).GoToY <> Effect(EffectIndex).Y Then
  724.  
  725.             'Calculate the angle
  726.            TargetA = Engine_GetAngle(Effect(EffectIndex).X, Effect(EffectIndex).Y, Effect(EffectIndex).GoToX, Effect(EffectIndex).GoToY) + 180
  727.  
  728.             'Update the position of the effect
  729.            Effect(EffectIndex).X = Effect(EffectIndex).X - Sin(TargetA * DegreeToRadian) * Effect(EffectIndex).BindSpeed
  730.             Effect(EffectIndex).Y = Effect(EffectIndex).Y + Cos(TargetA * DegreeToRadian) * Effect(EffectIndex).BindSpeed
  731.  
  732.             'Check if the effect is close enough to the target to just stick it at the target
  733.            If Effect(EffectIndex).GoToX > -30000 Then
  734.                 If Abs(Effect(EffectIndex).X - Effect(EffectIndex).GoToX) < 6 Then Effect(EffectIndex).X = Effect(EffectIndex).GoToX
  735.             End If
  736.             If Effect(EffectIndex).GoToY > -30000 Then
  737.                 If Abs(Effect(EffectIndex).Y - Effect(EffectIndex).GoToY) < 6 Then Effect(EffectIndex).Y = Effect(EffectIndex).GoToY
  738.             End If
  739.  
  740.             'Check if the position of the effect is equal to that of the target
  741.            If Effect(EffectIndex).X = Effect(EffectIndex).GoToX Then
  742.                 If Effect(EffectIndex).Y = Effect(EffectIndex).GoToY Then
  743.  
  744.                     'For some effects, if the position is reached, we want to end the effect
  745.                    If Effect(EffectIndex).KillWhenAtTarget Then
  746.                         Effect(EffectIndex).BindToChar = 0
  747.                         Effect(EffectIndex).Progression = 0
  748.                         Effect(EffectIndex).GoToX = Effect(EffectIndex).X
  749.                         Effect(EffectIndex).GoToY = Effect(EffectIndex).Y
  750.                     End If
  751.                     Exit Sub    'The effect is at the right position, don't update
  752.  
  753.                 End If
  754.             End If
  755.  
  756.         End If
  757.     End If
  758.  
  759. End Sub
  760.  
  761. Private Sub Effect_Protection_Update(ByVal EffectIndex As Integer)
  762. '*****************************************************************
  763. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Protection_Update
  764. '*****************************************************************
  765. Dim ElapsedTime As Single
  766. Dim LoopC As Long
  767.  
  768.     'Calculate The Time Difference
  769.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  770.     Effect(EffectIndex).PreviousFrame = timeGetTime
  771.  
  772.     'Update the life span
  773.    If Effect(EffectIndex).Progression > 0 Then Effect(EffectIndex).Progression = Effect(EffectIndex).Progression - ElapsedTime
  774.  
  775.     'Go through the particle loop
  776.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  777.  
  778.         'Check If Particle Is In Use
  779.        If Effect(EffectIndex).Particles(LoopC).Used Then
  780.  
  781.             'Update The Particle
  782.            Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
  783.  
  784.             'Check if the particle is ready to die
  785.            If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
  786.  
  787.                 'Check if the effect is ending
  788.                If Effect(EffectIndex).Progression > 0 Then
  789.  
  790.                     'Reset the particle
  791.                    Effect_Protection_Reset EffectIndex, LoopC
  792.  
  793.                 Else
  794.  
  795.                     'Disable the particle
  796.                    Effect(EffectIndex).Particles(LoopC).Used = False
  797.  
  798.                     'Subtract from the total particle count
  799.                    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
  800.  
  801.                     'Check if the effect is out of particles
  802.                    If Effect(EffectIndex).ParticlesLeft = 0 Then Effect(EffectIndex).Used = False
  803.  
  804.                     'Clear the color (dont leave behind any artifacts)
  805.                    Effect(EffectIndex).PartVertex(LoopC).Color = 0
  806.  
  807.                 End If
  808.  
  809.             Else
  810.  
  811.                 'Set the particle information on the particle vertex
  812.                Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
  813.                 Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
  814.                 Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
  815.  
  816.             End If
  817.  
  818.         End If
  819.  
  820.     Next LoopC
  821.  
  822. End Sub
  823.  
  824. Public Sub Effect_Render(ByVal EffectIndex As Integer, Optional ByVal SetRenderStates As Boolean = True)
  825. '*****************************************************************
  826. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Render
  827. '*****************************************************************
  828.  
  829.     'Check if we have the device
  830.    If D3DDevice.TestCooperativeLevel <> D3D_OK Then Exit Sub
  831.  
  832.     'Set the render state for the size of the particle
  833.    D3DDevice.SetRenderState D3DRS_POINTSIZE, Effect(EffectIndex).FloatSize
  834.    
  835.     'Set the render state to point blitting
  836.    If SetRenderStates Then D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
  837.    
  838.     'Set the last texture to a random number to force the engine to reload the texture
  839.    LastTexture = -65489
  840.  
  841.     'Set the texture
  842.    D3DDevice.SetTexture 0, ParticleTexture(Effect(EffectIndex).Gfx)
  843.  
  844.     'Draw all the particles at once
  845.    D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Effect(EffectIndex).ParticleCount, Effect(EffectIndex).PartVertex(0), Len(Effect(EffectIndex).PartVertex(0))
  846.  
  847.     'Reset the render state back to normal
  848.    If SetRenderStates Then D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
  849.  
  850. End Sub
  851.  
  852. Function Effect_Snow_Begin(ByVal Gfx As Integer, ByVal Particles As Integer) As Integer
  853. '*****************************************************************
  854. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Snow_Begin
  855. '*****************************************************************
  856. Dim EffectIndex As Integer
  857. Dim LoopC As Long
  858.  
  859.     'Get the next open effect slot
  860.    EffectIndex = Effect_NextOpenSlot
  861.     If EffectIndex = -1 Then Exit Function
  862.  
  863.     'Return the index of the used slot
  864.    Effect_Snow_Begin = EffectIndex
  865.  
  866.     'Set The Effect's Variables
  867.    Effect(EffectIndex).EffectNum = EffectNum_Snow      'Set the effect number
  868.    Effect(EffectIndex).ParticleCount = Particles       'Set the number of particles
  869.    Effect(EffectIndex).Used = True     'Enabled the effect
  870.    Effect(EffectIndex).Gfx = Gfx       'Set the graphic
  871.  
  872.     'Set the number of particles left to the total avaliable
  873.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  874.  
  875.     'Set the float variables
  876.    Effect(EffectIndex).FloatSize = Effect_FToDW(15)    'Size of the particles
  877.  
  878.     'Redim the number of particles
  879.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  880.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  881.  
  882.     'Create the particles
  883.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  884.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  885.         Effect(EffectIndex).Particles(LoopC).Used = True
  886.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  887.         Effect_Snow_Reset EffectIndex, LoopC, 1
  888.     Next LoopC
  889.  
  890.     'Set the initial time
  891.    Effect(EffectIndex).PreviousFrame = timeGetTime
  892.  
  893. End Function
  894.  
  895. Private Sub Effect_Snow_Reset(ByVal EffectIndex As Integer, ByVal Index As Long, Optional ByVal FirstReset As Byte = 0)
  896. '*****************************************************************
  897. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Snow_Reset
  898. '*****************************************************************
  899.  
  900.     If FirstReset = 1 Then
  901.  
  902.         'The very first reset
  903.        Effect(EffectIndex).Particles(Index).ResetIt -200 + (Rnd * (ScreenWidth + 400)), Rnd * (ScreenHeight + 50), Rnd * 5, 5 + Rnd * 3, 0, 0
  904.  
  905.     Else
  906.  
  907.         'Any reset after first
  908.        Effect(EffectIndex).Particles(Index).ResetIt -200 + (Rnd * (ScreenWidth + 400)), -15 - Rnd * 185, Rnd * 5, 5 + Rnd * 3, 0, 0
  909.         If Effect(EffectIndex).Particles(Index).sngX < -20 Then Effect(EffectIndex).Particles(Index).sngY = Rnd * (ScreenHeight + 50)
  910.         If Effect(EffectIndex).Particles(Index).sngX > ScreenWidth Then Effect(EffectIndex).Particles(Index).sngY = Rnd * (ScreenHeight + 50)
  911.         If Effect(EffectIndex).Particles(Index).sngY > ScreenHeight Then Effect(EffectIndex).Particles(Index).sngX = Rnd * (ScreenWidth + 50)
  912.  
  913.     End If
  914.  
  915.     'Set the color
  916.    Effect(EffectIndex).Particles(Index).ResetColor 1, 1, 1, 0.8, 0
  917.  
  918. End Sub
  919.  
  920. Private Sub Effect_Snow_Update(ByVal EffectIndex As Integer)
  921. '*****************************************************************
  922. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Snow_Update
  923. '*****************************************************************
  924. Dim ElapsedTime As Single
  925. Dim LoopC As Long
  926.  
  927.     'Calculate the time difference
  928.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  929.     Effect(EffectIndex).PreviousFrame = timeGetTime
  930.  
  931.     'Go through the particle loop
  932.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  933.  
  934.         'Check if particle is in use
  935.        If Effect(EffectIndex).Particles(LoopC).Used Then
  936.  
  937.             'Update The Particle
  938.            Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
  939.  
  940.             'Check if to reset the particle
  941.            If Effect(EffectIndex).Particles(LoopC).sngX < -200 Then Effect(EffectIndex).Particles(LoopC).sngA = 0
  942.             If Effect(EffectIndex).Particles(LoopC).sngX > (ScreenWidth + 200) Then Effect(EffectIndex).Particles(LoopC).sngA = 0
  943.             If Effect(EffectIndex).Particles(LoopC).sngY > (ScreenHeight + 200) Then Effect(EffectIndex).Particles(LoopC).sngA = 0
  944.  
  945.             'Time for a reset, baby!
  946.            If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
  947.  
  948.                 'Reset the particle
  949.                Effect_Snow_Reset EffectIndex, LoopC
  950.  
  951.             Else
  952.  
  953.                 'Set the particle information on the particle vertex
  954.                Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
  955.                 Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
  956.                 Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
  957.  
  958.             End If
  959.  
  960.         End If
  961.  
  962.     Next LoopC
  963.  
  964. End Sub
  965.  
  966. Function Effect_Strengthen_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer, Optional ByVal Size As Byte = 30, Optional ByVal Time As Single = 10) As Integer
  967. '*****************************************************************
  968. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Strengthen_Begin
  969. '*****************************************************************
  970. Dim EffectIndex As Integer
  971. Dim LoopC As Long
  972.  
  973.     'Get the next open effect slot
  974.    EffectIndex = Effect_NextOpenSlot
  975.     If EffectIndex = -1 Then Exit Function
  976.  
  977.     'Return the index of the used slot
  978.    Effect_Strengthen_Begin = EffectIndex
  979.  
  980.     'Set the effect's variables
  981.    Effect(EffectIndex).EffectNum = EffectNum_Strengthen    'Set the effect number
  982.    Effect(EffectIndex).ParticleCount = Particles           'Set the number of particles
  983.    Effect(EffectIndex).Used = True             'Enabled the effect
  984.    Effect(EffectIndex).X = X                   'Set the effect's X coordinate
  985.    Effect(EffectIndex).Y = Y                   'Set the effect's Y coordinate
  986.    Effect(EffectIndex).Gfx = Gfx               'Set the graphic
  987.    Effect(EffectIndex).Modifier = Size         'How large the circle is
  988.    Effect(EffectIndex).Progression = Time      'How long the effect will last
  989.  
  990.     'Set the number of particles left to the total avaliable
  991.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  992.  
  993.     'Set the float variables
  994.    Effect(EffectIndex).FloatSize = Effect_FToDW(20)    'Size of the particles
  995.  
  996.     'Redim the number of particles
  997.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  998.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  999.  
  1000.     'Create the particles
  1001.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  1002.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  1003.         Effect(EffectIndex).Particles(LoopC).Used = True
  1004.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  1005.         Effect_Strengthen_Reset EffectIndex, LoopC
  1006.     Next LoopC
  1007.  
  1008.     'Set The Initial Time
  1009.    Effect(EffectIndex).PreviousFrame = timeGetTime
  1010.  
  1011. End Function
  1012.  
  1013. Private Sub Effect_Strengthen_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)
  1014. '*****************************************************************
  1015. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Strengthen_Reset
  1016. '*****************************************************************
  1017. Dim a As Single
  1018. Dim X As Single
  1019. Dim Y As Single
  1020.  
  1021.     'Get the positions
  1022.    a = Rnd * 360 * DegreeToRadian
  1023.     X = Effect(EffectIndex).X - (Sin(a) * Effect(EffectIndex).Modifier)
  1024.     Y = Effect(EffectIndex).Y + (Cos(a) * Effect(EffectIndex).Modifier)
  1025.  
  1026.     'Reset the particle
  1027.    Effect(EffectIndex).Particles(Index).ResetIt X, Y, 0, Rnd * -1, 0, -2
  1028.     Effect(EffectIndex).Particles(Index).ResetColor 0.2, 1, 0.2, 0.6 + (Rnd * 0.4), 0.06 + (Rnd * 0.2)
  1029.  
  1030. End Sub
  1031.  
  1032. Private Sub Effect_Strengthen_Update(ByVal EffectIndex As Integer)
  1033. '*****************************************************************
  1034. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Strengthen_Update
  1035. '*****************************************************************
  1036. Dim ElapsedTime As Single
  1037. Dim LoopC As Long
  1038.  
  1039.     'Calculate the time difference
  1040.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  1041.     Effect(EffectIndex).PreviousFrame = timeGetTime
  1042.  
  1043.     'Update the life span
  1044.    If Effect(EffectIndex).Progression > 0 Then Effect(EffectIndex).Progression = Effect(EffectIndex).Progression - ElapsedTime
  1045.  
  1046.     'Go through the particle loop
  1047.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  1048.  
  1049.         'Check if particle is in use
  1050.        If Effect(EffectIndex).Particles(LoopC).Used Then
  1051.  
  1052.             'Update the particle
  1053.            Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
  1054.  
  1055.             'Check if the particle is ready to die
  1056.            If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
  1057.  
  1058.                 'Check if the effect is ending
  1059.                If Effect(EffectIndex).Progression > 0 Then
  1060.  
  1061.                     'Reset the particle
  1062.                    Effect_Strengthen_Reset EffectIndex, LoopC
  1063.  
  1064.                 Else
  1065.  
  1066.                     'Disable the particle
  1067.                    Effect(EffectIndex).Particles(LoopC).Used = False
  1068.  
  1069.                     'Subtract from the total particle count
  1070.                    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
  1071.  
  1072.                     'Check if the effect is out of particles
  1073.                    If Effect(EffectIndex).ParticlesLeft = 0 Then Effect(EffectIndex).Used = False
  1074.  
  1075.                     'Clear the color (dont leave behind any artifacts)
  1076.                    Effect(EffectIndex).PartVertex(LoopC).Color = 0
  1077.  
  1078.                 End If
  1079.  
  1080.             Else
  1081.  
  1082.                 'Set the particle information on the particle vertex
  1083.                Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
  1084.                 Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
  1085.                 Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
  1086.  
  1087.             End If
  1088.  
  1089.         End If
  1090.  
  1091.     Next LoopC
  1092.  
  1093. End Sub
  1094.  
  1095. Sub Effect_UpdateAll()
  1096. '*****************************************************************
  1097. 'Updates all of the effects and renders them
  1098. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_UpdateAll
  1099. '*****************************************************************
  1100. Dim LoopC As Long
  1101.  
  1102.     'Make sure we have effects
  1103.    If NumEffects = 0 Then Exit Sub
  1104.  
  1105.     'Set the render state for the particle effects
  1106.    D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
  1107.  
  1108.     'Update every effect in use
  1109.    For LoopC = 1 To NumEffects
  1110.  
  1111.         'Make sure the effect is in use
  1112.        If Effect(LoopC).Used Then
  1113.        
  1114.             'Update the effect position if the screen has moved
  1115.            Effect_UpdateOffset LoopC
  1116.        
  1117.             'Update the effect position if it is binded
  1118.            Effect_UpdateBinding LoopC
  1119.  
  1120.             'Find out which effect is selected, then update it
  1121.            If Effect(LoopC).EffectNum = EffectNum_Fire Then Effect_Fire_Update LoopC
  1122.             If Effect(LoopC).EffectNum = EffectNum_Snow Then Effect_Snow_Update LoopC
  1123.             If Effect(LoopC).EffectNum = EffectNum_Heal Then Effect_Heal_Update LoopC
  1124.             If Effect(LoopC).EffectNum = EffectNum_Bless Then Effect_Bless_Update LoopC
  1125.             If Effect(LoopC).EffectNum = EffectNum_Protection Then Effect_Protection_Update LoopC
  1126.             If Effect(LoopC).EffectNum = EffectNum_Strengthen Then Effect_Strengthen_Update LoopC
  1127.             If Effect(LoopC).EffectNum = EffectNum_Rain Then Effect_Rain_Update LoopC
  1128.             If Effect(LoopC).EffectNum = EffectNum_EquationTemplate Then Effect_EquationTemplate_Update LoopC
  1129.             If Effect(LoopC).EffectNum = EffectNum_Waterfall Then Effect_Waterfall_Update LoopC
  1130.             If Effect(LoopC).EffectNum = EffectNum_Summon Then Effect_Summon_Update LoopC
  1131.            
  1132.             'Render the effect
  1133.            Effect_Render LoopC, False
  1134.  
  1135.         End If
  1136.  
  1137.     Next
  1138.    
  1139.     'Set the render state back for normal rendering
  1140.    D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
  1141.  
  1142. End Sub
  1143.  
  1144. Function Effect_Rain_Begin(ByVal Gfx As Integer, ByVal Particles As Integer) As Integer
  1145. '*****************************************************************
  1146. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Rain_Begin
  1147. '*****************************************************************
  1148. Dim EffectIndex As Integer
  1149. Dim LoopC As Long
  1150.  
  1151.     'Get the next open effect slot
  1152.    EffectIndex = Effect_NextOpenSlot
  1153.     If EffectIndex = -1 Then Exit Function
  1154.  
  1155.     'Return the index of the used slot
  1156.    Effect_Rain_Begin = EffectIndex
  1157.  
  1158.     'Set the effect's variables
  1159.    Effect(EffectIndex).EffectNum = EffectNum_Rain      'Set the effect number
  1160.    Effect(EffectIndex).ParticleCount = Particles       'Set the number of particles
  1161.    Effect(EffectIndex).Used = True     'Enabled the effect
  1162.    Effect(EffectIndex).Gfx = Gfx       'Set the graphic
  1163.  
  1164.     'Set the number of particles left to the total avaliable
  1165.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  1166.  
  1167.     'Set the float variables
  1168.    Effect(EffectIndex).FloatSize = Effect_FToDW(10)    'Size of the particles
  1169.  
  1170.     'Redim the number of particles
  1171.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  1172.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  1173.  
  1174.     'Create the particles
  1175.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  1176.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  1177.         Effect(EffectIndex).Particles(LoopC).Used = True
  1178.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  1179.         Effect_Rain_Reset EffectIndex, LoopC, 1
  1180.     Next LoopC
  1181.  
  1182.     'Set The Initial Time
  1183.    Effect(EffectIndex).PreviousFrame = timeGetTime
  1184.  
  1185. End Function
  1186.  
  1187. Private Sub Effect_Rain_Reset(ByVal EffectIndex As Integer, ByVal Index As Long, Optional ByVal FirstReset As Byte = 0)
  1188. '*****************************************************************
  1189. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Rain_Reset
  1190. '*****************************************************************
  1191.  
  1192.     If FirstReset = 1 Then
  1193.  
  1194.         'The very first reset
  1195.        Effect(EffectIndex).Particles(Index).ResetIt -200 + (Rnd * (ScreenWidth + 400)), Rnd * (ScreenHeight + 50), Rnd * 5, 25 + Rnd * 12, 0, 0
  1196.  
  1197.     Else
  1198.  
  1199.         'Any reset after first
  1200.        Effect(EffectIndex).Particles(Index).ResetIt -200 + (Rnd * 1200), -15 - Rnd * 185, Rnd * 5, 25 + Rnd * 12, 0, 0
  1201.         If Effect(EffectIndex).Particles(Index).sngX < -20 Then Effect(EffectIndex).Particles(Index).sngY = Rnd * (ScreenHeight + 50)
  1202.         If Effect(EffectIndex).Particles(Index).sngX > ScreenWidth Then Effect(EffectIndex).Particles(Index).sngY = Rnd * (ScreenHeight + 50)
  1203.         If Effect(EffectIndex).Particles(Index).sngY > ScreenHeight Then Effect(EffectIndex).Particles(Index).sngX = Rnd * (ScreenWidth + 50)
  1204.  
  1205.     End If
  1206.  
  1207.     'Set the color
  1208.    Effect(EffectIndex).Particles(Index).ResetColor 1, 1, 1, 0.4, 0
  1209.  
  1210. End Sub
  1211.  
  1212. Private Sub Effect_Rain_Update(ByVal EffectIndex As Integer)
  1213. '*****************************************************************
  1214. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Rain_Update
  1215. '*****************************************************************
  1216. Dim ElapsedTime As Single
  1217. Dim LoopC As Long
  1218.  
  1219.     'Calculate the time difference
  1220.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  1221.     Effect(EffectIndex).PreviousFrame = timeGetTime
  1222.  
  1223.     'Go through the particle loop
  1224.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  1225.  
  1226.         'Check if the particle is in use
  1227.        If Effect(EffectIndex).Particles(LoopC).Used Then
  1228.  
  1229.             'Update the particle
  1230.            Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
  1231.  
  1232.             'Check if to reset the particle
  1233.            If Effect(EffectIndex).Particles(LoopC).sngX < -200 Then Effect(EffectIndex).Particles(LoopC).sngA = 0
  1234.             If Effect(EffectIndex).Particles(LoopC).sngX > (ScreenWidth + 200) Then Effect(EffectIndex).Particles(LoopC).sngA = 0
  1235.             If Effect(EffectIndex).Particles(LoopC).sngY > (ScreenHeight + 200) Then Effect(EffectIndex).Particles(LoopC).sngA = 0
  1236.  
  1237.             'Time for a reset, baby!
  1238.            If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
  1239.  
  1240.                 'Reset the particle
  1241.                Effect_Rain_Reset EffectIndex, LoopC
  1242.  
  1243.             Else
  1244.  
  1245.                 'Set the particle information on the particle vertex
  1246.                Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
  1247.                 Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
  1248.                 Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
  1249.  
  1250.             End If
  1251.  
  1252.         End If
  1253.  
  1254.     Next LoopC
  1255.  
  1256. End Sub
  1257.  
  1258. Public Sub Effect_Begin(ByVal EffectIndex As Integer, ByVal X As Single, ByVal Y As Single, ByVal GfxIndex As Byte, ByVal Particles As Byte, Optional ByVal Direction As Single = 180, Optional ByVal BindToMap As Boolean = False)
  1259. '*****************************************************************
  1260. 'A very simplistic form of initialization for particle effects
  1261. 'Should only be used for starting map-based effects
  1262. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Begin
  1263. '*****************************************************************
  1264. Dim RetNum As Byte
  1265.  
  1266.     Select Case EffectIndex
  1267.         Case EffectNum_Fire
  1268.             RetNum = Effect_Fire_Begin(X, Y, GfxIndex, Particles, Direction, 1)
  1269.         Case EffectNum_Waterfall
  1270.             RetNum = Effect_Waterfall_Begin(X, Y, GfxIndex, Particles)
  1271.     End Select
  1272.    
  1273.     'Bind the effect to the map if needed
  1274.    If BindToMap Then Effect(RetNum).BoundToMap = 1
  1275.    
  1276. End Sub
  1277.  
  1278. Function Effect_Waterfall_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer) As Integer
  1279. '*****************************************************************
  1280. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Waterfall_Begin
  1281. '*****************************************************************
  1282. Dim EffectIndex As Integer
  1283. Dim LoopC As Long
  1284.  
  1285.     'Get the next open effect slot
  1286.    EffectIndex = Effect_NextOpenSlot
  1287.     If EffectIndex = -1 Then Exit Function
  1288.  
  1289.     'Return the index of the used slot
  1290.    Effect_Waterfall_Begin = EffectIndex
  1291.  
  1292.     'Set the effect's variables
  1293.    Effect(EffectIndex).EffectNum = EffectNum_Waterfall     'Set the effect number
  1294.    Effect(EffectIndex).ParticleCount = Particles           'Set the number of particles
  1295.    Effect(EffectIndex).Used = True             'Enabled the effect
  1296.    Effect(EffectIndex).X = X                   'Set the effect's X coordinate
  1297.    Effect(EffectIndex).Y = Y                   'Set the effect's Y coordinate
  1298.    Effect(EffectIndex).Gfx = Gfx               'Set the graphic
  1299.  
  1300.     'Set the number of particles left to the total avaliable
  1301.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  1302.  
  1303.     'Set the float variables
  1304.    Effect(EffectIndex).FloatSize = Effect_FToDW(20)    'Size of the particles
  1305.  
  1306.     'Redim the number of particles
  1307.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  1308.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  1309.  
  1310.     'Create the particles
  1311.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  1312.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  1313.         Effect(EffectIndex).Particles(LoopC).Used = True
  1314.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  1315.         Effect_Waterfall_Reset EffectIndex, LoopC
  1316.     Next LoopC
  1317.  
  1318.     'Set The Initial Time
  1319.    Effect(EffectIndex).PreviousFrame = timeGetTime
  1320.  
  1321. End Function
  1322.  
  1323. Private Sub Effect_Waterfall_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)
  1324. '*****************************************************************
  1325. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Waterfall_Reset
  1326. '*****************************************************************
  1327.  
  1328.     If Int(Rnd * 10) = 1 Then
  1329.         Effect(EffectIndex).Particles(Index).ResetIt Effect(EffectIndex).X + (Rnd * 60), Effect(EffectIndex).Y + (Rnd * 130), 0, 8 + (Rnd * 6), 0, 0
  1330.     Else
  1331.         Effect(EffectIndex).Particles(Index).ResetIt Effect(EffectIndex).X + (Rnd * 60), Effect(EffectIndex).Y + (Rnd * 10), 0, 8 + (Rnd * 6), 0, 0
  1332.     End If
  1333.     Effect(EffectIndex).Particles(Index).ResetColor 0.1, 0.1, 0.9, 0.6 + (Rnd * 0.4), 0
  1334.    
  1335. End Sub
  1336.  
  1337. Private Sub Effect_Waterfall_Update(ByVal EffectIndex As Integer)
  1338. '*****************************************************************
  1339. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Waterfall_Update
  1340. '*****************************************************************
  1341. Dim ElapsedTime As Single
  1342. Dim LoopC As Long
  1343.  
  1344.     'Calculate The Time Difference
  1345.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  1346.     Effect(EffectIndex).PreviousFrame = timeGetTime
  1347.  
  1348.     'Update the life span
  1349.    If Effect(EffectIndex).Progression > 0 Then Effect(EffectIndex).Progression = Effect(EffectIndex).Progression - ElapsedTime
  1350.  
  1351.     'Go through the particle loop
  1352.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  1353.    
  1354.         With Effect(EffectIndex).Particles(LoopC)
  1355.    
  1356.             'Check if the particle is in use
  1357.            If .Used Then
  1358.    
  1359.                 'Update The Particle
  1360.                .UpdateParticle ElapsedTime
  1361.  
  1362.                 'Check if the particle is ready to die
  1363.                If (.sngY > Effect(EffectIndex).Y + 140) Or (.sngA = 0) Then
  1364.    
  1365.                     'Reset the particle
  1366.                    Effect_Waterfall_Reset EffectIndex, LoopC
  1367.    
  1368.                 Else
  1369.  
  1370.                     'Set the particle information on the particle vertex
  1371.                    Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(.sngR, .sngG, .sngB, .sngA)
  1372.                     Effect(EffectIndex).PartVertex(LoopC).X = .sngX
  1373.                     Effect(EffectIndex).PartVertex(LoopC).Y = .sngY
  1374.    
  1375.                 End If
  1376.    
  1377.             End If
  1378.            
  1379.         End With
  1380.  
  1381.     Next LoopC
  1382.  
  1383. End Sub
  1384.  
  1385. Function Effect_Summon_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer, Optional ByVal Progression As Single = 0) As Integer
  1386. '*****************************************************************
  1387. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Summon_Begin
  1388. '*****************************************************************
  1389. Dim EffectIndex As Integer
  1390. Dim LoopC As Long
  1391.  
  1392.     'Get the next open effect slot
  1393.    EffectIndex = Effect_NextOpenSlot
  1394.     If EffectIndex = -1 Then Exit Function
  1395.  
  1396.     'Return the index of the used slot
  1397.    Effect_Summon_Begin = EffectIndex
  1398.  
  1399.     'Set The Effect's Variables
  1400.    Effect(EffectIndex).EffectNum = EffectNum_Summon    'Set the effect number
  1401.    Effect(EffectIndex).ParticleCount = Particles       'Set the number of particles
  1402.    Effect(EffectIndex).Used = True                     'Enable the effect
  1403.    Effect(EffectIndex).X = X                           'Set the effect's X coordinate
  1404.    Effect(EffectIndex).Y = Y                           'Set the effect's Y coordinate
  1405.    Effect(EffectIndex).Gfx = Gfx                       'Set the graphic
  1406.    Effect(EffectIndex).Progression = Progression       'If we loop the effect
  1407.  
  1408.     'Set the number of particles left to the total avaliable
  1409.    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
  1410.  
  1411.     'Set the float variables
  1412.    Effect(EffectIndex).FloatSize = Effect_FToDW(8)    'Size of the particles
  1413.  
  1414.     'Redim the number of particles
  1415.    ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount)
  1416.     ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
  1417.  
  1418.     'Create the particles
  1419.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  1420.         Set Effect(EffectIndex).Particles(LoopC) = New Particle
  1421.         Effect(EffectIndex).Particles(LoopC).Used = True
  1422.         Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
  1423.         Effect_Summon_Reset EffectIndex, LoopC
  1424.     Next LoopC
  1425.  
  1426.     'Set The Initial Time
  1427.    Effect(EffectIndex).PreviousFrame = timeGetTime
  1428.  
  1429. End Function
  1430.  
  1431. Private Sub Effect_Summon_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)
  1432. '*****************************************************************
  1433. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Summon_Reset
  1434. '*****************************************************************
  1435. Dim X As Single
  1436. Dim Y As Single
  1437. Dim R As Single
  1438.    
  1439.     If Effect(EffectIndex).Progression > 1000 Then
  1440.         Effect(EffectIndex).Progression = Effect(EffectIndex).Progression + 1.4
  1441.     Else
  1442.         Effect(EffectIndex).Progression = Effect(EffectIndex).Progression + 0.5
  1443.     End If
  1444.     R = (Index / 30) * EXP(Index / Effect(EffectIndex).Progression)
  1445.     X = R * Cos(Index)
  1446.     Y = R * Sin(Index)
  1447.    
  1448.     'Reset the particle
  1449.    Effect(EffectIndex).Particles(Index).ResetIt Effect(EffectIndex).X + X, Effect(EffectIndex).Y + Y, 0, 0, 0, 0
  1450.     Effect(EffectIndex).Particles(Index).ResetColor 0, Rnd, 0, 0.9, 0.2 + (Rnd * 0.2)
  1451.  
  1452. End Sub
  1453.  
  1454. Private Sub Effect_Summon_Update(ByVal EffectIndex As Integer)
  1455. '*****************************************************************
  1456. 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Summon_Update
  1457. '*****************************************************************
  1458. Dim ElapsedTime As Single
  1459. Dim LoopC As Long
  1460.  
  1461.     'Calculate The Time Difference
  1462.    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
  1463.     Effect(EffectIndex).PreviousFrame = timeGetTime
  1464.  
  1465.     'Go Through The Particle Loop
  1466.    For LoopC = 0 To Effect(EffectIndex).ParticleCount
  1467.  
  1468.         'Check If Particle Is In Use
  1469.        If Effect(EffectIndex).Particles(LoopC).Used Then
  1470.  
  1471.             'Update The Particle
  1472.            Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
  1473.  
  1474.             'Check if the particle is ready to die
  1475.            If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
  1476.  
  1477.                 'Check if the effect is ending
  1478.                If Effect(EffectIndex).Progression < 1800 Then
  1479.  
  1480.                     'Reset the particle
  1481.                    Effect_Summon_Reset EffectIndex, LoopC
  1482.  
  1483.                 Else
  1484.  
  1485.                     'Disable the particle
  1486.                    Effect(EffectIndex).Particles(LoopC).Used = False
  1487.  
  1488.                     'Subtract from the total particle count
  1489.                    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
  1490.  
  1491.                     'Check if the effect is out of particles
  1492.                    If Effect(EffectIndex).ParticlesLeft = 0 Then Effect(EffectIndex).Used = False
  1493.  
  1494.                     'Clear the color (dont leave behind any artifacts)
  1495.                    Effect(EffectIndex).PartVertex(LoopC).Color = 0
  1496.  
  1497.                 End If
  1498.  
  1499.             Else
  1500.            
  1501.                 'Set the particle information on the particle vertex
  1502.                Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
  1503.                 Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
  1504.                 Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
  1505.  
  1506.             End If
  1507.  
  1508.         End If
  1509.  
  1510.     Next LoopC
  1511.  
  1512. End Sub
  1513.  
Advertisement
Comments
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!