split string after x characters? 5

[ale1981]

I would like to split a string if it is over x characters long after x amount of characters, is this possible? for example;

string = "this is one long line of text"

string1 = "this is one long line"
string2 = "of text"

the split can not split in the middle of words.

 

[HarleyQuinn]

I'll bite Mr Strong...

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[ale1981]

strongm, explain...?!

 

[strongm]

Ok - here's one illustration of what I mean

Try calling each of them with ... oh ...

"Deceptively simple line breaking"

with required width of 11, and then of 10

which should come out as

[tt]Deceptively
simple line
breaking[/tt]

and

[tt]Deceptivel
y simple
line
breaking[/tt]

Also, try

"This is an example"

with a required width of 10, and then of 9, and 11

which should give

[tt]This is an
example[/tt]

and

[tt]This is
an
example[/tt]

and
[tt]
This is an
example
[/tt]
All of which demonstrate what happens at certain boundary conditions for each of the functions.

And what about if you have a tab? e.g try

"Another" & vbTab & "example"

and a width of 8

which should give you

[tt]Another
example[/tt]

 

[ale1981]

I see what you mean, lucky for me that the line break is going to be after 85 characters.

Do you have a fix for any of the above functions to solve the problems you mentioned?

 

[HarleyQuinn]

strongm,

If I change the pattern in mine to match spaces or word boundaries and trim the result it works as I would expect it to for most cases.

.Pattern = "(^|\b|\s).{1," & LineLen & "}(\s|\b|$)"
    For Each m In .Execute(StringIn)
        SplitString = SplitString & Trim(m) & vbCrLf
    Next m

Output:

Deceptively
simple line
breaking

simple
line
breaking

This is an
example

This is
an
example

This is an
example

Another 
example

Having looked at the OP's original couple of posts I think using "Deceptively simple line breaking" with a split of 10 should not produce the output you posted. I think it should either skip the word (as my code does in the form above) or more appropriately flag to the user that the word is longer than the split so it could be split onto two lines. This is because ale said they didn't want to split words over lines.

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[strongm]

>lucky for me that the line break is going to be after 85 characters

Try

"And now for a further example that demonstrates the problems with a larger width than the previous examples have shown"

with a width of 85 ...

 

[MakeItSo]

I want to display the message (via a message box) in the application.

What if you not display it in a message box but on a label in a small custom user form?
I've just given that a try and the text wraps nicely without you having to bother anything about splitting it up.

Dim msg As String

msg = "This is some incredibly looooong message. A messagebox displaying this text will surely not look any kind of presentable at all let alone wrap it properly!"
UserForm1.Label1.Caption = msg
UserForm1.Show

;-)

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[ale1981]

strongm,

That example with a width of 85 works exactly as I would expect using HarleyQuinn's latest changes?

 

[TonyJollans]

I fully accept that my code would not cater for all situations, but that last example is interesting and raises the question as to why the original requirement. Do you know anything about the default line breaking algorithm?

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[strongm]

MakeItSo, quite so. This is what I was alluding to in one of my first posts when I said that "Windows has a built-in method for doing this"

ale1981, I posted my comment before seeing HQs latest changes.

 

[ale1981]

As I stated earlier in this thread I required it to be displayed in a message box, not a label, i can not modify the window to add a label and a label does not attract as much attention as a message box.

 

[HarleyQuinn]

MakeItSo is eluding to using another form with a label on to simulate a messagebox, i.e. it the label does the wrapping leg-work for you rather than a custom function (as strongm has been leading to for a while...).

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[ale1981]

I get what they are both trying to say, but unfortunately I can not modify or add forms to the application I can however modify the VBA that sits behind the current forms which is why I decided on a message box.

 

[strongm]

>I can not modify or add forms to the application

Cheat ...

Something like:

[blue]Option Explicit

Dim WithEvents cmdOK As CommandButton
Dim cheatform As UserForm1 ' choose a form that doesn't have any initialisation or termination code ...


' Illustrative only ...
Public Sub wombat()
     
    Dim mylabel As Label ' this will do our linebreaking for us ...
    Dim coverup As Object
    
    Set cheatform = New UserForm1
    Set coverup = cheatform.Controls.Add("Forms.Frame.1", , True)
    
    
    coverup.Width = cheatform.Width
    coverup.Height = cheatform.Height

    Set cmdOK = coverup.Controls.Add("Forms.CommandButton.1", , True)
    cmdOK.Caption = "OK"
    'cmdOK.Visible = True

    Set mylabel = coverup.Controls.Add("Forms.Label.1", , True)
    With mylabel
        .AutoSize = True
        .WordWrap = True
        .Width = 200
        .Visible = True
        .Caption = "And now for a further example that demonstrates the problems with a larger width than the previous examples have shown"
    End With
    cmdOK.Top = mylabel.Height + 10
    cmdOK.Left = (cheatform.Width - cmdOK.Width) / 2

    cheatform.Show
End Sub

Private Sub cmdOK_Click()
    Unload cheatform
End Sub[/blue]

 

[strongm]

(oh, and Microsoft noticed that message boxes could look ugly with long lines, so Vista and Windows 7 messageboxes do line breaking for you)

 

[ale1981]

Thanks strongm, will give this a go

I think it may be a long time until our company upgrades to Windows 7!

 

[HarleyQuinn]

Awww, the wombat is back

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[strongm]

 

[MakeItSo]

Ah yes, the infamous wombat - and such a nice one at that!
That's a handy piece of code, strongm!
Will archive that right away...


[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[strongm]

And for those that want an alternative way to get the default Windows linebreaking try the following (which is substantially more complex than my original VB version becasue of differences in the Forms 2 implementation of controls which has forced rather more of the API to be used ...):

[blue]Option Explicit

Private Const WS_CHILD = &H40000000
Private Const ES_MULTILINE = &H4&
Private Const EM_FMTLINES = &HC8
Private Const WM_GETTEXT = &HD
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETFONT = &H30

Private Type Size
        cx As Long
        cy As Long
End Type

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
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 Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function GetTextExtentPoint Lib "gdi32" Alias "GetTextExtentPointA" (ByVal hdc As Long, ByVal lpszString As String, ByVal cbString As Long, lpSize As Size) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Function vbLinebreakText(ByVal strSource As String, ByVal lBreakPos As Long) As String
    Dim myfont As Long
    Dim myDC As Long
    Dim oldfont As Long
    Dim StringExtent As Size
    Dim hWndEdit As Long
    Dim strOutput As String
    
    lBreakPos = lBreakPos + 1
    
    ' create a default fixed width font to use. 
    myfont = CreateFont(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "Courier New")
    
    ' Step 1 - establish how many pixels wide our edit box needs to be to match requested breakpoint
    myDC = GetDC(GetDesktopWindow)  ' Leverage the desktop's DC
    oldfont = SelectObject(myDC, myfont) ' Now select our fixed width font into the DC
    Call GetTextExtentPoint(myDC, String(lBreakPos, "W"), lBreakPos, StringExtent) ' OK, StringExtent now has size we need

    ' We need a multiline edit control with an hWnd for this trick to work. Which means we have to revert to the API if using VBA Forms
    ' This one is 'owned' by the desktop. Use the width we've calculated
    If hWndEdit = 0 Then hWndEdit = CreateWindowEx(0&, "edit", "", WS_CHILD Or ES_MULTILINE, 0&, 0&, StringExtent.cx, StringExtent.cy * 10, GetDesktopWindow, 0&, 0&, 0&)

    ' Match the font that was used in the DC for the width calculation
    SendMessage hWndEdit, WM_SETFONT, myfont, 0
    
    ' Now do the magic
    SendMessage hWndEdit, WM_SETTEXT, 0&, ByVal strSource
    SendMessage hWndEdit, EM_FMTLINES, 1, 0& ' apply Windows default linebreaking algorithm

    'Retrieve the string which now includes soft breaks
    strOutput = Space(SendMessage(hWndEdit, WM_GETTEXTLENGTH, 0, 0) + 1)
    SendMessage hWndEdit, WM_GETTEXT, Len(strOutput), ByVal strOutput
    vbLinebreakText = Replace(strOutput, vbCr & vbCr, vbCr)
    
    ' All done, so tidy up GDI and window objects
    SelectObject myDC, oldfont 'select original font back in
    If myfont <> 0 Then DeleteObject myfont
    If myDC <> 0 Then DeleteDC myDC ' dispose of the DC as we don't need it anymore
    If hWndEdit <> 0 Then DestroyWindow hWndEdit
End Function[/blue]