VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2DEffects"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Vertices(0 To 3) As LitVertex
Private MoreVertices() As LitVertex
Public MyPool As cS2DTexturePool

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

Dim myid As Integer

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 Sub RenderBorderRect(x As Integer, y As Integer, Width As Integer, Height As Integer, VertexColor As Long, Optional Alpha As Integer = 255, Optional BorderWidth As Integer = 1)

    RenderRectangle x - BorderWidth, y - BorderWidth, Width + 2 * BorderWidth, BorderWidth, VertexColor, VertexColor, VertexColor, VertexColor, Alpha
    RenderRectangle x, y + Height, Width + BorderWidth, BorderWidth, VertexColor, VertexColor, VertexColor, VertexColor, Alpha
    RenderRectangle x - BorderWidth, y, BorderWidth, Height + BorderWidth, VertexColor, VertexColor, VertexColor, VertexColor, Alpha
    RenderRectangle x + Width, y, BorderWidth, Height + BorderWidth, VertexColor, VertexColor, VertexColor, VertexColor, Alpha

End Sub

Public Sub RenderRectangle(x As Integer, y As Integer, Width As Integer, Height As Integer, Optional Vertex1Color As Long = vbWhite, Optional Vertex2Color As Long = vbWhite, Optional Vertex3Color As Long = vbWhite, Optional Vertex4Color As Long = vbWhite, Optional Alpha As Integer = 255)
    
    On Error Resume Next
    
    Dim toX As Double
    Dim toY As Double
    Dim toWidth As Double
    Dim toHeight As Double
    
    toX = x * ZoomFactor
    toY = y * ZoomFactor
    toWidth = Width * ZoomFactor
    toHeight = Height * ZoomFactor

    D3DDevice.SetTexture 0, MyPool.GetBlancTexture
    Vertices(0) = CreateLitVertex(toX - ScreenShiftX, toY - ScreenShiftY, 0, Vertex1Color, 0, 0, 0)
    Vertices(1) = CreateLitVertex(toX + toWidth - ScreenShiftX, toY - ScreenShiftY, 0, Vertex2Color, 0, Width / MyPool.TextureWidth(MyPool.BlancID), 0)
    Vertices(2) = CreateLitVertex(toX - ScreenShiftX, toY + toHeight - ScreenShiftY, 0, Vertex3Color, 0, 0, Height / MyPool.TextureHeight(MyPool.BlancID))
    Vertices(3) = CreateLitVertex(toX + toWidth - ScreenShiftX, toY + toHeight - ScreenShiftY, 0, Vertex4Color, 0, Width / MyPool.TextureWidth(MyPool.BlancID), Height / MyPool.TextureHeight(MyPool.BlancID))
    
    MyPool.SetAlpha Alpha
    If Not D3DDevice.GetVertexShader = vFVF Then D3DDevice.SetVertexShader vFVF
    If MaximumActiveLights > 0 Then D3DDevice.SetRenderState D3DRS_LIGHTING, 0
    D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, Vertices(0), Len(Vertices(0))
    If MaximumActiveLights > 0 Then D3DDevice.SetRenderState D3DRS_LIGHTING, 1

End Sub

Function LineLen(X1, Y1, X2, y2)

    Dim a, b As Single
    a = Abs(X2 - X1)
    b = Abs(y2 - Y1)
    LineLen = Sqr(a ^ 2 + b ^ 2)
        
End Function

Public Sub RenderLine(x As Integer, y As Integer, X2 As Integer, y2 As Integer, Optional BorderWidth As Integer = 2, Optional Vertex1Color As Long = vbWhite, Optional Vertex2Color As Long = vbWhite, Optional Alpha As Integer = 255)
    
    Dim toX As Double
    Dim toY As Double
    Dim toX2 As Double
    Dim toY2 As Double
    
    toX = x * ZoomFactor
    toY = y * ZoomFactor
    toX2 = X2 * ZoomFactor
    toY2 = y2 * ZoomFactor
    
    Dim toWidth As Integer
    toWidth = BorderWidth * ZoomFactor
    
    D3DDevice.SetTexture 0, MyPool.GetBlancTexture
    Vertices(0) = CreateLitVertex(toX - ScreenShiftX, toY - ScreenShiftY, 0, Vertex1Color, 0, 0, 0)
    Vertices(1) = CreateLitVertex(toX - toWidth - ScreenShiftX, toY + toWidth - ScreenShiftY, 0, Vertex1Color, 0, LineLen(x, y, X2, y2) / MyPool.TextureWidth(MyPool.BlancID), 0)
    Vertices(2) = CreateLitVertex(toX2 - ScreenShiftX, toY2 - ScreenShiftY, 0, Vertex2Color, 0, 0, LineLen(x, y, X2, y2) / MyPool.TextureHeight(MyPool.BlancID))
    Vertices(3) = CreateLitVertex(toX2 - toWidth - ScreenShiftX, toY2 + toWidth - ScreenShiftY, 0, Vertex2Color, 0, LineLen(x, y, X2, y2) / MyPool.TextureWidth(MyPool.BlancID), LineLen(x, y, X2, y2) / MyPool.TextureHeight(MyPool.BlancID))
    
    MyPool.SetAlpha Alpha
    If Not D3DDevice.GetVertexShader = vFVF Then D3DDevice.SetVertexShader vFVF
    If MaximumActiveLights > 0 Then D3DDevice.SetRenderState D3DRS_LIGHTING, 0
    D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, Vertices(0), Len(Vertices(0))
    If MaximumActiveLights > 0 Then D3DDevice.SetRenderState D3DRS_LIGHTING, 1
    
End Sub
