Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Visual Basic (Classic) FAQ

What VB shoud be able to do!

How do I make a list box with different colors for each item [ PART 2] by DarkMercenary44
Posted: 21 Nov 00

Declarations to put in Form1
Dim lstitemcolor As Variant
Dim selindex As Integer

'Sets oldcolorb, and f to a variable array that has 31999 variables in it
'this will let you add up to 31999 items to your list box, hopefully, I
'haven't tested the max allotment yet

Dim oldcolorb(31999) As Variant
Dim oldcolorf(31999) As Variant

Private Sub butchange_Click()

'Calls the change item sub, passes the new text that you want on to the sub
Call changeitem(Text1.Text)
End Sub

Private Sub butnew_Click()

'Calls the additem sub, passing the text that you want to appear
'in the list

Call additem(Text1.Text)
End Sub

Private Sub chklate_Click()

'This is just a sample color, you can make it anything.  This sets
'lstitemcolor variable to the color you want it, and then the changeitem
'sub uses that to determine if it needs to change the listitem color

If chklate.Value = vbChecked Then
    lstitemcolor = vbRed
    lstitemcolor = vbBlack
End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

'This is the code that lets you use the arrow keys to scroll the
'lst box  NOT MY CODE

Select Case KeyCode
        Case vbKeyUp
            If scr1.Value - scr1.SmallChange < 0 Then
                scr1.Value = 0

                'This will prevent overscrolling (Error 380)
                scr1.Value = scr1.Value - scr1.SmallChange
            End If
        Case vbKeyDown
            If scr1.Value + scr1.SmallChange > scr1.Max Then
                scr1.Value = scr1.Max

                'This will prevent overscrolling (Error 380)
                scr1.Value = scr1.Value + scr1.SmallChange
            End If
End Select
End Sub

Private Sub Form_Load()

    'Set VScrollBar Max
    scr1.Max = lst.Height - container.Height

    'Set VScrollBar LargeChange and SmallChange
    scr1.LargeChange = scr1.Max \ 2
    scr1.SmallChange = scr1.Max \ 5
b = 0
Do While b <= 31999
    oldcolorf(b) = vbBlack
    oldcolorb(b) = vbWhite
    b = b + 1
End Sub

Private Sub lstitem_DblClick(Index As Integer)

'On DblClick, the change buttons show and the text that was stored in
'the list item is displayed in the text box

butchange.Visible = True
chklate.Visible = True
Text1.Text = lstitem(Index).Caption

'This sets the selindex to the item that was dblclicked, its like the
'selindex property of the listbox control

selindex = Index
End Sub

Private Sub lstitem_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

'This is the most important part, with out this code, you would never
'know which item that you had selected, when the mouse moves over it
'it checks to all the other items in the list , and sets all the colors
'for them back to their preseted properities, except for the ones that the
'use changes.  Then it highlights the one that the mouse is actually over

a = 0
num = lstitem.Count - 1
    If a = Index Then
        With lstitem(a)
            .BackColor = vbBlue
            .ForeColor = vbWhite
        End With
        With lstitem(a)
            .BackColor = oldcolorb(a)
            .ForeColor = oldcolorf(a)
        End With
    End If
a = a + 1
Loop Until a > num
End Sub

Private Sub scr1_Change()

'This makes the scroll bar work-Don't ask me how , I have no clue,
'this tidbit from another example i saw

lst.Top = -scr1.Value
End Sub

Public Sub additem(lsttext As String)
Dim addtoh As Integer

'This gets the next available list item
nextlistitem = lstitem.Count
'This loads a new instance of it
Load lstitem(nextlistitem)
'Sets all of the default properties for the new list item
With lstitem(nextlistitem)
    'Sets backcolor to the varable stored in the oldcolorb variable array
    .BackColor = oldcolorb(nextlistitem)
    'Sets forecolor to the variable stroed in the oldcolorf variable array
    .ForeColor = oldcolorf(nextlistitem)
    'Sets the new top position, 22 is the height of each item,in pixels
    .Top = 22 * nextlistitem
    .Left = 0
    .Width = 213
    .Height = 22

    'Sets the caption to the variable that you passed to it
    .Caption = lsttext
    .Visible = True
End With

'This calculates the bottom most items bottom corner position so that
'we can compare it to the lst box height.  390 is twips, and it equals
'22 pixels

testvar = nextlistitem * 390
'This checks to see if the bottom corner of the bottom most list item
'is greater than the height of the lst box

If testvar > lst.Height Then
    'If it is higher, then we subtract the bottom corner of the bottom
    'most item from the lst box height, that way we are cropping the
    'lst box to the exact size to fit the number of list items

    addtoh = (nextlistitem * 390) - lst.Height
    'Then we just add the difference we found above to the height of the
    'lst box

    lst.Height = lst.Height + addtoh
End If
    scr1.Max = lst.Height - container.Height
    scr1.LargeChange = scr1.Max \ 5
    scr1.SmallChange = scr1.Max \ 10
End Sub

Public Sub changeitem(txt As String)

'Resets all the presets for the lstitem that was DblClicked
With lstitem(selindex)
    .Caption = txt
    .BackColor = vbWhite
    .ForeColor = lstitemcolor
End With

'These variable arrays store the list items colors so that
'you don't loose then everytime you move your mouse over them

oldcolorb(selindex) = lstitem(selindex).BackColor
oldcolorf(selindex) = lstitem(selindex).ForeColor

'Resets the visibility of the change controls
chklate.Visible = False
butchange.Visible = False
End Sub

Hope this works out for you.  You can change the Font in the lstitem propertie, but make sure you change the height in the code, that way you don't have huge spaces between your list items.  Drop me a line and tell me if this worked for you or not. I'd love to have some feedback, and if someone could point me to someplace that explains how to make an OCX Control , then I will make one out of this code.  Thanks, darkmercenary44@earthlink.net

Back to Visual Basic (Classic) FAQ Index
Back to Visual Basic (Classic) Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close