VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2DTexturePool"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Textures() As Texture
Public TextureCount As Integer

Private Vertices(0 To 3) As UnlitVertex
Private LitVertices(0 To 3) As LitVertex

Private Sprite As D3DXSprite

Private Const Pi As Single = 3.141593

Private Type UnlitVertex
    x As Single
    y As Single
    Z As Single
    nx As Single
    ny As Single
    nz As Single
    tu As Single
    tv As Single
End Type

Private Type LitVertex
    x As Single
    y As Single
    Z As Single
    Color As Long
    specular As Long
    tu As Single
    tv As Single
End Type

Private Type Texture
    Tex As Direct3DTexture8
    Width As Integer
    Height As Integer
    colorkey As Long
    FileName As String
End Type

Private Type D3DXIMAGEINFO
    Width As Long
    Height As Long
    Depth As Long
    
    MipLevels As Long
    Format As Long
    ResourceType As Long
    ImageFileFormat As Long
End Type

Private Type tBuffer
    Texture As Long
    VertexCount As Long
    Vertex() As UnlitVertex
    LitVertex() As LitVertex
End Type

Private Type BufferCollection
    VerticesBuffer() As tBuffer
    BufferCount As Long
    Dynamic As Boolean
    Colored As Boolean
End Type

Private BufferArray() As BufferCollection
Private BufferCount As Integer
Private Buffer As Integer

Private BackBuffer As Direct3DSurface8
Private TextureBuffer() As tBuffer
Private TextureBufferCount As Long
Private VertexSize As Long

Public BlancID As Integer
Public BlancID2 As Integer
Public OverrideZ As Integer

Private Sub Class_Initialize()

    Dim TempVertex As UnlitVertex
    VertexSize = Len(TempVertex)
    BufferCount = -1
    Buffer = -1
    ZoomFactor = 1
    TextureCount = 0
    Set Sprite = D3DX.CreateSprite(D3DDevice)
    S2DLog.Add "Texturepool initialized"
    
End Sub

Public Function Unload()

    Dim i As Integer
    For i = 0 To TextureCount
        Set Textures(i).Tex = Nothing
    Next i
    
    Erase Textures
    DestroyBuffers
    S2DLog.Add "Texturepool successfully unloaded"
    
End Function

Public Function UnloadTexture(ID As Integer)

    Set Textures(i).Tex = Nothing
    Textures(i).FileName = ""
    S2DLog.Add "Texture successfully unloaded"
    
End Function

Public Function SetAlpha(Intensity As Integer)
    
    Dim rIntensity As Double
    rIntensity = (255 - Intensity) / 255
    D3DDevice.SetRenderState D3DRS_TEXTUREFACTOR, D3DColorMake(0, 0, 0, 1 - rIntensity)
    
End Function

Public Function SetBlending(Mode As BlendingMode)
    
    D3DDevice.SetRenderState D3DRS_ALPHATESTENABLE, 1
    D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1
    D3DDevice.SetRenderState D3DRS_TEXTUREFACTOR, D3DColorMake(0, 0, 0, 1)
    D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1
    D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAARG2, D3DTA_CURRENT
    
    CurrentMode = Mode
    
    With D3DDevice
    Select Case Mode
        Case 0
            .SetRenderState D3DRS_ALPHATESTENABLE, 0
            .SetRenderState D3DRS_ALPHABLENDENABLE, 0
            
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ZERO
        
        Case 1
            .SetRenderState D3DRS_ALPHABLENDENABLE, 0
            
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ZERO
        
        Case 2
            .SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE
            .SetTextureStageState 0, D3DTSS_ALPHAARG2, D3DTA_TFACTOR
            
            .SetRenderState D3DRS_BLENDOP, D3DBLENDOP_ADD
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
        
        Case 3
            .SetRenderState D3DRS_BLENDOP, D3DBLENDOP_ADD
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCCOLOR
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCCOLOR
        
        Case 4
            .SetRenderState D3DRS_BLENDOP, D3DBLENDOP_ADD
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
        
        Case 5
            .SetRenderState D3DRS_BLENDOP, D3DBLENDOP_ADD
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCCOLOR
        
        Case 6
            .SetRenderState D3DRS_BLENDOP, D3DBLENDOP_ADD
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCCOLOR
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
        
        Case 7
            .SetRenderState D3DRS_BLENDOP, D3DBLENDOP_REVSUBTRACT
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
        
        Case 8
            .SetRenderState D3DRS_BLENDOP, D3DBLENDOP_SUBTRACT
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
        
        Case 9
            .SetRenderState D3DRS_BLENDOP, D3DBLENDOP_MAX
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
        
        Case 10
            .SetRenderState D3DRS_BLENDOP, D3DBLENDOP_MIN
            .SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
            .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
        
    End Select
    End With
    
End Function

Public Function LoadTexture(FileName As String, Optional colorkey As Long = vbMagenta) As Long
    
    'On Error Resume Next
    
    Dim tFilename As String
    tFilename = GetFileName(FileName)
    
    If TextureCount = 0 Then
        TextureCount = 1
        CurrentTexture = 1
        ReDim Textures(1)
        GoTo SkipAllocate
    End If
    
    Dim i As Integer
    For i = 1 To TextureCount
        If Textures(i).FileName = tFilename Then
            S2DLog.Add "Texture already loaded """ & FileName & """"
            LoadTexture = i
            Exit Function
        End If
        If Textures(i).FileName = "" Then
            S2DLog.Add "Using free Texture Slot"
            CurrentTexture = i
            GoTo SkipAllocate
        End If
    Next
    
    TextureCount = TextureCount + 1
    ReDim Preserve Textures(TextureCount)
    CurrentTexture = TextureCount
    
SkipAllocate:
    With Textures(CurrentTexture)
      If FileName <> "" Then
        .FileName = tFilename
        .colorkey = colorkey
        
        Dim ImageInfo As D3DXIMAGEINFO
        Set .Tex = D3DX.CreateTextureFromFileEx(D3DDevice, FileName, D3DX_DEFAULT, D3DX_DEFAULT, 1, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, D3DX_FILTER_POINT, colorkey, ImageInfo, ByVal 0)
        If .Tex Is Nothing Then
            S2DLog.Add "Error loading Image """ & FileName & """"
            .FileName = ""
        Else
            S2DLog.Add "Image """ & FileName & """ loaded successfully"
        End If
        
        .Width = ImageInfo.Width
        .Height = ImageInfo.Height
        
        If .Width < 1 Or .Height < 1 Then
            S2DLog.Add "Width or Height < 1 """ & FileName & """"
            .FileName = ""
            If Not .Tex Is Nothing Then Set .Tex = Nothing
        End If
      End If
    End With
    
    LoadTexture = CurrentTexture
End Function

Public Function RenderTexture(textureID As Integer, _
                              Optional DestinationX As Double = 0, _
                              Optional DestinationY As Double = 0, _
                              Optional DestinationWidth As Integer = -1, _
                              Optional DestinationHeight As Integer = -1, _
                              Optional SourceWidth As Integer = -1, _
                              Optional SourceHeight As Integer = -1, _
                              Optional SourceX As Integer = 0, _
                              Optional SourceY As Integer = 0, _
                              Optional Alpha As Integer = 255, _
                              Optional Angle As Integer = 0, _
                              Optional AngleX As Integer = -1, _
                              Optional AngleY As Integer = -1, _
                              Optional DestinationZ As Integer = 0, _
                              Optional Tiled As Boolean = False, _
                              Optional Color As Long = vbWhite)
    On Error GoTo 1
    
    Dim MoveX As Single
    Dim MoveY As Single
    Dim SizeX As Single
    Dim SizeY As Single
    Dim ThetS As Single
    Dim ThetC As Single
    Dim Point0Xa As Single
    Dim Point0Ya As Single
    Dim Point1Xa As Single
    Dim Point1Ya As Single
    Dim Point2Xa As Single
    Dim Point2Ya As Single
    Dim Point3Xa As Single
    Dim Point3Ya As Single
    Dim Point0X As Single
    Dim Point0Y As Single
    Dim Point1X As Single
    Dim Point1Y As Single
    Dim Point2X As Single
    Dim Point2Y As Single
    Dim Point3X As Single
    Dim Point3Y As Single
    
    If Not OverrideZ = -1 Then DestinationZ = OverrideZ
    
    If Alpha <= 0 Then Exit Function
       
    If DestinationWidth = -1 Then
        DestinationWidth = Textures(textureID).Width
    End If
    If DestinationHeight = -1 Then
        DestinationHeight = Textures(textureID).Height
    End If
    If SourceWidth = -1 Then
        SourceWidth = Textures(textureID).Width
    End If
    If SourceHeight = -1 Then
        SourceHeight = Textures(textureID).Height
    End If
    
    If DestinationX > ScreenWidth Then Exit Function
    If DestinationY > ScreenHeight Then Exit Function
    If DestinationX < 0 - SourceWidth Then Exit Function
    If DestinationY < 0 - SourceHeight Then Exit Function
    
    If Not CurrentTexture = textureID Then
        D3DDevice.SetTexture 0, Textures(textureID).Tex
    End If
    CurrentTexture = textureID

    With Textures(textureID)
        If Not Tiled Then
            MoveX = SourceX / .Width
            MoveY = SourceY / .Height
            SizeX = (SourceX + SourceWidth) / .Width
            SizeY = (SourceY + SourceHeight) / .Height
        Else
            SizeX = DestinationWidth / .Width
            SizeY = DestinationHeight / .Height
        End If
    End With

    If Not CurrentMode = S2D_Masked And Not CurrentMode = S2D_None Then
        SetAlpha Alpha
    End If

    If Not Angle = 0 And Not Angle = 360 Then
        If AngleX = -1 Then
            AngleX = DestinationWidth / 2
        End If
        If AngleY = -1 Then
            AngleY = DestinationHeight / 2
        End If
        Point0Xa = -AngleX
        Point0Ya = -AngleY
        Point1Xa = Point0Xa + DestinationWidth
        Point1Ya = Point0Ya
        Point2Xa = Point0Xa
        Point2Ya = Point0Ya + DestinationHeight
        Point3Xa = Point0Xa + DestinationWidth
        Point3Ya = Point0Ya + DestinationHeight
        ThetS = Sin(Angle * NotPI)
        ThetC = Cos(Angle * NotPI)
        Point0X = (Point0Xa * ThetC - Point0Ya * ThetS) + DestinationX + AngleX - ScreenShiftX
        Point0Y = (Point0Xa * ThetS + Point0Ya * ThetC) + DestinationY + AngleY - ScreenShiftY
        Point1X = (Point1Xa * ThetC - Point1Ya * ThetS) + DestinationX + AngleX - ScreenShiftX
        Point1Y = (Point1Xa * ThetS + Point1Ya * ThetC) + DestinationY + AngleY - ScreenShiftY
        Point2X = (Point2Xa * ThetC - Point2Ya * ThetS) + DestinationX + AngleX - ScreenShiftX
        Point2Y = (Point2Xa * ThetS + Point2Ya * ThetC) + DestinationY + AngleY - ScreenShiftY
        Point3X = (Point3Xa * ThetC - Point3Ya * ThetS) + DestinationX + AngleX - ScreenShiftX
        Point3Y = (Point3Xa * ThetS + Point3Ya * ThetC) + DestinationY + AngleY - ScreenShiftY
    Else
        Point0X = DestinationX - ScreenShiftX
        Point0Y = DestinationY - ScreenShiftY
        Point1X = DestinationX + DestinationWidth - ScreenShiftX
        Point1Y = DestinationY - ScreenShiftY
        Point2X = DestinationX - ScreenShiftX
        Point2Y = DestinationY + DestinationHeight - ScreenShiftY
        Point3X = DestinationX + DestinationWidth - ScreenShiftX
        Point3Y = DestinationY + DestinationHeight - ScreenShiftY
    End If
    
    If MaximumActiveLights > 0 And Color = vbWhite Then
        Vertices(0) = CreateUnLitVertex(Point0X, Point0Y, DestinationZ, 0, 0, 0, MoveX, MoveY)
        Vertices(1) = CreateUnLitVertex(Point1X, Point1Y, DestinationZ, 0, 0, 0, SizeX, MoveY)
        Vertices(2) = CreateUnLitVertex(Point2X, Point2Y, DestinationZ, 0, 0, 0, MoveX, SizeY)
        Vertices(3) = CreateUnLitVertex(Point3X, Point3Y, DestinationZ, 0, 0, 0, SizeX, SizeY)

        Dim vn As D3DVECTOR
        vn = GenerateTriangleNormals(Vertices(0), Vertices(1), Vertices(2))
        Vertices(0).nx = vn.x: Vertices(0).ny = vn.y: Vertices(0).nz = vn.Z
        Vertices(1).nx = vn.x: Vertices(1).ny = vn.y: Vertices(1).nz = vn.Z
        Vertices(2).nx = vn.x: Vertices(2).ny = vn.y: Vertices(2).nz = vn.Z
        Vertices(3).nx = vn.x: Vertices(3).ny = vn.y: Vertices(3).nz = vn.Z
        
        If ZoomFactor <> 1 Then
            For i = 0 To 3
                Vertices(i).x = ((Vertices(i).x + ScreenShiftX) * ZoomFactor) - ScreenShiftX
                Vertices(i).y = ((Vertices(i).y + ScreenShiftY) * ZoomFactor) - ScreenShiftY
            Next i
        End If
    Else
        Dim C2 As ColorRGB
        C2 = SplitColor(Color)
        Color = D3DColorARGB(255, C2.r, C2.g, C2.b)
        
        LitVertices(0) = CreateLitVertex(Point0X, Point0Y, DestinationZ, Color, 0, MoveX, MoveY)
        LitVertices(1) = CreateLitVertex(Point1X, Point1Y, DestinationZ, Color, 0, SizeX, MoveY)
        LitVertices(2) = CreateLitVertex(Point2X, Point2Y, DestinationZ, Color, 0, MoveX, SizeY)
        LitVertices(3) = CreateLitVertex(Point3X, Point3Y, DestinationZ, Color, 0, SizeX, SizeY)
        
        If ZoomFactor <> 1 Then
            For i = 0 To 3
                LitVertices(i).x = ((LitVertices(i).x + ScreenShiftX) * ZoomFactor) - ScreenShiftX
                LitVertices(i).y = ((LitVertices(i).y + ScreenShiftY) * ZoomFactor) - ScreenShiftY
            Next i
        End If
    End If
    
    If Buffer >= 0 Then
    
        Dim Index As Double
    
        With BufferArray(Buffer)
        
        Dim cntBuf As Integer
        Dim newTex As Boolean
        newTex = True
        
        For cntBuf = 0 To .BufferCount
            If .VerticesBuffer(cntBuf).Texture = textureID Then
                newTex = False
                Exit For
            End If
        Next
            
        If newTex Then
        
            .BufferCount = .BufferCount + 1
            If .Dynamic Then ReDim Preserve .VerticesBuffer(.BufferCount)
            .VerticesBuffer(.BufferCount).Texture = textureID
            .VerticesBuffer(.BufferCount).VertexCount = -1
        
        End If
        
        CurrentTexture = textureID
        If Not Color = vbWhite Then .Colored = True
   
        With .VerticesBuffer(.BufferCount)
            Index = .VertexCount + 1
            .VertexCount = .VertexCount + 6
            
            If BufferArray(Buffer).Colored = False Then
                If BufferArray(Buffer).Dynamic Then ReDim Preserve .Vertex(.VertexCount)
                .Vertex(Index + 0) = Vertices(0)
                .Vertex(Index + 1) = Vertices(1)
                .Vertex(Index + 2) = Vertices(3)
                .Vertex(Index + 5) = Vertices(2)
                .Vertex(Index + 3) = .Vertex(Index)
                .Vertex(Index + 4) = .Vertex(Index + 2)
            Else
                If BufferArray(Buffer).Dynamic Then ReDim Preserve .LitVertex(.VertexCount)
                .LitVertex(Index + 0) = LitVertices(0)
                .LitVertex(Index + 1) = LitVertices(1)
                .LitVertex(Index + 2) = LitVertices(3)
                .LitVertex(Index + 5) = LitVertices(2)
                .LitVertex(Index + 3) = .LitVertex(Index)
                .LitVertex(Index + 4) = .LitVertex(Index + 2)
            End If
            
        End With
        End With
        
    Else
        If MaximumActiveLights > 0 And Color = vbWhite Then
            If Not D3DDevice.GetVertexShader = lFVF Then D3DDevice.SetVertexShader lFVF
            D3DDevice.DrawPrimitiveUP 5, 2, Vertices(0), Len(Vertices(0))
        Else
            If Not D3DDevice.GetVertexShader = vFVF Then D3DDevice.SetVertexShader vFVF
            If MaximumActiveLights > 0 Then D3DDevice.SetRenderState D3DRS_LIGHTING, 0
            D3DDevice.DrawPrimitiveUP 5, 2, LitVertices(0), Len(LitVertices(0))
            If MaximumActiveLights > 0 Then D3DDevice.SetRenderState D3DRS_LIGHTING, 1
        End If
    End If
    Exit Function
1
    S2DLog.Add "Error rendering using RenderTexture"
    
End Function

Public Function RenderOffscreen(ByVal textureID As Integer, _
                     ByVal DestinationX As Double, _
                     ByVal DestinationY As Double, _
                     Optional SourceX As Integer = 0, _
                     Optional SourceY As Integer = 0, _
                     Optional SourceWidth As Integer = -1, _
                     Optional SourceHeight As Integer = -1, _
                     Optional DestinationWidth As Integer = -1, _
                     Optional DestinationHeight As Integer = -1, _
                     Optional RotationX As Integer = 0, _
                     Optional RotationY As Integer = 0, _
                     Optional Angle As Integer = 0, _
                     Optional Alpha As Integer = 255, _
                     Optional lngColor As Long = vbWhite)
On Error GoTo 1
  
    Dim ARGBColor As Long
    Dim RGBColor  As ColorRGB
    Dim Format    As CONST_D3DFORMAT
    Dim To2D      As D3DVECTOR2
    Dim Source2D  As RECT
    Dim Scale2D   As D3DVECTOR2
    Dim Rotate2D  As D3DVECTOR2
    Dim Textu     As Texture

    Textu = Textures(textureID)
    RGBColor = SplitColor(lngColor)
    ARGBColor = D3DColorARGB(Alpha, RGBColor.r, RGBColor.g, RGBColor.b)
    
    To2D.x = DestinationX
    To2D.y = DestinationY
    
    If SourceWidth = -1 Then
        SourceWidth = Textu.Width
    End If
    If SourceHeight = -1 Then
        SourceHeight = Textu.Height
    End If
    If DestinationWidth = -1 Then
        DestinationWidth = Textu.Width
    End If
    If DestinationHeight = -1 Then
        DestinationHeight = Textu.Height
    End If
    
    If DestinationX > ScreenWidth Then Exit Function
    If DestinationY > ScreenHeight Then Exit Function
    If DestinationX < 0 - SourceWidth Then Exit Function
    If DestinationY < 0 - SourceHeight Then Exit Function
    
    If ZoomFactor <> 1 Then
        DestinationWidth = DestinationWidth * ZoomFactor
        DestinationHeight = DestinationHeight * ZoomFactor
    End If
      
    With Source2D
        .Left = SourceX
        .Top = SourceY
        .Bottom = (SourceHeight + SourceY)
        .Right = (SourceWidth + SourceX)
    End With
    
    Scale2D.x = DestinationWidth / SourceWidth
    Scale2D.y = DestinationHeight / SourceHeight
    Rotate2D.x = RotationX
    Rotate2D.y = RotationY
    
    If Angle > 0 Then
        If Angle < 360 Then
            Angle = Deg2Rad(360 - Angle)
        End If
    End If
    
    Sprite.Draw Textu.Tex, Source2D, Scale2D, Rotate2D, Angle, To2D, ARGBColor
    Exit Function
1
    S2DLog.Add "Error rendering Offscreen"

End Function

Public Function BeginBuffer(BufferID As Integer)

    Buffer = BufferID
    
End Function

Public Function EndBuffer()

    Buffer = -1
    
End Function

Public Function CreateBuffer(Optional ApproximateSize As Long = 0, Optional Colored As Boolean = False, Optional ApproximateTextureCount As Integer = 5) As Integer
    
    S2DLog.Add "Creating Buffer..."
    BufferCount = BufferCount + 1
    ReDim Preserve BufferArray(BufferCount)
    
    If ApproximateSize > 0 Then
        ReDim BufferArray(BufferCount).VerticesBuffer(ApproximateTextureCount)
        For i = 0 To ApproximateTextureCount
            If Colored = False And MaximumActiveLights > 0 Then
                ReDim BufferArray(BufferCount).VerticesBuffer(i).Vertex(ApproximateSize)
            Else
                ReDim BufferArray(BufferCount).VerticesBuffer(i).LitVertex(ApproximateSize)
            End If
        Next i
    Else
        BufferArray(BufferCount).Dynamic = True
    End If
    
    BufferArray(BufferCount).BufferCount = -1
    CreateBuffer = BufferCount
    S2DLog.Add "Buffer (" & BufferCount & ") created"
    
End Function

Public Function DestroyBuffers()

    S2DLog.Add "Destroying Buffers..."
    Erase BufferArray
    BufferCount = -1
    S2DLog.Add "All Buffers destroyed"
    
End Function

Public Sub FlushBuffer(BufferID As Integer, Optional Alpha As Integer = 255)


    SetBlending S2D_Alpha
    SetAlpha Alpha
    
    If BufferID < 0 Then Exit Sub
    With BufferArray(BufferID)
    
    If .BufferCount < 0 Then
        'keine buffer erstellt
        Exit Sub
    End If
    
    For i = 0 To .BufferCount
        With .VerticesBuffer(i)
        
            If .Texture >= 0 Then
                CurrentTexture = .Texture
                D3DDevice.SetTexture 0, Textures(CurrentTexture).Tex
            Else
                D3DDevice.SetTexture 0, Nothing
            End If
            
            If MaximumActiveLights > 0 And BufferArray(BufferID).Colored = False Then
                If Not D3DDevice.GetVertexShader = lFVF Then D3DDevice.SetVertexShader lFVF
                D3DDevice.DrawPrimitiveUP 4, (.VertexCount + 1) / 3, .Vertex(0), Len(.Vertex(0))
            Else
                If Not D3DDevice.GetVertexShader = vFVF Then D3DDevice.SetVertexShader vFVF
                If MaximumActiveLights > 0 Then D3DDevice.SetRenderState D3DRS_LIGHTING, 0
                D3DDevice.DrawPrimitiveUP 4, (.VertexCount + 1) / 3, .LitVertex(0), Len(.LitVertex(0))
                If MaximumActiveLights > 0 Then D3DDevice.SetRenderState D3DRS_LIGHTING, 1
            End If
            
        End With
    Next
    End With
    
End Sub

Public Sub ClearBuffer(ID As Integer)

    BufferArray(ID).BufferCount = -1
    
    If BufferArray(ID).Dynamic Then
        Erase BufferArray(ID).VerticesBuffer
    End If
    
End Sub

Private Function CreateUnLitVertex(ByVal x As Single, ByVal y As Single, ByVal Z As Single, ByVal nx As Long, ByVal ny As Long, ByVal nz As Long, ByVal tu As Single, ByVal tv As Single) As UnlitVertex

    With CreateUnLitVertex
        .x = x
        .y = y
        .Z = Z
        .nx = nx
        .ny = ny
        .nz = nz
        .tu = tu
        .tv = tv
    End With

End Function

Private Function CreateLitVertex(ByVal x As Single, ByVal y As Single, ByVal Z As Single, ByVal lngColor As Long, ByVal specular As Long, ByVal tu As Single, ByVal tv As Single) As LitVertex
 
    With CreateLitVertex
        .x = x
        .y = y
        .Z = Z
        .Color = lngColor
        .specular = specular
        .tu = tu
        .tv = tv
    End With

End Function

Public Property Get TextureHeight(textureID As Integer) As Integer

    On Error Resume Next
    TextureHeight = Textures(textureID).Height
    
End Property

Public Property Get TextureWidth(textureID As Integer) As Integer
    
    On Error Resume Next
    TextureWidth = Textures(textureID).Width
    
End Property

Public Function CreateTexture(Width As Integer, Height As Integer) As Long
    
    TextureCount = TextureCount + 1
    ReDim Preserve Textures(TextureCount)
    CreateTexture = TextureCount
    
    With Textures(CreateTexture)
        
        If SquareTextureLimitation Then
            S2DLog.Add "Creating Texture using squared Width/Height"
            If Width > Height Then Height = Width
            'Height = 2 ^ Int(Log(Height * 2) / Log(2))
            Width = Height
        End If
        
        .Width = Width
        .Height = Height
        Set .Tex = D3DX.CreateTexture(D3DDevice, .Width, .Height, D3DX_DEFAULT, D3DUSAGE_RENDERTARGET, D3DFMT_UNKNOWN, D3DPOOL_DEFAULT)
        Randomize Timer
        .FileName = "Offscreen|" & Rnd(10000)
        
        If .Tex Is Nothing Then
            S2DLog.Add "Error creating Texture (" & Width & "/" & Height & ")"
        Else
            S2DLog.Add "Texture (" & Width & "/" & Height & ") successfully created"
        End If
        
    End With
    
End Function

Public Function GetBlancTexture(Optional AlternativePattern As Boolean = False) As Direct3DBaseTexture8
    
    On Error Resume Next
    If BlancID <= 0 Then
        BlancID = LoadTexture(App.Path & "\point.PNG")
    End If
    
    If BlancID2 <= 0 Then
        BlancID2 = LoadTexture(App.Path & "\point2.PNG")
    End If
    
    If Not AlternativePattern Then
        Set GetBlancTexture = Textures(BlancID).Tex
    Else
        Set GetBlancTexture = Textures(BlancID2).Tex
    End If
    
End Function

Public Function SetRenderTarget(textureID As Integer)
            
    On Error GoTo 1
    Set BackBuffer = D3DDevice.GetBackBuffer(0, D3DBACKBUFFER_TYPE_MONO)
    D3DDevice.SetRenderTarget Textures(textureID).Tex.GetSurfaceLevel(0), D3DDevice.GetDepthStencilSurface, 0
    Sprite.Begin
    Exit Function
1
    S2DLog.Add "Error setting Render Target to Texture"
        
End Function

Public Function ResetRenderTarget()
    
    On Error GoTo 1
    D3DDevice.SetRenderTarget BackBuffer, D3DDevice.GetDepthStencilSurface, 0
    Sprite.End
    Exit Function
1
    S2DLog.Add "Error closing Render Target"
    
End Function

Private Function GenerateTriangleNormals(p0 As UnlitVertex, p1 As UnlitVertex, p2 As UnlitVertex) As D3DVECTOR

    Dim v01 As D3DVECTOR
    Dim v02 As D3DVECTOR
    Dim vNorm As D3DVECTOR

    D3DXVec3Subtract v01, MakeVector(p1.x, p1.y, p1.Z), MakeVector(p0.x, p0.y, p0.Z)
    D3DXVec3Subtract v02, MakeVector(p2.x, p2.y, p2.Z), MakeVector(p0.x, p0.y, p0.Z)
    D3DXVec3Cross vNorm, v01, v02
    D3DXVec3Normalize vNorm, vNorm

    GenerateTriangleNormals.x = vNorm.x
    GenerateTriangleNormals.y = vNorm.y
    GenerateTriangleNormals.Z = vNorm.Z

End Function
