Private Sub FillData()
Dim ComboBox As CommandBarComboBox
Dim ComboPopUp As CommandBar
Dim Gallery As CommandBarGallery
Dim Items As CommandBarGalleryItems
Dim Key As Variant
Dim count As Integer
Set ComboBox = MenuBar.Controls.Add(xtpControlComboBox, 999, "&Data", -1, False)
ComboBox.AutoComplete = False
ComboBox.Width = 500
ComboBox.DropDownItemCount = 20
ComboBox.DropDownWidth = 1000
ComboBox.DropDownListStyle = True
ComboBox.EditHint = "Data..."
ComboBox.CloseSubMenuOnClick = True
Set ComboPopUp = CommandBarsFrame.Add("ComboPopUp", xtpBarComboBoxGalleryPopup)
ComboPopUp.BarID = 1010
ComboPopUp.Title = "ComboPopUp"
Set Gallery = ComboPopUp.Controls.Add(xtpControlGallery, 1111, "Gallery")
Gallery.Width = 1000
Gallery.Height = 508
Gallery.resizable = xtpAllowResizeWidth Or xtpAllowResizeHeight
Gallery.Caption = "Gallery"
Set rstTMP = New ADODB.Recordset
rstTMP.CursorLocation = adUseClient
rstTMP.LockType = adLockReadOnly
rstTMP.CursorType = adOpenStatic
Set DataItemsListOfICD = New Scripting.Dictionary
If OpenSQL(rstTMP, clO_LIST_OF_ICD) Then
Do While Not rstTMP.EOF
DataItems.Add CVal(rstTMP("GLOICD_ID"), clBT_NUMBER), CVal(rstTMP("GLOICD_Code"), clBT_STRING) & " - " & CVal(rstTMP("GLOICD_Translation"), clBT_STRING)
rstTMP.MoveNext
Loop
End If
Set Items = CommandBarsFrame.CreateGalleryItems(1212)
Items.ItemWidth = 0
Items.ItemHeight = 38
Items.AddLabel "History"
Items.AddItem 1, "A01"
Items.AddLabel "All data"
For Each Key In DataItems.Keys
Items.AddItem Key, DataItems(Key)
Items.item(Items.count - 1).Enabled = True
Next
Set Gallery.Items = Items
Set ComboBox.CommandBar = ComboPopUp
Set Key = Nothing
Set ComboPopUp = Nothing
Set Items = Nothing
Set Gallery = Nothing
Set ComboBox = Nothing
Set rstTMP = Nothing
End Sub
Private Sub CommandBarsFrame_CommandBarKeyDown(CommandBar As XtremeCommandBars.ICommandBar, KeyCode As Long, Shift As Integer)
Dim ComboBox As CommandBarComboBox
Set ComboBox = CommandBarsFrame.FindControl(, 999)
If ComboBox Is Nothing Then Exit Sub
Select Case KeyCode
Case vbKeyBack
If Len(ComboBox.Text) > 0 Then
ComboBox.Text = Left(ComboBox.Text, Len(ComboBox.Text) - 1)
End If
Case vbKeyDelete
ComboBox.Text = ""
Case Else
ComboBox.Text = ComboBox.Text & Chr(KeyCode)
End Select
Call UpdateComboBox(ComboBox)
End Sub
Private Sub UpdateComboBox(ComboBox As CommandBarComboBox)
Dim ComboPopUp As CommandBar
Dim Gallery As CommandBarGallery
Dim Items As CommandBarGalleryItems
Dim Key As Variant
Dim results As Scripting.Dictionary
Dim count As Integer
On Error GoTo Handler
count = 0
Set results = New Scripting.Dictionary
If Len(ComboBox.Text) > 0 Then
For Each Key In DataItemsListOfICD.Keys
If InStr(1, DataItemsListOfICD(Key), ComboBox.Text, vbTextCompare) > 0 Then
results.Add Key, DataItemsListOfICD(Key)
count = count + 1
If count >= 100 Then Exit For
End If
Next
End If
Set Gallery = ComboBox.CommandBar.FindControl(xtpControlGallery, 1212)
Gallery.Items.DeleteAll
Set Items = Gallery.Items
Items.AddLabel "History"
Items.AddItem 1, "A01"
Items.AddLabel "All data"
Set ComboPopUp = Gallery.Parent
If results.count > 0 Then
For Each Key In results.Keys
Items.AddItem Key, results(Key)
Items.item(Items.count - 1).Enabled = True
Next
ElseIf Len(ComboBox.Text) > 0 Then
ComboBox.AddItem "No results: " & ComboBox.Text
End If
Set Gallery.Items = Items
Set ComboBox.CommandBar = ComboPopUp
ComboPopUp.RecalcLayout
ComboPopUp.RedrawBar
ComboPopUp.ShowPopup , ComboBox.Left, ComboBox.Top + ComboBox.Height
Dim rs As RECT
ComboBox.GetRect rs.Left, rs.Top, rs.Right, rs.Bottom
CommandBar.Controls.Find(, 999).CommandBar.ShowPopup , 50, 50
Set ComboPopUp = ComboBox.Controls.Find(, 999).CommandBar
ComboPopUp.ShowPopup , rs.Left, rs.Top
End Sub