[INCLUDE]
GetTextExtentExPoint_FitInWidth

[CODE]
Public Function WordWrapText(ByVal hDC As Long, ByVal xText As String, ByVal MaxWidth As Long) As String
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xLong3 As Long
  Dim xChar1 As String
  
  If Not Len(xText) = 0& Then
    xText = Replace(Replace(Replace(xText, vbCrLf, vbCr), vbLf, vbCr), vbCr, vbCrLf) + vbCrLf
    xLong1 = InStr(xText, vbCrLf)
    xLong2 = 1&
    Do
      xChar1 = Mid(xText, xLong2, xLong1 - xLong2)
      Do
        xLong2 = GetTextExtentExPoint_FitInWidth(hDC, xChar1, MaxWidth)
        If xLong2 = Len(xChar1) Then
          WordWrapText = WordWrapText + vbCrLf + xChar1
          Exit Do
          ElseIf Mid(xChar1, xLong2 + 1&, 1&) = " " And Not Mid(xChar1, xLong2, 1&) = " " Then
          WordWrapText = WordWrapText + vbCrLf + Left(xChar1, xLong2)
          xChar1 = Mid(xChar1, xLong2 + 2&)
          Else
          xLong3 = InStrRev(xChar1, " ", xLong2)
          If xLong3 = 0& Then
            WordWrapText = WordWrapText + vbCrLf + Left(xChar1, xLong2)
            xChar1 = Mid(xChar1, xLong2 + 1&)
            Else
            WordWrapText = WordWrapText + vbCrLf + Left(xChar1, xLong3 - 1&)
            xChar1 = Mid(xChar1, xLong3 + 1&)
            End If
          End If
        Loop
      xLong2 = xLong1 + 2&
      xLong1 = InStr(xLong2, xText, vbCrLf)
      Loop Until (xLong1 = 0&)
    End If
  WordWrapText = Mid(WordWrapText, 3&)
  End Function
