Ordlängd i shoutbox

Okej.

lägg in den här koden i ett separat dokument som du sedan includar:

<%
Class clsTextSpliter

  Private strTextIn
  Private strText()
  Private intTotLen
  Private intElements

  Private intMaxLen
  Private strSpacer

  Public Function GetFixedText(ByVal strIn, ByVal intMaxLenIn, ByVal strSpacerIn)
    Dim strOutPut

    If Len(strIn) <= 0 Then
      GetFixedText = ""
      Exit Function
    Else
      strTextIn = strIn
    End if

    If IsNumeric(intMaxLenIn) AND intMaxLenIn > 0 Then
      intMaxLen = intMaxLenIn
    Else
      intMaxLen = 80 'Här ändrar du hur många tecken som ska visas innan de automatiska radbytet ska ske
    End if

    If Not IsNumeric(strSpacerIn) AND Len(strSpacerIn) > 0 Then
      strSpacer = strSpacerIn
    Else
      strSpacer = "<br>"
    End if
    
    Call SplitText()

    If intElements = 0 Then
      strOutPut = DoWord(strText(0))
    Else
      strOutPut = DoSentence()
    End if
    
    Call DoReset()
    GetFixedText = strOutPut
  End Function

  Private Sub DoReset()
    strTextIn = empty
    Redim strText(-1)
    intTotLen = empty
    intElements = -1
  End Sub

  Private Sub SplitText()
    Dim c
    Dim strTemp, ch
    
    intTotLen = Len(strTextIn)

    For c = 1 To intTotLen
      ch = Mid(strTextIn, c, 1)

      If ch = " " Then
        intElements = intElements + 1
        Redim Preserve strText(intElements)
        strText(intElements) = strTemp
        strTemp = empty
      Else
        strTemp = strTemp & ch
      End if
    Next
  
    intElements = intElements + 1
    Redim Preserve strText(intElements)
    strText(intElements) = strTemp
  End sub

  Private Function DoWord(strIn)
    Dim c, c2: c2 = 0
    Dim strTemp, ch
    Dim intLen: intLen = Len(strIn)
  
    For c = 1 To intLen
      c2 = c2 + 1
      ch = mid(strIn, c, 1)

      If c2 = intMaxLen Then
        If c = intLen Then
          strTemp = strTemp & ch
        Else
          strTemp = strTemp & ch & strSpacer
        End If

        c2 = 0
      Else
        strTemp = strTemp & ch
      End if
    Next
    DoWord = strTemp
  End Function

  Private Function DoSentence()
    Dim element
    Dim strTemp
    Dim c: c = 0
    
    For Each element In strText
      If c = intElements Then strTemp = strTemp &  DoWord(element)
      If c < intElements Then strTemp = strTemp & " " & DoWord(element)
    Next
  
    DoSentence = strTemp
  End Function
  Public Sub Class_Initialize()

    intElements = -1

  End Sub

End Class
%>

Där du sedan ska skriva ut texten skriver du såhär:

<%
Dim obj, strTestText
Set obj = New clsTextSpliter
%>

<%=obj.GetFixedText(RecSet("text"), -1, -1)%>

Tror den ska funka, ganska avancerad men det funkar fint för mig.

MVH