Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How do I make a list box with different colors for each item [ PART 2]

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 Nov 21, 2000 (Edited Nov 21, 2000)

[color green]Declarations to put in Form1[/color]

Code:

Dim lstitemcolor As Variant
Dim selindex As Integer

[color green]'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[/color]

Code:

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


Private Sub butchange_Click()

[color green]'Calls the change item sub, passes the new text that you want on to the sub[/color]

Code:

Call changeitem(Text1.Text)
End Sub

Private Sub butnew_Click()

[color green]'Calls the additem sub, passing the text that you want to appear
'in the list[/color]

Code:

Call additem(Text1.Text)
End Sub

Private Sub chklate_Click()

[color green]'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[/color]

Code:

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

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

[color green]'This is the code that lets you use the arrow keys to scroll the
'lst box NOT MY CODE[/color]

Code:

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

[color green]'This will prevent overscrolling (Error 380)[/color]

Code:

Else
                scr1.Value = scr1.Value - scr1.SmallChange
            End If
        Case vbKeyDown
            If scr1.Value + scr1.SmallChange > scr1.Max Then
                scr1.Value = scr1.Max

[color green]'This will prevent overscrolling (Error 380)[/color]

Code:

Else
                scr1.Value = scr1.Value + scr1.SmallChange
            End If
End Select
End Sub

Private Sub Form_Load()

[color green] 'Set VScrollBar Max[/color]

Code:

scr1.Max = lst.Height - container.Height

[color green]'Set VScrollBar LargeChange and SmallChange[/color]

Code:

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
Loop
End Sub


Private Sub lstitem_DblClick(Index As Integer)

[color green]'On DblClick, the change buttons show and the text that was stored in
'the list item is displayed in the text box[/color]

Code:

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

[color green]'This sets the selindex to the item that was dblclicked, its like the
'selindex property of the listbox control[/color]

Code:

selindex = Index
End Sub

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

[color green]'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[/color]

Code:

a = 0
num = lstitem.Count - 1
Do
    If a = Index Then
        With lstitem(a)
            .BackColor = vbBlue
            .ForeColor = vbWhite
        End With
    Else
        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()

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

Code:

lst.Top = -scr1.Value
End Sub



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

[color green]'This gets the next available list item[/color]

Code:

nextlistitem = lstitem.Count

[color green]'This loads a new instance of it[/color]

Code:

Load lstitem(nextlistitem)

[color green]'Sets all of the default properties for the new list item[/color]

Code:

With lstitem(nextlistitem)

[color green]'Sets backcolor to the varable stored in the oldcolorb variable array[/color]

Code:

.BackColor = oldcolorb(nextlistitem)

[color green]'Sets forecolor to the variable stroed in the oldcolorf variable array[/color]

Code:

.ForeColor = oldcolorf(nextlistitem)

[color green]'Sets the new top position, 22 is the height of each item,in pixels[/color]

Code:

.Top = 22 * nextlistitem
    .Left = 0
    .Width = 213
    .Height = 22

[color green]'Sets the caption to the variable that you passed to it[/color]

Code:

.Caption = lsttext
    .Visible = True
End With

[color green]'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[/color]

Code:

testvar = nextlistitem * 390

[color green]'This checks to see if the bottom corner of the bottom most list item
'is greater than the height of the lst box[/color]

Code:

If testvar > lst.Height Then

[color green]'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[/color]

Code:

addtoh = (nextlistitem * 390) - lst.Height

[color green]'Then we just add the difference we found above to the height of the
'lst box[/color]

Code:

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)

[color green]'Resets all the presets for the lstitem that was DblClicked[/color]

Code:

With lstitem(selindex)
    .Caption = txt
    .BackColor = vbWhite
    .ForeColor = lstitemcolor
End With

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

Code:

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

[color green]'Resets the visibility of the change controls[/color]

Code:

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

Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.

Accept Learn more…

Back

Top