| I developed the following function to act as a way of breaking up a blob of text (with or without line breaks) into a neatly packaged box of text where the line breaks, once added, occur between words rather then within the words themselves. The programmer or the userer has control over the top, l eft and (most importantly) the right margin. Your right margin should be a reasonable one that allows for the length of most words before inserting a line break. In the case where a word exceeds the space provided for it the function splits it at that character. The function has two limitations, first, it's a bit slow for really large blobs of text (say hundred-thousand characters) and second, that it can't box text with a right margin less than two characters in width. The second limitation should be forgiven, as I can't see the value of splitting a single character in two pieces. Inputs:Text As String, Right As Integer, Optional Left As Integer, Optional Top As Integer, Optional Remove As Boolean Returns:String with line breaks Assumes:VB 5.0 doesn't support the Replace function. You may remove it without adverse side affects. Public Function BoxText(Text As String, _ Right As Integer, Optional Left As Integer, Optional Top As Integer, _ Optional Remove As Boolean) As String Dim LBookend As String, RBookend As String Dim Boxed As String, Temp As String, Char As String, Rows As String Dim j As Long, x As Long, diff As Integer, Pos As Long, nTest As Long Dim aCut As Integer, bCut As Long, bDone As Boolean, bEnding As Boolean If Remove Then Text = Replace(Text, vbNewLine, " ") 'take out line breaks If Right < 2 Then Exit Function 'invalid cut If Left < 0 Then Left = 0 'invalid left For j = 1 To Top 'rows down Rows = Space(Left) & Rows & vbNewLine Next j If Len(Text) <= Right Then 'No need To box Temp = Rows & Space(Left) & Text BoxText = Temp Exit Function End If LBookend = Mid(Text, 1, Right) If InStr(1, LBookend, " ") = 0 Then Char = Mid(Text, Right) Temp = Mid(Text, 1, Right - 1) & " " Text = Temp & Char End If Do While Not bDone bDone = True RBookend = Mid(Text, Len(Text) - Right) 'Test bookend If InStr(1, RBookend, " ") = 0 Then j = Len(Text) x = 0 Do While x = 0 'Loop backwards till x = InStr(j, Text, " ") 'space is found j = j - 1 Loop Temp = Mid(Text, x + 1) Char = Mid(Temp, 1, Right - 1) & " " Temp = Mid(Temp, Right) Text = Mid(Text, 1, x) & Char & Temp bDone = False End If Loop bDone = False nTest = 1 For j = 1 To Len(Text) 'Cut up middle strings x = nTest'that exceed right nTest = InStr(j, Text, " ") diff = nTest - x If diff > Right Then Char = Mid(Text, x + Right) Temp = Mid(Text, 1, x + Right - 1) & " " Text = Temp & Char End If Next j aCut = Right Temp = Mid(Text, 1, Right) Do While Not bEnding Do While Not bDone Pos = InStr(aCut, Temp, " ") If Pos = 0 Then aCut = aCut - 1 If aCut = 0 Then'There is a String in the text Boxed = Boxed & Space(Left) & Temp 'that can't be boxed : bookend BoxText = Rows & Boxed'display what's remains Exit Function End If Else Temp = Space(Left) & Mid(Temp, 1, aCut - 1) & vbNewLine Boxed = Boxed & Temp Text = Mid(Text, aCut + 1) aCut = Right Temp = Mid(Text, 1, aCut) bDone = True End If Loop bDone = False bCut = Len(Text) If bCut < Right Then 'Add on what's left Boxed = Boxed & Space(Left) & Text bEnding = True End If Loop BoxText = Rows & Boxed End Function |
Box Text (word wrap) |
Express News India | Freelance ecommerce web development India