Color an item added to a ComboBox?

barryjohnson · May 30, 2002

I have a ComboBox called "cboPlatform". I query a Access Database and populate cboPlatform from a Products Table with all the Distinct values in the Field called Platform. Then I query a second Access Database that also has a Products Table/Platform Field and compare the values in that Products Table against those already loaded in cboPlatform.

If I find a value in the second Products Table, I add it to cboPlatform. It works fine. But, I'd like to be able to set the ForeColor to vbRed for the values added from the second table. Here is my code that loads the values from the second Products Table.

Also, the values from the second table get added to the bottom of cboPlatform. I'd like to re-sort cboPlatform once I get the values from the second table -- keeping my vbRed attribute with the values from the second table.

Any ideas? Thanks

Set dbsObject = wksObject1.OpenDatabase(dbPathUser, , True)
Set rstObject1 = dbsObject.OpenRecordset( _
"SELECT DISTINCT [PLATFORM] " & _
"FROM PRODUCTS " & _
"ORDER BY [PLATFORM] ASC&quot

If rstObject1.RecordCount > 0 Then
rstObject.MoveLast
rstObject.MoveFirst
For Ndx = 1 To rstObject1.RecordCount
For Ndx1 = 0 To cboPlatform.ListCount - 1
If cboPlatform.List(Ndx1) = rstObject1.Fields "PLATFORM&quot

.Value Then
Found = True
End If

Next

If Not Found Then
cboPlatform.AddItem rstObject1.Fields("PLATFORM&quot

.Value)
''' THIS IS WHERE I FEEL I NEED TO ADD SOMETHING TO TURN
''' THE NEXT ADDEDItem vbRED IN cboPlatform
End If

Found = False
rstObject1.MoveNext
Next

''' I NEED TO DO A RE-SORT DOWN HERE, BEFORE I LEAVE THE SUB

End If

strongm · May 30, 2002

To do this with a VB combobox means delving into the depths of the Windows API, and setting the combobox up as an ownerdraw control. This involves hooks, callbacks and subclassing. You probably don't want to go there, unless you really need to.

It might be worth considering the MSFlexGrid control, which gives you individual control over fore and backcolors for every cell

CajunCenturion · May 30, 2002

strongm,
Just how much time on your hands to you have? :-D Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein

strongm · May 30, 2002

<grin>

barryjohnson · May 31, 2002

strongm, did you have any ideas to the second part of my thread? Barry

p.s. - I'f I didn't have so many other things going on right now, I might be tempted to play with the "deeper" API calls -- maybe someday.

Guest_imported · May 31, 2002

Barry, a colleague suggests you might look at the ImageCombo, which is in Common Controls 6. If it doesn't do what you want with the color, you might consider putting an icon on the ones you wanted to highlight. Jim Brown,
Johannesburg,
South Africa.
My time is GMT+2

CajunCenturion · May 31, 2002

Barry
you can do exactly what you want using a frame, text box, command button, and flexgrid.

If you're interested, I'll explain how to make it work. Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein

barryjohnson · May 31, 2002

Sure. I'd appreciate any help and I'm not opposed to changing what I have coded so far. It works well except for the re-sort problem and the highlight (color, bold, etc.) of the items added from my second database. I'm going to look into the idea presented about the icons - I don't think the ComboBox has a way to use icons, but I'm going to read up and see.

All I would like to do is denote in some way to the user that some values in cboPlatform are from our second database, and show them in the correct alphanumeric order in the cboPlatform combobox.

Thanks, Barry

CajunCenturion · May 31, 2002

Here is the code that should take care of your needs. Its a bit rough on the edges so you may need to make minor adjustments.

The Multi-Color combo box is simulated using a frame with a text box, command button, and a flex grid. The code actually treats this as a set of control arrays. The form that this is used on has two of these multi-color combo boxes on it (but the same data in each one). The text box is in the upper left corner of the frame, the command button is in the upper right corner of the frame, flush against the text box. The textbox and command button are the same height. The flex grid is as wide as the frame, and immediately below the text box and button. The frame and its three controls all have the same index value.

Sorting of the entries in the combo box is handled by creating a user defined type structure which is the node of a binary tree stored in an array. As the entries are processed, they are added to the b-tree. The flexgrid is then loaded by reading thru the tree in Left-Node-Right order. The building and walking of the tree are both recursive processes. (One improvment here would be to use a balanced b-tree).

Here is the code

'=================================================================

Option Explicit

Private Type COMBOENTRY
tStr_Option As String ' The ComboBox entry
tLng_ForeCol As Long ' The Entry Foregroud color
tLng_BackCol As Long ' The Entry Background color
tInt_LeftPtr As Integer ' B-Tree Left Ptr
tInt_RightPtr As Integer ' B-Tree Right Ptr
End Type

Dim BinaryTree() As COMBOENTRY ' This contains the tree

' global variables for general handling of activities

Dim fBol_ComboOpen As Boolean
Dim fInt_CurrSelRow As Integer
Dim fInt_CurrCombo As Integer
Dim fBol_FirstEntry As Boolean

'==========================================================

Private Sub Form_Load()

' Build the first combo box
fBol_FirstEntry = True
InitComboFrame 0
LoadCombo 0

' Build the second combo box
fBol_FirstEntry = True
InitComboFrame 1
LoadCombo 1

' Initialize our globals
fInt_CurrCombo = -1
fInt_CurrSelRow = -1
fBol_ComboOpen = False

End Sub

'------------------------------------------------------------------------------------------

Private Sub InitComboFrame(rInt_ComboId As Integer)

' Set the height of the frame to the height of the text
'(combo box closed), but keep the open height in the tag
' field of the frame. When the combobox is opened, the
' frame will be extended to expose the flexgrid

fraCombo(rInt_ComboId).Tag = Trim(fraCombo(rInt_ComboId).Height)
fraCombo(rInt_ComboId).Height = txtCombo(rInt_ComboId).Height
grdCombo(rInt_ComboId).Cols = 1
grdCombo(rInt_ComboId).Rows = 0
grdCombo(rInt_ComboId).ColWidth(0) = fraCombo(rInt_ComboId).Width
cmdCombo(rInt_ComboId).Caption = Chr(223)

End Sub

'------------------------------------------------------------------------------------------

Private Sub Form_MouseDown(rInt_Button As Integer, rInt_Shift As Integer, _
rSng_CurrX As Single, rSng_CurrY As Single)

' If there is a mouse click outside of the frame, then
' we need to close the frame

Dim lSng_FrameRight As Single
Dim lSng_FrameBottm As Single
Dim lBol_InSideFrame As Boolean

lBol_InSideFrame = False
If (fInt_CurrCombo >= 0) Then
If (rSng_CurrX >= fraCombo(fInt_CurrCombo).Left) Then
If (rSng_CurrY <= fraCombo(fInt_CurrCombo).Top) Then
lSng_FrameRight = fraCombo(fInt_CurrCombo).Left + fraCombo(fInt_CurrCombo).Width
If (rSng_CurrX <= lSng_FrameRight) Then
lSng_FrameBottm = fraCombo(fInt_CurrCombo).Top + fraCombo(fInt_CurrCombo).Height
If (rSng_CurrY >= lSng_FrameBottm) Then
lBol_InSideFrame = True
End If
End If
End If
End If
End If
If (Not lBol_InSideFrame) Then
CloseComboFrame
End If

End Sub

'------------------------------------------------------------------------------------------

Private Sub CloseComboFrame()

' When we close a frame, we relfect that in the globals

If (fInt_CurrCombo >= 0) Then
If (fBol_ComboOpen = True) Then
fBol_ComboOpen = False
fraCombo(fInt_CurrCombo).Height = txtCombo(fInt_CurrCombo).Height
End If
fInt_CurrCombo = -1
fInt_CurrSelRow = -1
End If

End Sub

'------------------------------------------------------------------------------------------

Private Sub cmdCombo_Click(rInt_ComboId As Integer)

' If we click on the Down Button, then we need to close
' an open frame if its not the one we clicked on, then
' open this one up

If (rInt_ComboId <> fInt_CurrCombo) Then
CloseComboFrame
End If
fInt_CurrCombo = rInt_ComboId
If (fraCombo(rInt_ComboId).Height = Val(fraCombo(rInt_ComboId).Tag)) Then
fBol_ComboOpen = False
fraCombo(rInt_ComboId).Height = txtCombo(rInt_ComboId).Height
Else
fBol_ComboOpen = True
fraCombo(rInt_ComboId).Height = Val(fraCombo(rInt_ComboId).Tag)
SetTopRow rInt_ComboId
End If

End Sub

'------------------------------------------------------------------------------------------

Private Sub txtCombo_GotFocus(rInt_ComboId As Integer)

' If we click on the text box, we need to close any other
' frames that are open, then continue with this one

If (rInt_ComboId <> fInt_CurrCombo) Then
CloseComboFrame
End If
fInt_CurrCombo = rInt_ComboId

End Sub

'------------------------------------------------------------------------------------------

Private Sub txtCombo_Change(rInt_ComboId As Integer)

' Update the display of the flexgrid to match what's in
' the textbox

SetTopRow rInt_ComboId

End Sub

'------------------------------------------------------------------------------------------

Private Sub SetTopRow(rInt_ComboId As Integer)

' This routine finds the best fit match in the flex grid
' and sets the flexgrid display to match

Dim lInt_Idx As Integer
Dim lBol_Found As Boolean
Dim lInt_LastRow As Integer
Dim lStr_CurrVal As String
Dim lInt_CurrLen As Integer
Dim lVar_OldColors As Variant

If (fBol_ComboOpen = True) Then
grdCombo(rInt_ComboId).Redraw = False
lStr_CurrVal = Trim(txtCombo(rInt_ComboId).Text)
lInt_CurrLen = Len(lStr_CurrVal)
lInt_Idx = -1
lBol_Found = False
lInt_LastRow = grdCombo(rInt_ComboId).Rows - 2
Do While ((lInt_Idx <= lInt_LastRow) And (lBol_Found = False))
lInt_Idx = lInt_Idx + 1
If (Left(grdCombo(rInt_ComboId).TextMatrix(lInt_Idx, 0), lInt_CurrLen) = lStr_CurrVal) Then
' Since we've found a match, we want to alter the colors
' to reflect the current row is the flexgrid. We need to
' restore the color settings of the previously row first.
If (fInt_CurrSelRow >= 0) Then
grdCombo(rInt_ComboId).Row = fInt_CurrSelRow
grdCombo(rInt_ComboId).Col = 0
lVar_OldColors = Split(grdCombo(rInt_ComboId).Tag, ":&quot

grdCombo(rInt_ComboId).CellForeColor = lVar_OldColors(0)
grdCombo(rInt_ComboId).CellBackColor = lVar_OldColors(1)
End If
' Save the selected row's colors in the tag field, so we
' restore back to the original color after de-selecting
grdCombo(rInt_ComboId).Row = lInt_Idx
grdCombo(rInt_ComboId).Col = 0
grdCombo(rInt_ComboId).Tag = Trim(grdCombo(rInt_ComboId).CellForeColor) & ":" & _
Trim(grdCombo(rInt_ComboId).CellBackColor)
fInt_CurrSelRow = lInt_Idx
grdCombo(rInt_ComboId).CellForeColor = vbYellow
grdCombo(rInt_ComboId).CellBackColor = vbBlue
grdCombo(rInt_ComboId).TopRow = lInt_Idx
lBol_Found = True
End If
Loop
grdCombo(rInt_ComboId).Redraw = True
End If

End Sub

'------------------------------------------------------------------------------------------

Private Sub grdCombo_Click(rInt_ComboId As Integer)

' update the text box with the value from the grid
txtCombo(rInt_ComboId).Text = grdCombo(rInt_ComboId).Text

End Sub

'===========================================================

Private Sub LoadCombo(rInt_ComboId As Integer)

' this part simulates the loading of the combobox. We
' are picking out the values, and the colors for that
' value and sending them to the binary tree
AddToList "Wisconsin", vbRed, vbWhite
AddToList "Montana", vbRed, vbWhite
AddToList "Arizona", vbRed, vbWhite
AddToList "Illinois", vbRed, vbWhite
AddToList "Nevada", vbRed, vbWhite
AddToList "Minnesota", vbRed, vbWhite
AddToList "Texas", vbRed, vbWhite
AddToList "Florida", vbRed, vbWhite
AddToList "Kansas", vbRed, vbWhite
AddToList "New Mexico", vbRed, vbWhite
AddToList "Maine", vbRed, vbWhite
AddToList "Colorado", vbRed, vbWhite
AddToList "Hawaii", vbYellow, vbRed
AddToList "Alabama", vbYellow, vbRed
AddToList "North Carolina", vbYellow, vbRed
AddToList "South Carolina", vbYellow, vbRed
AddToList "Oklahoma", vbYellow, vbRed
AddToList "Delaware", vbWhite, vbGreen
AddToList "New Jersey", vbWhite, vbGreen
AddToList "Kentucky", vbWhite, vbGreen
AddToList "Alaska", vbWhite, vbGreen
AddToList "Michigan", vbWhite, vbGreen
AddToList "Idaho", vbWhite, vbGreen
AddToList "Arkansas", vbBlack, vbWhite
AddToList "Georgia", vbBlack, vbWhite
AddToList "New Hampshire", vbBlack, vbWhite
AddToList "Utah", vbBlack, vbWhite
AddToList "Ohio", vbBlack, vbWhite
AddToList "Pennsylvania", vbBlack, vbWhite
AddToList "Iowa", vbBlack, vbWhite
AddToList "Mississippi", vbBlack, vbWhite
AddToList "California", vbBlack, vbYellow
AddToList "Connecticut", vbBlack, vbYellow
AddToList "Tennessee", vbBlack, vbYellow
AddToList "Missouri", vbBlack, vbYellow
AddToList "Rhode Island", vbBlack, vbYellow
AddToList "Oregon", vbBlack, vbYellow
AddToList "Louisiana", vbBlack, vbYellow
AddToList "New York", vbBlack, vbYellow
AddToList "Vermont", vbBlack, vbYellow
AddToList "Washington", vbBlack, vbYellow
AddToList "Massachusetts", vbBlack, vbYellow
AddToList "Indiana", vbCyan, vbMagenta
AddToList "West Virginia", vbCyan, vbMagenta
AddToList "Maryland", vbCyan, vbMagenta
AddToList "Nebraska", vbCyan, vbMagenta
AddToList "South Dakota", vbCyan, vbMagenta
AddToList "Wyoming", vbCyan, vbMagenta
AddToList "North Dakota", vbCyan, vbMagenta

' The B-Tree is build, so move the tree in sorted order
' to the flexgrid
MoveListToGrid rInt_ComboId

End Sub

'------------------------------------------------------------------------------------------

Private Sub AddToList(rStr_Option As String, rLng_ForeCol As Long, rLng_BackCol As Long)

' This routine starts the add to the tree routine

Dim lTyp_NewEntry As COMBOENTRY

lTyp_NewEntry.tStr_Option = rStr_Option
lTyp_NewEntry.tLng_ForeCol = rLng_ForeCol
lTyp_NewEntry.tLng_BackCol = rLng_BackCol
lTyp_NewEntry.tInt_LeftPtr = 0
lTyp_NewEntry.tInt_RightPtr = 0

' First entry is easy
If (fBol_FirstEntry = True) Then
fBol_FirstEntry = False
ReDim BinaryTree(1)
BinaryTree(1) = lTyp_NewEntry
Else
' other entries require pointer setting
ReDim Preserve BinaryTree(UBound(BinaryTree) + 1)
AddToTree lTyp_NewEntry, 1
End If

End Sub

'------------------------------------------------------------------------------------------

Private Sub AddToTree(rTyp_NewEntry As COMBOENTRY, rInt_CurrSub As Integer)

' this recursive procedure finds the node in the tree
' that will point to the new node. We will walk the tree
' via left/right points until we find our location

Dim lTyp_CurrEntry As COMBOENTRY
Dim lInt_TreeSize As Integer

lInt_TreeSize = UBound(BinaryTree)
lTyp_CurrEntry = BinaryTree(rInt_CurrSub)
If (rTyp_NewEntry.tStr_Option <= lTyp_CurrEntry.tStr_Option) Then
If (lTyp_CurrEntry.tInt_LeftPtr = 0) Then
lTyp_CurrEntry.tInt_LeftPtr = lInt_TreeSize
BinaryTree(rInt_CurrSub) = lTyp_CurrEntry
BinaryTree(lInt_TreeSize) = rTyp_NewEntry
Else
AddToTree rTyp_NewEntry, lTyp_CurrEntry.tInt_LeftPtr
End If
Else
If (lTyp_CurrEntry.tInt_RightPtr = 0) Then
lTyp_CurrEntry.tInt_RightPtr = lInt_TreeSize
BinaryTree(rInt_CurrSub) = lTyp_CurrEntry
BinaryTree(lInt_TreeSize) = rTyp_NewEntry
Else
AddToTree rTyp_NewEntry, lTyp_CurrEntry.tInt_RightPtr
End If
End If

End Sub

'------------------------------------------------------------------------------------------

Private Sub MoveListToGrid(rInt_ComboId As Integer)

' Start the Sorted Tree Walk
WalkBinaryTree rInt_ComboId, 1

End Sub

Private Sub WalkBinaryTree(rInt_ComboId As Integer, rInt_CurrSub As Integer)

' Standard Recursive Left-Node-Right B-Tree Walk Function

Dim lTyp_CurrEntry As COMBOENTRY
Dim lInt_TreeSize As Integer

' walk the left side of the tree
lTyp_CurrEntry = BinaryTree(rInt_CurrSub)
If (lTyp_CurrEntry.tInt_LeftPtr > 0) Then
WalkBinaryTree rInt_ComboId, lTyp_CurrEntry.tInt_LeftPtr
End If

' move this node into the flexgird

lTyp_CurrEntry = BinaryTree(rInt_CurrSub)
AddToGrid rInt_ComboId, lTyp_CurrEntry.tStr_Option, _
lTyp_CurrEntry.tLng_ForeCol, lTyp_CurrEntry.tLng_BackCol

' walk the right side of the tree

If (lTyp_CurrEntry.tInt_RightPtr > 0) Then
WalkBinaryTree rInt_ComboId, lTyp_CurrEntry.tInt_RightPtr
End If

End Sub

'------------------------------------------------------------------------------------------

Private Sub AddToGrid(rInt_ComboId As Integer, rStr_Option As String, _
rLng_ForeCol As Long, rLng_BackCol As Long)

' Here is where we actually add the entry to the flexgrid

grdCombo(rInt_ComboId).Rows = grdCombo(rInt_ComboId).Rows + 1
grdCombo(rInt_ComboId).Row = grdCombo(rInt_ComboId).Rows - 1
grdCombo(rInt_ComboId).Col = 0
grdCombo(rInt_ComboId).Text = rStr_Option
grdCombo(rInt_ComboId).CellForeColor = rLng_ForeCol
grdCombo(rInt_ComboId).CellBackColor = rLng_BackCol

End Sub

'==========================================================

One last thing, on the other controls of the form, we need to close any open frames when they get the focus

Private Sub txtSubject_GotFocus()

CloseComboFrame

End Sub

Hope you have some fun with this Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein

barryjohnson · May 31, 2002

I think I will be having a lot of fun, but I will try to use it. Barry

CajunCenturion · Jun 3, 2002

Barry,
There are a couple of things that you can do to improve these routines.

Since the "combo box" is in reality a flexgrid, it is not necessary to use the tag field to keep track of the original colors when changing an individual row to the highlight color. Simply use two additional columns in the flexgrid to hold the original colors. The reseting of the colors becomes much simpler.

Also, since the combo is sorted, rather than do a sequential search in SetTopRow, you can do a binary search. This should be much faster, espcially if the combo list become long.
Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein

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!

Color an item added to a ComboBox?

barryjohnson

Technical User

strongm

MIS

CajunCenturion

Programmer

strongm

MIS

barryjohnson

Technical User

Guest_imported

New member

CajunCenturion

Programmer

barryjohnson

Technical User

CajunCenturion

Programmer

barryjohnson

Technical User

CajunCenturion

Programmer

Similar threads

Part and Inventory Search

Sponsor