gopikrish
asked on
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.
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.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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
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(l
' 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
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(l
' 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
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
' move the v scroll bar
vscroll1.move picvp.width,0,vscroll1.wid
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
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
' move the v scroll bar
vscroll1.move picvp.width,0,vscroll1.wid
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
ASKER
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.
ASKER
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.