VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2DParticle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Type Particle
    x As Double
    y As Double
    MovementX As Double
    MovementY As Double
    GravityX As Double
    GravityY As Double
    LifeTime As Double
    Color As Long
    Zoom As Double
    ZoomIn As Double
    ZoomOut As Double
    ZoomSpeed As Double
    ZoomDir As Boolean
    RotationSpeed As Double
    Rotation As Double
    AniQFrame As Integer
    FrameTimer As Double
End Type

Private Type ParticleEffect
    XPos As Integer
    YPos As Integer
    ParticleWidth As Integer
    ParticleHeight As Integer
    Power As Double
    GravityX As Double
    GravityY As Double
    ParticleCount As Integer
    LifeTime As Double
    Particles() As Particle
    textureID As Integer
    Add As Boolean
    OverrideAniq As Boolean
End Type
    
Private CFm_S2D As cS2D_i

Private ParticleEffectCount As Integer
Private ParticleEffects() As ParticleEffect
Private ParticleEffectNames() As String

'dokumentieren: NEIN
Public Property Get S2D() As cS2D_i
    Set S2D = CFm_S2D
End Property

Public Property Set S2D(PropVal As cS2D_i)
    Set CFm_S2D = PropVal
End Property

'dokumentieren: NEIN
Public Function OverrideAniq(Name As String)
    
    Dim ID As Integer
    For i = 1 To ParticleEffectCount
        If ParticleEffectNames(i) = Name Then ID = i: GoTo Continue
    Next i
    Exit Function
    
Continue:
    ParticleEffects(ID).OverrideAniq = Not ParticleEffects(ID).OverrideAniq

End Function

'dokumentieren: NEIN
Public Sub DrawParticle(ID As Integer, ByVal XPos As Double, ByVal YPos As Double, ByVal Power As Double, ByVal lngColor As Long, Optional Additive As Boolean = False, Optional dblZoom As Double = 1, Optional Rotation As Double = 0, Optional AniQFrame As Integer = -1)

    Dim Fade As Integer

    'Private ParticleStrip() As LitVertex
    Fade = Int((Power / 100) * 255)
    If Fade < 0 Then Fade = 0
    If Fade > 255 Then Fade = 255
    
    Dim dblZoom2 As Double
    Dim dblZoom3 As Double
    dblZoom2 = ParticleEffects(ID).ParticleWidth * (CInt(dblZoom) / 100)
    dblZoom3 = ParticleEffects(ID).ParticleHeight * (CInt(dblZoom) / 100)
    
    If dblZoom2 < -ParticleEffects(ID).ParticleWidth Then dblZoom = -ParticleEffects(ID).ParticleWidth + 1
    If dblZoom3 < -ParticleEffects(ID).ParticleHeight Then dblZoom = -ParticleEffects(ID).ParticleHeight + 1
    
    If Additive Then
        S2D.TexturePool.Pool1.SetBlending S2D_Additive
    End If
    
    S2D.TexturePool.RenderTexture ParticleEffects(ID).textureID, XPos, YPos, ParticleEffects(ID).ParticleWidth + dblZoom2, ParticleEffects(ID).ParticleHeight + dblZoom3, , , , , Fade, CInt(Rotation), , , , lngColor

    If Additive Then
        S2D.TexturePool.Pool1.SetBlending S2D_Alpha
    End If

End Sub

'dokumentieren: NEIN
Public Sub Render(ID As Integer, Optional offsetx As Integer, Optional offsety As Integer)

    Dim i As Integer
    Calculate ID
        
    For i = 1 To ParticleEffects(ID).ParticleCount
        
        If ParticleEffects(ID).textureID > 1000 Then
        
            Dim tID As Integer
            Dim tani As cS2DAniQ
            
            tID = ParticleEffects(ID).textureID - 1000
            Set tani = GFX.TexturePool.GetAnimation(ID)
            tani.RemoteControl = ParticleEffects(ID).OverrideAniq
            tani.RemoteFrame = ParticleEffects(ID).Particles(i).AniQFrame
            If tani.RemoteFrame = -1 Then tani.RemoteFrame = 0
            
        End If
    
        DrawParticle ID, ParticleEffects(ID).Particles(i).x + offsetx, ParticleEffects(ID).Particles(i).y + offsety, ParticleEffects(ID).Particles(i).LifeTime, ParticleEffects(ID).Particles(i).Color, ParticleEffects(ID).Add, ParticleEffects(ID).Particles(i).Zoom, ParticleEffects(ID).Particles(i).Rotation, IIf(ParticleEffects(ID).OverrideAniq, ParticleEffects(ID).Particles(i).AniQFrame, -1)
    Next i
       
End Sub

'dokumentieren: NEIN
Public Function RenderAll(Optional offsetx As Integer, Optional offsety As Integer)

    Dim i As Integer
    
    For i = 1 To ParticleEffectCount
        Render i, offsetx, offsety
    Next i

End Function

'dokumentieren: NEIN
Public Sub Calculate(ID As Integer)
    
For i = 1 To ParticleEffects(ID).ParticleCount
    
    If ParticleEffects(ID).OverrideAniq Then
    
        If GetTickCount - ParticleEffects(ID).Particles(i).FrameTimer >= S2D.TexturePool.AnimationInterval(ParticleEffects(ID).textureID, ParticleEffects(ID).Particles(i).AniQFrame) Then
            ParticleEffects(ID).Particles(i).FrameTimer = GetTickCount
            If Not ParticleEffects(ID).Particles(i).AniQFrame >= S2D.TexturePool.AnimationFrameCount(ParticleEffects(ID).textureID) Then
                ParticleEffects(ID).Particles(i).AniQFrame = ParticleEffects(ID).Particles(i).AniQFrame + 1
            Else
                ParticleEffects(ID).Particles(i).AniQFrame = 1
            End If
        End If
        
    End If
               
    With ParticleEffects(ID).Particles(i)
        .Rotation = .Rotation + ParticleEffects(ID).Particles(i).RotationSpeed
        If .Rotation > 360 Then
            .Rotation = 0
        End If
    End With
            
    If ParticleEffects(ID).Particles(i).Rotation < 0 Then
        ParticleEffects(ID).Particles(i).Rotation = 360
    End If
    
    With ParticleEffects(ID).Particles(i)
    
        .x = .x + ParticleEffects(ID).Particles(i).MovementX
        .x = .x + ParticleEffects(ID).Particles(i).GravityX
        .GravityX = .GravityX + ParticleEffects(ID).GravityX
        .y = .y + ParticleEffects(ID).Particles(i).MovementY
        .y = .y + ParticleEffects(ID).Particles(i).GravityY
        .GravityY = .GravityY + ParticleEffects(ID).GravityY
        
        If .ZoomDir Then
            If .Zoom < .ZoomOut Then
                .Zoom = .Zoom + .ZoomSpeed
            Else
                .ZoomDir = False
            End If
        End If
        
        If .ZoomDir = False Then
            If .Zoom > -.ZoomIn Then
                .Zoom = .Zoom - .ZoomSpeed
            Else
                .ZoomDir = True
            End If
        End If
        
        If .LifeTime > 0 Then
            .LifeTime = .LifeTime - ParticleEffects(ID).LifeTime
        Else
            If .LifeTime < 0 Then
                .LifeTime = 0
            End If
            
            .AniQFrame = -1
            .x = ParticleEffects(ID).XPos
            .y = ParticleEffects(ID).YPos
            .MovementX = -ParticleEffects(ID).Power + Round(Rnd * 2 * ParticleEffects(ID).Power, 2)
            .MovementY = -ParticleEffects(ID).Power + Round(Rnd * 2 * ParticleEffects(ID).Power, 2)
            .GravityX = 0
            .GravityY = 0
            .LifeTime = 100 - Int(Rnd * 30)
        End If
        
    End With

Next i

End Sub

'dokumentieren: NEIN
Public Sub Unload()

    For i = 1 To ParticleEffectCount
    If ParticleEffects(i).textureID > 0 Then S2D.TexturePool.RemoveTexture ParticleEffects(i).textureID
    Next i

End Sub

'dokumentieren: JA
Public Function SetPositionByName(Name As String, x As Integer, y As Integer)

    Dim ID As Integer
    For i = 1 To ParticleEffectCount
        If ParticleEffectNames(i) = Name Then ID = i: GoTo Continue
    Next i
    Exit Function

Continue:
    ParticleEffects(ID).XPos = x
    ParticleEffects(ID).YPos = y

End Function

Public Function SetPositionByID(ID As Integer, x As Integer, y As Integer)
    
    ParticleEffects(ID).XPos = x
    ParticleEffects(ID).YPos = y

End Function

'dokumentieren: JA
Public Sub CreateParticles(Name As String, ByVal strImage As String, colorkey As Long, x As Integer, y As Integer, ByVal Pwr As Double, ByVal XGrv As Double, ByVal YGrv As Double, ByVal dblCount As Double, ByVal lngColor As Long, Optional Additive As Boolean = False, Optional Life As Double = 0.5, Optional ZoomOut As Double = 1, Optional ZoomIn As Double = 1, Optional ZoomSpeed As Double = 0.1, Optional RotationSpeed As Double = 0)
    
    Dim i As Integer
    Dim ID As Integer
    
    For i = 1 To ParticleEffectCount
        If ParticleEffectNames(i) = Name Then ID = i: GoTo Continue
    Next i
        
    ParticleEffectCount = ParticleEffectCount + 1
    ReDim Preserve ParticleEffects(1 To ParticleEffectCount)
    ReDim Preserve ParticleEffectNames(1 To ParticleEffectCount)
    ParticleEffectNames(ParticleEffectCount) = Name
    ID = ParticleEffectCount

Continue:

    With ParticleEffects(ID)
    
        .XPos = x
        .YPos = y
        .Power = Pwr
        .GravityX = XGrv
        .GravityY = YGrv
        .ParticleCount = dblCount
        
        ReDim .Particles(.ParticleCount)
        
        Randomize Timer
        
        If .textureID > 0 Then S2D.TexturePool.RemoveTexture .textureID
        
        Dim imgfile As String
        imgfile = "images\" & strImage
        .textureID = S2D.TexturePool.AddTexture(imgfile, colorkey)
        .ParticleWidth = S2D.TexturePool.TextureWidth(.textureID)
        .ParticleHeight = S2D.TexturePool.TextureHeight(.textureID)
    
    End With

    For i = 1 To ParticleEffects(ID).ParticleCount
        With ParticleEffects(ID).Particles(i)
            .MovementX = -ParticleEffects(ID).Power + Round(Rnd * 2 * ParticleEffects(ID).Power, 2)
            .MovementY = -ParticleEffects(ID).Power + Round(Rnd * 2 * ParticleEffects(ID).Power, 2)
            .LifeTime = 70 - Int(Rnd * 69)
            .Color = lngColor
            .ZoomIn = ZoomIn
            .ZoomOut = ZoomOut
            .ZoomSpeed = ZoomSpeed
            .Zoom = 1
            .RotationSpeed = RotationSpeed
        End With
    Next i

    ParticleEffects(ID).Add = Additive
    ParticleEffects(ID).LifeTime = Life

End Sub
