How to wrap to a text file? (RESOLVED)

[AlvaroF1]

How to wrap a 240 length textbox to a 80 length line and print it on a text file?

Thanks.

[RobDog888]

Something like this to limit the lines in a multi-line textbox on a line
by line basis.

CodeBank

[Halsafar]

Can't you just use multi-line?
I know the textbox's have a basic word-wrap built in if you have some certain properties enabled.

A wrapped box, may not save wrapped thought
It may put the NULL character at places where the linefeed is.
NULL character is that blank rectangle u see now and then.

[RobDog888]

No you cant use multi-line alone because the poster wants to
limit each lines length to 80 characters. The code allows the enter
key to make the line breaks. Then you can output to a text file
like so...(note: this ex. is limited to 10 chrs per line).

Option Explicit
 
'API Declarations:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  lParam As Any) As Long
 
'Constant Delcarations
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
 
Private Sub Command1_Click()
 
    Dim i As Integer
    Dim ar() As String
    
    ar = Split(Text1.Text, vbKeyReturn)
    Open "C:\Test.txt" For Output As #1
        For i = 0 To UBound(ar)
            Print #1, ar(i)
        Next
    Close #1
    
End Sub
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
    Dim lLen As Long
 
    'Get the length of the current line:
    lLen = SendMessage(Text1.hwnd, EM_LINELENGTH, EM_LINEINDEX, 0&)
    
    'If length is 10, don't allow more characters:
    If lLen = 10 And KeyAscii <> vbKeyReturn And KeyAscii <> vbKeyBack Then
        KeyAscii = 0
    End If
  
End Sub

[nareth]

not true. blank rects depend on the font

[RobDog888]

Actually the little squares represent an "Un-Supported" character.
Depending on either the font, encoding, or the actual character.

A backspace character of ASCII 8 is shown as a square because it
can't be displayed as a visual character.

[Halsafar]

Well so my assumtion of it being at least a null character is fairly true because it is techinally nothing..or error.

Thanks for the explanation though, I did not know that.

[RobDog888]

No prob.

I hate those little squares!

[Maverickz]

What I would do is take the whole string, read 80 characters, back up to the nearest space so you don't split a word and replace that space witha vbCrLF (vb Carriage Return/Line Feed) character and repeat until you reach the end of the string. Then write the whole string to the text file.

If I have time I will update this post later with some code.

The Mav

[AlvaroF1]

Originally posted by Maverickz
What I would do is take the whole string, read 80 characters, back up to the nearest space so you don't split a word and replace that space witha vbCrLF (vb Carriage Return/Line Feed) character and repeat until you reach the end of the string. Then write the whole string to the text file.

If I have time I will update this post later with some code.

The Mav

I think you are right. I wrote a code but it isn't working correctly:

Dim i As Integer
Select Case Len(Text1)
    Case Is <= 80
        Print #1, Text1
    Case Is <= 160
        For i = 80 To 1 Step -1
            If Mid$(Text1, i, 1) = " " Then
                Print #1, Left$(Text1, i - 1)
                Print #1, Mid$(Text1, i + 1, Len(Text1))
                Exit For
            End If
        Next i
    Case Else
        Dim z As Integer
        For i = 80 To 1 Step -1
            If Mid$(Text1, i, 1) = " " Then
                Print #1, Left$(Text1, i - 1)
                z = i + 1
                Exit For
            End If
        Next i
        For i = 160 To 81 Step -1
            If Mid$(Text1, i, 1) = " " Then
                Print #1, Mid$(Text1, z, i - 81)
                Print #1, Mid$(Text1, i + 1, 80)
                Exit For
            End If
        Next i
End Select

[nareth]

you cant use a select case you need to use a loop and midstr.

[nareth]

Dim I As Long
 
For I = 0 to Len(Text1.Text) Step 80
 Mid$(Text1.Text, I, I + 1) = vbCrLf
Next I

[Merri]

nareth, besides errorneus behavior, that wouldn't work: you can't do Mid$(Text1.Text, I, I + 1) = vbCrLf, because you can do like that only to a variable, not a property of a textbox.

[nareth]

i forgot :P

dont mind me im feeling sick

[Merri]

Hmm... I just remembered: you can use DrawTextW so that it won't draw the text, but instead looks for the size of it. You can also limit the width it draws to and I believe it might even be able to alter the string so that it adds the linechanges. Thus you could do it with one API call (if you use a fixed width font, such as FixedSys). It wouldn't work if there would be lines with too long continuous content, like 90 = characters one after another.

If someone wants to, I can take a look if it can do it.

[AlvaroF1]

Private Function QuebrarTexto(ByVal Texto As String, ByVal Tamanho As Integer) As String
    Tamanho = Tamanho + 1
    Texto = Trim$(Texto)
    Dim MeioEnter As String, Enter As String, NovaLinha As String, l As Integer, s As String, c As String, NovoTexto As String
    MeioEnter = Chr$(13)
    Enter = Chr$(13) & Chr$(10)
    Do
        l = Len(NovaLinha)
        s = InStr(Texto, " ")
        c = InStr(Texto, MeioEnter)
        If c Then
            If l + c <= Tamanho Then
                NovoTexto = NovoTexto & NovaLinha & Left$(Texto, c)
                NovaLinha = ""
                Texto = Mid$(Texto, c + 1)
                GoTo Loopar
            End If
        End If
        If s Then
            If l + s <= Tamanho Then
                NovaLinha = NovaLinha & Left$(Texto, s)
                Texto = Mid$(Texto, s + 1)
            ElseIf s > Tamanho Then
                NovoTexto = NovoTexto & Enter & Left$(Texto, Tamanho)
                Texto = Mid$(Texto, Tamanho + 1)
            Else
                NovoTexto = NovoTexto & NovaLinha & Enter
                NovaLinha = ""
            End If
        Else
            If l Then
                If l + Len(Texto) > Tamanho Then
                    NovoTexto = NovoTexto & NovaLinha & Enter & Texto & Enter
                Else
                    NovoTexto = NovoTexto & NovaLinha & Texto & Enter
                End If
            Else
                NovoTexto = NovoTexto & Texto & Enter
            End If
            Exit Do
        End If
Loopar:
    Loop
    QuebrarTexto = NovoTexto
End Function
 
Private Sub Command1_Click()
    Open "C:\MeuArquivo.txt" For Output As #1
        Print #1, QuebrarTexto(Text1, 80)
    Close #1
End Sub