Solved

Splitting a string variable in a second line for listbox

Posted on 2004-10-23
227 Views
Last Modified: 2010-05-02
I have a String variable called as "mess" and its assigned a very lengthy string. But the problem is when I add this "mess" to a listbox, not all portion is displayed. So how to make a part of that string variable to be displayed in second line? Can I use Split function? And also how to find the length of a variable or textbox ?


Let me paste a part of my code so that you will get a clearer idea of my part.

sql = "select * from Chatdata"
rs.Open sql, cn, adOpenDynamic, adLockOptimistic
Do While Not rs.EOF
If rs("duser") = frmLogin.gstrUsername Then
mess = rs("suser") & " tells you: " & rs("message")
rs.Delete
rs.Update
lstChat.AddItem mess
End If
rs.MoveNext
Loop
rs.Close

So as you can see I am adding that "mess" variable to lstChat. So my goal is to check if "mess" has more than 80 characters and if so then extract characters above 80 and add them as a seperate list item. So any ideas? Thanks.
0
Question by:gopikrish
    6 Comments
     
    LVL 55

    Accepted Solution

    by:
    A simple method could be:
    Do While len(mess)>0
         l = len(mess)
         lstChat.AddItem left(mess,80)
         if (l > 80) Then mess = right(mess, l-80) Else mess = ""
    Loop
     
    0
     

    Author Comment

    by:gopikrish
    Ok thanks looks like good idea but I heard if you use only the length, then you will break words in the middle. Best to use split() to break them into words.
     So suppose if I want to split that "mess" variable contents of 80 characters each or if any word is breaking then split before that word's blank space. Can you write that split statement please? Thanks.




    0
     
    LVL 55

    Expert Comment

    by:Jaime Olivares
    Have not tested, please advice:

    Dim arr
    arr = Split(mess, " ")

    line = ""
    for i = 1 to count(arr)
        l = len(arr(i))
        if len(line)+l > 80 then
             if len(line) = 0 then
                   lstChat.AddItem arr(i)
                   line = ""
             else
                   lstChat.AddItem line
                   line = arr(i)
             end if
        else
             line = line & arr(i)
        end if
    next

    if len(line) > 0 then
            lstChat.AddItem line
    end if

    0
     
    LVL 17

    Expert Comment

    by:inthedark
    Here is a fast function MakeLines that does what you need. It uses textwidth to find the width of each word.
    I use it when printing text. You can also modify it to handle justification.


    Private Sub Form_Load()

    ' create some test data
    Dim sTestString As String
    sTestString = "Mary had a little lamb."
    Do While Len(sTestString) < 1024
        sTestString = sTestString + " " + sTestString
    Loop

    Dim Lines

    ' split the long line into smaller lines
    Lines = MakeLines(Me, sTestString, List1.Width - 255 - 40)

    Dim lc As Long
    List1.Clear
    For lc = 0 To UBound(Lines)
        List1.AddItem Lines(lc)
    Next

    End Sub


    Function MakeLines(objForm As Object, psText As String, plLineWidth As Single)

    ' Returns an array of lines.
    ' each line being shorter than plLineWidth
    ' using the font data from the form/picture object objForm

    Dim lSpaceWidth As Single
    Dim lWordWidth As Single
    Dim lc As Long
    Dim lWidth As Single
    Dim lLines As Long
    Dim lStart As Long
    Dim lLength As Long
    Dim sWords() As String

    ' split into words
    sWords = Split(psText, " ")


    ' create a place to save our output lines
    Dim Lines
    Lines = Array("")
    ReDim Lines(100) ' make it bif to sve on endless redims


    lSpaceWidth = Me.TextWidth(Space(1)) ' width of one space

    lStart = 1
    lWidth = 0
    For lc = 0 To UBound(sWords)

        ' get the width of the current word
        lWordWidth = objForm.TextWidth(sWords(lc))
       
        ' will this new word fit on the end of the line?
        If lWordWidth + lWidth > plLineWidth Then
           
            ' no we are out of space, save the line
            lLines = lLines + 1
            If lLines - 1 > UBound(Lines) Then
                ReDim Preserve Lines(lLines * 2)
            End If
            Lines(lLines - 1) = Mid(psText, lStart, lLength - 1)
            lWidth = 0
            ' set start point for next line
            lStart = lLength + lStart
            lLength = 0
        End If
       
        ' save the width and actual size of the word
        lWidth = lWidth + lWordWidth + lSpaceWidth ' width
        lLength = lLength + Len(sWords(lc)) + 1 ' size
       
    Next

    ' save the final wedge into the pot
    lLines = lLines + 1
    ReDim Preserve Lines(lLines - 1)
    Lines(lLines - 1) = Mid(psText, lStart, lLength - 1)
    MakeLines = Lines

    End Function

    0
     
    LVL 17

    Expert Comment

    by:inthedark
    I think you could get a nicer look by scrapping the list box and using a picture box (say picVP) and a VScroll  to add colour and more style.

    sql = "select * from Chatdata"
    rs.Open sql, cn, adOpenDynamic, adLockOptimistic
    Dim lYPos As Long
    Dim tab1 As Single
    tab1 = 1440 * 1.5 ' create a tab point for the message 1.5 inches

    Dim DropHeight As Single

    DropHeight = Me.TextHeight("X") * 1.05  

    ' move the scrolling picture box
    PICVP.MOVE 0,0,ME.scalewidth-vscroll1.width,dropheight * 100
    ' move the v scroll bar
    vscroll1.move picvp.width,0,vscroll1.width,me.scaleheight

    picVP.CLS

    Do While Not rs.EOF
        If rs("duser") = frmLogin.gstrUsername Then
            Dim sUser As String
            Dim vMessage
            sUser = rs("suser")
            vMessage = MakeLines(picVP, CStr(rs("message")), picVP.ScaleWidth - tab1)
            rs.Delete
            rs.Update
           
            picVP.ForeColor = RGB(255, 0, 0)
            picVP.CurrentX = 10
            picVP.CurrentY = lYPos
            picVP.Print sUser;
            Dim lc As Long
            For lc = 0 To UBound(vMessage)
                if picVP.scaleheight<lYPos + DropHeight then
                     picVP.height = lYPos + DropHeight+300
                end if

                picVP.ForeColor = RGB(0, 0, 255)
                picVP.CurrentX = tab1
                picVP.CurrentY = lYPos
                picVP.Print vMessage(lc);
                lYPos = lYPos + DropHeight
            Next lc
        End If
        rs.MoveNext
    Loop
    picVP.Height = lYPos
    rs.Close

    ' set scrollbar max
    VS.Max = picVP.Height - Me.ScaleHeight

    ' here is some code for the scroll bars

    Private Sub VScroll1_Scroll()
    picVP.Top = -VScroll1.Value
    End Sub
    Private Sub VScroll1_Change()
    VScroll1_Scroll
    End Sub
    0
     

    Author Comment

    by:gopikrish
    Thanks both of you but I am sorry inthedark since I couldnt award points to you, maybe next time. Although your solution was a bit tough to understand it might help me in the future since I am still not an expert in VB.
    0

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone. Privacy Policy Terms of Use

    Featured Post

    Course: From Zero to Hero with Nodejs & MongoDB

    Interested in Node.js, but don't know where to start or how to learn it properly? Confused about how the MEAN stack pieces of MongoDB, Expressjs, Angularjs, and Nodejs fit together? Or how it's even possible to run JavaScript outside of the browser?

    Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
    Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
    Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
    This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

    877 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    11 Experts available now in Live!

    Get 1:1 Help Now