Wordwrap


Function wordWrap(ByVal strOriginal As String, Optional ByVal
varMaxWidth As Variant, Optional varLeftMargin As Variant, Optional
ByVal varIndent As Variant) As String
    Dim strNewString As String
    Dim x As Integer
    Dim intBOL As Integer
    Dim intOriginalLen As Integer
    Dim strLeftMargin As String
    Dim strTemp As String

    If IsMissing(varMaxWidth) Or IsEmpty(varMaxWidth) Or
IsNull(varMaxWidth) Then
        varMaxWidth = Printer.ScaleWidth
    ElseIf Not IsNumeric(varMaxWidth) Then
        varMaxWidth = Printer.ScaleWidth
    End If
    Select Case VarType(varLeftMargin)
    Case vbString
        strLeftMargin = varLeftMargin
    Case vbInteger, vbLong, vbSingle, vbDouble, vbByte
        Do Until Printer.TextWidth(Space$(x)) >= varLeftMargin
            x = x + 1
        Loop
        strLeftMargin = Space$(x)
    Case Else
        strLeftMargin = ""
    End Select
    If IsMissing(varIndent) Or IsEmpty(varIndent) Or IsNull(varIndent)
Then
        varIndent = 0
    ElseIf Not IsNumeric(varIndent) Then
        varIndent = 0
    Else
        x = 0
        Do Until Printer.TextWidth(Space$(x)) >= varIndent
            x = x + 1
        Loop
        strOriginal = Space$(x) & strOriginal
    End If
    If varIndent = 0 Then
        If (Printer.TextWidth(strLeftMargin & strOriginal)) <=
varMaxWidth Then
            wordWrap = strLeftMargin & strOriginal
            Exit Function
        End If
    Else
        If (Printer.TextWidth(strOriginal) + varIndent) <= varMaxWidth
Then
            wordWrap = strOriginal
            Exit Function
        End If
    End If
    intOriginalLen = Len(strOriginal)
    strNewString = ""
    intBOL = 1
    x = 1
    Do Until x > intOriginalLen
        If Printer.TextWidth(Mid$(strOriginal, intBOL, (x - intBOL +
1))) > varMaxWidth Then
            Do While Mid$(strOriginal, x, 1) <> " "
                x = x - 1
                If x < intBOL Then
                    x = intBOL
                    Do While Mid$(strOriginal, x, 1) <> " "
                        x = x + 1
                        If x > intOriginalLen Then
                            Exit Do
                        End If
                    Loop
                    Exit Do
                End If
            Loop
            If strNewString = "" Then
                strNewString = Mid$(strOriginal, intBOL, (x - intBOL))
            Else
                strNewString = strNewString & vbCrLf & strLeftMargin &
Mid$(strOriginal, intBOL, (x - intBOL))
            End If
            intBOL = x + 1
        End If
        x = x + 1
    Loop
    If intBOL < x Then
        strNewString = strNewString & vbCrLf & strLeftMargin &
Mid$(strOriginal, intBOL, (x - intBOL))
    End If

    wordWrap = strNewString
End Function



Mail to Daniel Wiman <daniel@wimania.com>
Online since June 1996, updated 980315
<- The VB home
<- Daniels homepage