• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 230
  • Last Modified:

Splitting a string variable in a second line for listbox

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
gopikrish
Asked:
gopikrish
  • 2
  • 2
  • 2
1 Solution
 
Jaime OlivaresSoftware ArchitectCommented:
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
 
gopikrishAuthor Commented:
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
 
Jaime OlivaresSoftware ArchitectCommented:
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
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
inthedarkCommented:
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
 
inthedarkCommented:
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
 
gopikrishAuthor Commented:
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

Featured Post

Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

  • 2
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now