VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2DText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private textureID                      As Integer
Private Type Character
    x                                    As Integer
    y                                    As Integer
    Height                               As Integer
    Width                                As Integer
    Text                                 As String
End Type
Private FontCollection(0 To 255)       As Character
Private DanceCount                     As Single
Private DanceBack                      As Boolean
''Private d3dfont                        As IFontDisp
Private MainFont                       As D3DXFont
Private MainFontDesc                   As IFont
Private TextRect                       As RECT
Private fnt                            As New StdFont
Private CFm_S2D                             As cS2D_i

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

Public Sub DrawText(x As Double, _
                    y As Double, _
                    strText As String, _
                    Optional Size As Double = 1, _
                    Optional Alpha As Integer = 255, _
                    Optional Distance As Double = -2, _
                    Optional lineHeight As Double = -1)

  On Error Resume Next
  Dim CurrentTextWidth As Double
  Dim LineCount        As Integer
  Dim TextColor        As Long
  Dim LetterCount      As Integer
  Dim OnY              As Integer
  Dim ShakeOn          As Boolean
  Dim DanceOn          As Boolean
  Dim CharRotation     As Integer
  Dim TextLen          As Integer
  Dim a()              As String
  Dim B()              As String

   Dim m                As Single
'    If S2D.Support.OnlySimpleText Then
'        DrawTextSimple x, y, strText, Size, Alpha, Distance, lineHeight
'        Exit Sub
'    End If
    TextColor = vbWhite
    If lineHeight = -1 Then
        lineHeight = GetTextHeight(1)
    End If
   ' If S2D.Support.ForceAlternativeDrawingRoutine Then
   '     S2D.TexturePool.TempSprite.Begin
   ' End If
    TextLen = Len(strText) + 1
    
    Dim i As Integer
    
    For i = 1 To TextLen
        If Mid$(strText, i, 1) = "<" Then
            If Mid$(strText, i, 4) = "<br>" Then
                LineCount = LineCount + 1
                CurrentTextWidth = 0
                i = i + 4
                LetterCount = 0
                GoTo Continue
            End If
            If Mid$(strText, i, 6) = "<color" Then
                B = Split(Mid$(strText, i + 7), ")", 2)
                a = Split(B(0), ",", 3)
                TextColor = rgb(CInt(a(0)), CInt(a(1)), CInt(a(2)))
                i = i + (11 + Len(a(0)) + Len(a(1)) + Len(a(2)))
                GoTo Continue
            End If
            If Mid$(strText, i, 7) = "<shake>" Then
                ShakeOn = True
                i = i + 7
                GoTo Continue
            End If
            If Mid$(strText, i, 8) = "</shake>" Then
                ShakeOn = False
                i = i + 8
                GoTo Continue
            End If
            If Mid$(strText, i, 7) = "<dance>" Then
                DanceOn = True
                i = i + 7
                GoTo Continue
            End If
            If Mid$(strText, i, 8) = "</dance>" Then
                DanceOn = False
                CharRotation = 0
                i = i + 8
                GoTo Continue
            End If
            If Mid$(strText, i, 3) = "<i>" Then
                CharRotation = 10
                i = i + 3
                GoTo Continue
            End If
            If Mid$(strText, i, 4) = "</i>" Then
                CharRotation = 0
                i = i + 4
                GoTo Continue
            End If
        End If
Continue:
        If i >= TextLen Then
    '        If S2D.Support.ForceAlternativeDrawingRoutine Then
    '            S2D.TexturePool.TempSprite.End
    '        End If
            Exit Sub
        End If
        If i <= TextLen Then
            m = Asc(Mid$(strText, i, 1))
        End If
        LetterCount = LetterCount + 1
        If ShakeOn Then
            Randomize Timer
            OnY = y - FontCollection(m).Height / 4 + Int(FontCollection(m).Height / 2 * Rnd)
         Else 'SHAKEON = FALSE/0
            OnY = y
        End If
        If DanceOn Then
            If DanceBack Then
                DanceCount = DanceCount - 0.1
             Else 'DANCEBACK = FALSE/0
                DanceCount = DanceCount + 0.1
            End If
            If DanceCount >= 30 Then
                DanceBack = True
            End If
            If DanceCount <= -30 Then
                DanceBack = False
            End If
            CharRotation = DanceCount
        End If
     '   If S2D.Support.ForceAlternativeDrawingRoutine Then
     '       S2D.TexturePool.RenderNew textureID, x + CurrentTextWidth * Size, OnY + (LineCount * lineHeight * Size), FontCollection(m).x, FontCollection(m).y, FontCollection(m).Width * Size, FontCollection(m).Height * Size, FontCollection(m).Width * Size, FontCollection(m).Height * Size, , FontCollection(m).Height * Size, CharRotation, Alpha, TextColor
     '    Else 'S2D.SUPPORT.FORCEALTERNATIVEDRAWINGROUTINE = FALSE/0
            S2D.TexturePool.RenderTexture textureID, x + CurrentTextWidth * Size, OnY + (LineCount * lineHeight * Size), FontCollection(m).Width * Size, FontCollection(m).Height * Size, FontCollection(m).Width, FontCollection(m).Height, FontCollection(m).x, FontCollection(m).y, Alpha, CharRotation, , FontCollection(m).Height * Size
      '  End If
        If LetterCount > 0 Then
            CurrentTextWidth = CurrentTextWidth + FontCollection(m).Width + Distance
        End If
    Next i
    'If S2D.Support.ForceAlternativeDrawingRoutine Then
    '    S2D.TexturePool.TempSprite.End
    'End If

End Sub

Public Sub DrawTextSimple(ByVal x As Double, _
                          ByVal y As Double, _
                          strText As String, _
                          Optional Size As Double = 1, _
                          Optional Alpha As Integer = 255, _
                          Optional Distance As Double = 0, _
                          Optional lineHeight As Double = 10, _
                          Optional ByRef lngColor As Long = vbWhite, _
                          Optional dblWidth As Double = 9999, _
                          Optional dblHeight As Double = 9999)
If strText = "" Then Exit Sub


  Dim TextColor
  Dim a()  As String
  Dim B()  As String
  Dim clr2 As Long
  Dim clr  As ColorRGB
    clr = SplitColor(lngColor)
    TextColor = D3DColorARGB(Alpha, clr.r, clr.g, clr.B)
    fnt.Size = 8 * Size
    strText = Replace(strText, "<br>", vbCrLf)
    strText = Replace(strText, "<shake>", vbNullString)
    strText = Replace(strText, "</shake>", vbNullString)
    strText = Replace(strText, "<dance>", vbNullString)
    strText = Replace(strText, "</dance>", vbNullString)
    strText = Replace(strText, "<i>", vbNullString)
    strText = Replace(strText, "</i>", vbNullString)
    Dim i As Integer
    For i = 1 To Len(strText)
        If Mid$(strText, i, 6) = "<color" Then
            B = Split(Mid$(strText, i + 7), ")", 2)
            a = Split(B(0), ",", 3)
            TextColor = D3DColorARGB(Alpha, a(0), a(1), a(2))
            strText = Replace(strText, "<color(" & a(0) & "," & a(1) & "," & a(2) & ")>", vbNullString)
        End If
    Next i
    With TextRect
        .Top = y + Distance
        .Left = x + Distance
        .Bottom = y + dblHeight
        .Right = x + dblWidth
    End With 'TextRect
    Set MainFontDesc = fnt
    Set MainFont = D3DX.CreateFont(D3DDevice, MainFontDesc.hFont)
    clr2 = D3DColorARGB(Alpha * 0.5, 0, 0, 0)
    D3DX.DrawText MainFont, clr2, strText, TextRect, DT_TOP Or DT_LEFT
    TextRect.Top = y - Distance
    TextRect.Left = x - Distance
    Set MainFontDesc = fnt
    Set MainFont = D3DX.CreateFont(D3DDevice, MainFontDesc.hFont)
    D3DX.DrawText MainFont, TextColor, strText, TextRect, DT_TOP Or DT_LEFT

End Sub

Public Function GetTextHeight(Size As Integer) As Integer

    GetTextHeight = FontCollection(Asc("a")).Height * Size

End Function

Public Function GetTextWidth(ByVal strText As String, _
                             ByVal Size As Integer) As Integer


  Dim cWidth As Integer
Dim i As Integer
    For i = 1 To Len(strText)
        cWidth = cWidth + (FontCollection(Asc(Mid$(strText, i, 1))).Width * Size)
    Next i
    GetTextWidth = cWidth

End Function

Public Sub InitText(ByVal FontSet As String, _
                    ByVal FontMap As String)

 
  Dim tw    As String
  Dim tH    As String
  Dim TX    As Integer
  Dim Ty    As Integer
  Dim tText As String
    With fnt
        .Name = "Arial"
        .Size = 8
        .Italic = False
        .Bold = True
        .Underline = False
        .Strikethrough = False
    End With 'fnt
    Set MainFontDesc = fnt
    
    Set MainFont = D3DX.CreateFont(D3DDevice, MainFontDesc.hFont)
    'S2D.Support.AddDebugText "Added Font : " & FontSet & " using Fontmap : " & FontMap
    textureID = S2D.TexturePool.AddTexture(FontSet, rgb(255, 0, 255))
    
    Open FontMap For Input As #1
    Do Until EOF(1)
    DoEvents
        Input #1, TX, Ty, tw, tH, tText
        With FontCollection(Asc(tText))
            .x = TX
            .y = Ty
            .Width = tw
            .Height = tH
            .Text = tText
        End With 'FontCollection(Asc(tText))
    Loop
    Close #1

End Sub

