Re: Breaking up text keep existing linebreaks
- From: "Mike Williams" <mikea@xxxxxxxxxxxxxxxxx>
- Date: Sun, 2 Sep 2007 23:03:17 +0100
"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
.
- Prev by Date: Re: Breaking up text keep existing linebreaks
- Next by Date: Re: CHM File
- Previous by thread: Re: Breaking up text keep existing linebreaks
- Next by thread: Re: Breaking up text keep existing linebreaks
- Index(es):
Relevant Pages
|