Re: Breaking up text keep existing linebreaks

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance



"RB Smissaert" <bartsmissaert@xxxxxxxxxxxxxxxx> wrote in message news:eavWUHa7HHA.5136@xxxxxxxxxxxxxxxxxxxxxxx

Trying to put together a function that breaks up an existing
string, where:
- The existing linebreaks need to be preserved.
- There is a maximum line length, so from one linebreak to the next.
- Breaks need to happen at spaces if it can't be at a line break.
- Optionally there is a maximum length for the returned string.

I'm not entirely sure what you are trying to do, but it looks as though you want to break up the text into lines of a specified maximum character length (rather than a maximum text width) and that you want the resultant string to contain vbCrLf at the break points? If so then try the following. Drop a standard Text Box and a Command Button onto a Form and in the IDE set the TextBox Borderstyle to None, its MultiLine property to True and its Visible property to False. Then paste in the following code. Is this what you're after, or have I misunderstood your question?

Mike

Option Explicit
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
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETLINE = &HC4

Private Function BreakText _
(s1 As String, nChars As Long) As String
Dim nLines As Long, usedLines As Long
Dim nLength As Long, n As Long
Dim sBuffer As String * 100, sInitial As String * 2
Dim LineArray() As String
Me.Font.Name = "Courier New"
Set Text1.Font = Me.Font
Text1.Width = Me.TextWidth(Space$(nChars)) + _
TextWidth("x") / 2
Text1.Text = s1
sInitial = Chr$(100 - 1) & Chr(0)
nLines = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0, 0)
For n = 1 To nLines
Mid(sBuffer, 1, 2) = sInitial
nLength = SendMessage(Text1.hwnd, EM_GETLINE, _
n - 1, ByVal sBuffer)
BreakText = BreakText & _
Trim(Left(sBuffer, nLength)) & vbCrLf
Next n
End Function

Private Sub Command1_Click()
Dim sTest As String
sTest = "This is just some text to check the operation "
sTest = sTest & "of the code to break it into lines."
Print BreakText(sTest, 12)
End Sub




.



Relevant Pages

  • Re: FileSystemWatcher advice required please
    ... Private ArchiveImport As String ... Private FilesToProcess As ProcessFiles ... Public Sub Main ... Dim NoVersion As New Collection ...
    (microsoft.public.dotnet.framework)
  • Re: Is there a way to prevent a RichTextBox from scrolling?
    ... Private _isRegex As Boolean ... Public Sub New(ByVal thispattern As String, ... Dim entry As tDict ...
    (microsoft.public.dotnet.framework.windowsforms.controls)
  • MAPI Emails from Access
    ... I realize this code is quite long, but could someone take a look at the sub ... Private Const mcERR_DOH = vbObjectError + 10000 ... Private mstStatus As String ... Dim db As Database, rs As Recordset ...
    (microsoft.public.access.formscoding)
  • Re: vb6 print dialog problem
    ... Private Const HWND_BROADCAST = &HFFFF ... dmDeviceName As String * CCHDEVICENAME ... Private Declare Function WriteProfileString _ ... Dim sTemp As String * 512, ...
    (comp.lang.basic.visual.misc)
  • Re: File attributes
    ... Private Declare Function GetFullPathName Lib "kernel32" Alias ... ByVal lpFileName As String, _ ... Dim Buffer As String ... Private Const VOS_UNKNOWN = &H0 ...
    (microsoft.public.excel.programming)