Word Wrap

[MaxRaceSoftware]

a basic WordWrap program i created or modified from various source codes found on the InterNet .

it does not do a 100% percent job on every type of Text entered,
so please feel free to help improve this Source Code to handle every combination of Characters/Numbers/Etc.

[MaxRaceSoftware]

Option Explicit



Private Function IndentWordWrap(txtIn As String, LeftIndent As Byte, RightIndent As Byte, ByVal TextWidth As Byte) As String()


On Error Resume Next


Dim i As Long
Dim l As Long
Dim p() As String
Dim b() As String
ReDim b(0)
    
p = Split(txtIn, " ")
b(0) = Space(LeftIndent)
TextWidth = TextWidth + LeftIndent
    
For i = 0 To UBound(p)
    If Len(b(UBound(b))) + Len(p(i)) > TextWidth Then
         b(UBound(b)) = Left(b(UBound(b)), Len(b(UBound(b))) - 1)
         b(UBound(b)) = b(UBound(b)) & Space(TextWidth + RightIndent - Len(b(UBound(b))))
         ReDim Preserve b(UBound(b) + 1)
         b(UBound(b)) = Space(LeftIndent) & p(i) & " "
    Else
         b(UBound(b)) = b(UBound(b)) & p(i) & " "
    End If
Next
    
b(UBound(b)) = Left(b(UBound(b)), Len(b(UBound(b))) - 1)
b(UBound(b)) = b(UBound(b)) & Space(TextWidth + RightIndent - Len(b(UBound(b))))

IndentWordWrap = b
    
Dim Txt2 As String
For i = 0 To UBound(b)
    Txt2 = Txt2 & b(i) & vbCrLf
Next
    
Text2 = Txt2
    
Erase b
Erase p



End Function


Function WordWrap(ByVal Text As String, Optional ByVal MaxLineLen As Integer = 70)


'--------On Error Resume Next

Dim i As Long

For i = 1 To Len(Text) / MaxLineLen
    Text = Mid(Text, 1, MaxLineLen * i - 1) & Replace(Text, " ", vbCrLf, MaxLineLen * i, 1, vbTextCompare)
Next i
    
Text2.Text = Text
    
    
    
End Function

 
 




Private Sub Combo1_Click()


Text2 = ""

Call Combo1_KeyDown(13, 0)



End Sub


Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)


Select Case KeyCode
Case 13
    Text3.SetFocus
End Select



End Sub

Private Sub Command1_Click()


If Len(Text1) < 1 Then
    MsgBox "  ERROR = no Text to wrap " & vbCrLf & "  .... please enter Text to Wrap "
    Text1.SetFocus
    Exit Sub
End If


Dim x As Long

x = Val(Format$(Text3, "0"))

If x > 255 Then x = 255: Text3 = "255": MsgBox " you exceeded the maximum wordwrap length of 255 " & vbCrLf & " .... a value of 255 will be used"

If x < 30 Then x = 78: Text3 = "78": MsgBox " the minimum wordwrap length is 30 " & vbCrLf & " .... a value of 30 will be used"


Select Case Combo1.ListIndex
        '--------IndentWordWrap(txtIn As String, LeftIndent As Byte, RightIndent As Byte, ByVal TextWidth As Byte) As String()
Case 0: IndentWordWrap Text1, 0, 0, x
        '--------WordWrap(ByVal Text As String, Optional ByVal MaxLineLen As Integer = 70)
Case 1: WordWrap Text1, x
Case 2: Text2 = Text1
End Select


Text3.SetFocus



End Sub


Private Sub Command2_Click()


Text1.Text = ""
Text2.Text = ""
Text1.SetFocus



End Sub


Private Sub Command3_Click()


Text2.Text = ""
Text1.SetFocus



End Sub


Private Sub Command4_Click()


Unload Form1
Set Form1 = Nothing



End Sub

Private Sub Form_Load()


Me.Show

Text3 = "78"

Combo1.AddItem " IndentWordWrap function"
Combo1.AddItem " WordWrap function"
Combo1.AddItem " Direct copy"
Combo1.ListIndex = 0



End Sub

Private Sub Form_Unload(Cancel As Integer)


Unload Form1
Set Form1 = Nothing



End Sub


Private Sub Text3_Change()


Text2 = ""



End Sub

Private Sub Text3_GotFocus()


Text3.SelStart = 0
Text3.SelLength = Len(Text3.Text)



End Sub


Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)


If KeyCode = vbKeyReturn Then
    Command1.SetFocus
End If



End Sub


Private Sub Text3_KeyPress(KeyAscii As Integer)


If KeyAscii = vbKeyReturn Then
    KeyAscii = 0
End If




End Sub