Source code for Issue Number 60

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this source code into a module called basStrings and include it in your project.

'----------------------------------------------------------------------
'
'   Module Name:    basStrings
'   Written By:     C&D Programming Corp.
'   Create Date:    10/98
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Function WordWrap(sText As String, ByVal lMaxWidth As Long) As String
    Dim lStart As Long
    Dim lEnd As Long
    Dim lTextLen As Long
    Dim sSep As String

    ' setup length and starting positions
    lTextLen = Len(sText)
    lStart = 1
    lEnd = lMaxWidth
    ' look for the following separator
    sSep = " "
    Do While lEnd < lTextLen
        ' Parse back to white space
        Do While InStr(sSep, Mid$(sText, lEnd, 1)) = 0
            lEnd = lEnd - 1
            ' Don't send us text with words longer than the lines!
            If lEnd <= lStart Then
                WordWrap = sText
                Exit Function
            End If
        Loop
        ' build wrapped string
        WordWrap = WordWrap & Mid$(sText, lStart, lEnd - lStart + 1) & vbCrLf
        ' adjust pointers into original string
        lStart = lEnd + 1
        lEnd = lStart + lMaxWidth
    Loop
    ' get last bit of string if necessary
    WordWrap = WordWrap & Mid$(sText, lStart)
End Function