' by Marzo Junior, marzojr@taskmail.com.br, 20041027
' requires FastString typelib
Option Explicit

Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any)
Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&)

Private Header1(5) As Long
Private Header2(5) As Long
Private SafeArray1() As Integer
Private SafeArray2() As Integer


Private Sub Class_Initialize()
'Set up our template for looking at strings
  Header1(0) = 1              'Number of dimensions
  Header1(1) = 2              'Bytes per element (long = 4)
  Header1(4) = &H7FFFFFFF     'Array size
  
  'Force SafeArray1 to use Header1 as its own header
  RtlMoveMemory ByVal ArrPtr(SafeArray1), VarPtr(Header1(0)), 4
  
  'Set up our template for look at search text
  Header2(0) = 1                 'Number of dimensions
  Header2(1) = 2                 'Bytes per element (long = 4)
  Header2(4) = &H7FFFFFFF        'Array size
  
  'Force SafeArray1 to use Header1 as its own header
  RtlMoveMemory ByVal ArrPtr(SafeArray2), VarPtr(Header2(0)), 4
End Sub


Private Sub Class_Terminate()
' Make SafeArray1 once again use its own header
' If this code doesn't run the IDE will crash
  RtlMoveMemory ByVal ArrPtr(SafeArray1), 0&, 4
  RtlMoveMemory ByVal ArrPtr(SafeArray2), 0&, 4
End Sub


Friend Function WordWrap02( _
    ByRef Text As String, _
    ByVal Width As Long, _
    Optional ByRef CountLines As Long) As String
' by Marzo Junior, marzojr@taskmail.com.br, 20041027
' based on the code by Donald Lessau
  Dim i As Long
  Dim lenLine As Long
  Dim posBreak As Long
  Dim cntBreakChars As Long
  Dim ubText As Long
  
  ' no fooling around
  If Width <= 0 Then
    CountLines = 0
    Exit Function
  End If
  
  Dim lLen As Long
  lLen = Len(Text)
  
  If lLen <= Width Then  ' no need to wrap
    CountLines = 1
    WordWrap02 = Text
    Exit Function
  End If
  
  ubText = lLen - 1
  
  'Point the arrays to our strings; also, allocate the potential max string:
  Header1(3) = StrPtr(Text)
  Dim sTemp As String
  sTemp = FastString.SysAllocStringLen(ByVal 0, lLen * 3)
  Header2(3) = StrPtr(sTemp)
  
  For i = 0 To ubText
    Select Case SafeArray1(i)
    Case 32, 45 'space, hyphen
      posBreak = i
    Case Else
    End Select
    
    SafeArray2(i + cntBreakChars) = SafeArray1(i)
    lenLine = lenLine + 1
    
    If lenLine > Width Then
      If posBreak > 0 Then
        ' don't break at the very end
        If posBreak = ubText Then Exit For
        ' wrap after space, hyphen
        SafeArray2(posBreak + cntBreakChars + 1) = &HD
        SafeArray2(posBreak + cntBreakChars + 2) = &HA
        i = posBreak
        posBreak = 0
      Else
        ' cut word
        SafeArray2(i + cntBreakChars) = &HD
        SafeArray2(i + cntBreakChars + 1) = &HA
        i = i - 1
      End If
      cntBreakChars = cntBreakChars + 2
      lenLine = 0
    End If
  Next
  
  CountLines = cntBreakChars \ 2 + 1
  WordWrap02 = Left$(sTemp, lLen + cntBreakChars)
  
End Function