vbAccelerator - Contents of code file: vbalCboEx6.ctl

VERSION 5.00
Begin VB.UserControl vbalCboEx 
   BackColor       =   &H80000005&
   ClientHeight    =   540
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3330
   ScaleHeight     =   540
   ScaleWidth      =   3330
   ToolboxBitmap   =   "vbalCboEx6.ctx":0000
End
Attribute VB_Name = "vbalCboEx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Implements ISubclass

Public Enum ECCXExtendedStyle
   eccxNoEditImage = CBES_EX_NOEDITIMAGE
   eccxNoImages = CBES_EX_NOEDITIMAGEINDENT
   eccxCaseSensitiveSearch = CBES_EX_CASESENSITIVE
End Enum
Public Enum EDriveType
   DRIVE_REMOVABLE = 2
   DRIVE_FIXED = 3
   DRIVE_REMOTE = 4
   DRIVE_CDROM = 5
   DRIVE_RAMDISK = 6
End Enum
Public Enum ECCXComboStyle
   eccxDropDownCombo
   eccxSimple
   eccxDropDownList
End Enum
' End edit reasons:
Public Enum ECCXEndEditReason
   CBENF_KILLFOCUS = 1
   CBENF_RETURN = 2
   CBENF_ESCAPE = 3
   CBENF_DROPDOWN = 4
End Enum
Public Enum ECCXDrawMode
    ' -- Owner draw styles --
    eccxDrawDefault              ' default comboboxex draw
    eccxDrawDefaultThenClient    ' default comboboxex draw then raise DrawItem
     event
    eccxDrawODCboList            ' ODCboLst style draw
    eccxDrawODCboListThenClient  ' ODCboLst style draw then raise DrawItem event
    eccxOwnerDraw                ' you do all drawing yourself
    
    ' -- Special styles --
    eccxColourPickerWithNames
    eccxColourPickerNoNames
    eccxSysColourPicker
    eccxFontPicker
    eccxDriveList
End Enum

' Column type enums
Public Enum ECCXColumnType
   eccxTextString = 0       ' The default - draw as text, sort as text
   eccxTextNumber = 1       ' Convert to number during sort
   eccxTextDateTime = 2     ' Convert to date for sort
   eccxImageListIcon = 4    ' Convert to icon index in image list & assume
    numeric during sort
End Enum

Private m_hWnd As Long
Private m_hWndCbo As Long
Private m_hWndEdit As Long
Private m_hWndParent As Long
Private m_hWndDropDown As Long

Private m_bSubclass As Boolean
Private m_hFnt As Long
Private m_hFntOld As Long
Private m_tlF As LOGFONT
Private m_hUFnt As Long
Private m_tULF As LOGFONT
Private m_fnt As StdFont
Private m_bInFocus As Boolean
Private m_bEvents As Boolean
Private m_bDesignTime As Boolean
Private m_oBackColor As OLE_COLOR
Private m_hBrBack As Long
Private m_oForeColor As OLE_COLOR

Private m_eStyle As ECCXComboStyle
Private m_bSorted As Boolean
Private m_bExtendedUI As Boolean
Private m_eExStyle As ECCXExtendedStyle
Private m_eClientDraw As ECCXDrawMode

Private m_hIml As Long
Private m_lIconSizeY As Long
Private m_bEnabled As Boolean
Private m_bRedraw As Boolean
Private m_lWidth As Long
Private m_lMaxLength As Long
Private m_lNewIndex As Long

Private m_iColCount As Long
Private m_lColWidth() As Long
Private m_eCoLType() As ECCXColumnType

' Auto complete mode for drop-down combo boxes:
Private m_bDoAutoComplete As Boolean
Private m_bOnlyAutoCompleteItems As Boolean
Private m_bDataIsSorted As Boolean

Private m_IPAOHookStruct As IPAOHookStruct

Public Event AutoCompleteSelection(ByVal sItem As String, ByVal lIndex As Long)
Attribute AutoCompleteSelection.VB_Description = "Raised whenever the Auto
 Complete mode selects an item."
Public Event BeginEdit(ByVal iIndex As Long)
Attribute BeginEdit.VB_Description = "Raised when the user begins editing the
 text box section of the ComboBox."
Public Event Change()
Attribute Change.VB_Description = "Raised when the text in the combo box is
 changed."
Public Event Click()
Attribute Click.VB_Description = "Raised when the user selects an item by
 clicking on it and when the ListIndex property is set in code."
Public Event CloseUp()
Attribute CloseUp.VB_Description = "Raised when the ComboBox portion of the
 control is closed up."
Public Event DblClick()
Attribute DblClick.VB_Description = "Raised when the control is double clicked."
Public Event DrawItem(ByVal ItemIndex As Long, ByVal hdc As Long, ByVal
 bSelected As Boolean, ByVal bEnabled As Boolean, ByVal LeftPixels As Long,
 ByVal TopPixels As Long, ByVal RightPixels As Long, ByVal BottomPixels As
 Long, ByVal hFntOld As Long)
Attribute DrawItem.VB_Description = "Raised when an item in the combo box must
 be drawn."
Public Event DropDown()
Attribute DropDown.VB_Description = "Raised whenever the drop-down portion of
 the combo-box is shown."
Public Event EndEdit(ByVal iIndex As Long, ByVal bChanged As Boolean, ByVal
 sText As String, ByVal eWHy As ECCXEndEditReason, ByVal iNewIndex As Long)
Attribute EndEdit.VB_Description = "Raised when the user finished editing the
 text portion of the Combo Box."
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Attribute KeyDown.VB_Description = "Raised when a KeyDown occurs in the
 control."
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Attribute KeyUp.VB_Description = "Raised when a KeyUp occurs in the control."
Public Event KeyPress(KeyAscii As Integer)
Attribute KeyPress.VB_Description = "Raised when a Key is pressed  in the
 control."
Public Event RequestDropDownResize(ByRef lLeft As Long, ByRef lTop As Long,
 ByRef lRight As Long, ByRef lBottom As Long, ByRef bCancel As Boolean)
Attribute RequestDropDownResize.VB_Description = "Raised when the drop down
 portion of the control is about to be shown.  You can customise the position
 at which the drop down appears."

Private Sub pDefaultDrawItem( _
        ByVal hdc As Long, _
        ByVal ItemId As Long, _
        ByVal ItemAction As Long, _
        ByVal ItemState As Long, _
        ByVal Left As Long, ByVal Top As Long, ByVal Right As Long, ByVal
         Bottom As Long _
    )
Dim tR As RECT, tIR As RECT, tTR As RECT
Dim hPen As Long, hPenOld As Long
Dim hBrush As Long
Dim sItem As String
Dim lCol As Long
Dim tP As POINTAPI
Dim hMem As Long
Dim bSelected As Boolean
Dim iColCount As Integer
Dim lLeft As Long
Dim bFocus As Boolean
Dim lFocus As Long

   ' Debug.Print "DefaultDrawItem"
   lFocus = GetFocus()
   bFocus = ((lFocus = m_hWnd) Or (lFocus = m_hWndParent)) Or (lFocus =
    m_hWndCbo) Or (lFocus = m_hWndEdit)
   
   ' Determine the default draw mechanism:
   Select Case m_eClientDraw
   Case eccxColourPickerNoNames, eccxColourPickerWithNames, eccxSysColourPicker
       ' Do ColourPicker:
       pDrawColorPicker hdc, ItemId, ItemAction, ItemState, Left, Top, Right,
        Bottom
       
   Case eccxDrawODCboList, eccxDrawODCboListThenClient
      With tR
          .Left = Left
          .Top = Top
          .Right = Right
          .Bottom = Bottom
      End With
      ' Debug.Print ItemId
      If (ItemId <> -1) Then
          sItem = List(ItemId)
      Else
          sItem = ""
      End If
      '' Debug.Print sItem, hdc, left, Right, tOp, Bottom
      
      If (ItemState And ODS_DISABLED) = ODS_DISABLED Then
         
         lLeft = tR.Left
         If (ItemState And ODS_COMBOBOXEDIT) <> ODS_COMBOBOXEDIT Then
            tR.Left = tR.Left + ItemIndent(ItemId)
         End If
          
         If (ItemId > -1) Then
            If (ItemIcon(ItemId) > -1) Then
               ImageList_DrawEx m_hIml, ItemIcon(ItemId), hdc, tR.Left + 2,
                tR.Top, 0, 0, CLR_NONE, GetSysColor(vbWindowBackground And
                &H1F&), ILD_TRANSPARENT Or ILD_SELECTED
               tR.Left = tR.Left + m_lIconSizeY + 4
            End If
         End If
         If (ItemState And ODS_SELECTED) = ODS_SELECTED Then
            lCol = GetSysColor(vbButtonFace And &H1F&)
            SetBkColor hdc, lCol
            lCol = GetSysColor(vbWindowBackground And &H1F&)
            SetBkMode hdc, OPAQUE
         Else
            lCol = GetSysColor(vbButtonShadow And &H1F&)
            SetBkMode hdc, TRANSPARENT
         End If
         tR.Top = tR.Top + 1
         SetTextColor hdc, lCol
          
          pDrawText hdc, ItemState, sItem, lLeft, DT_WORD_ELLIPSIS Or
           DT_SINGLELINE Or DT_LEFT, tR
          
      Else
          SetBkMode hdc, OPAQUE
          ' Set the forecolour to use for this draw:
          
          ' Determine selection state:
          bSelected = ((ItemState And ODS_SELECTED) = ODS_SELECTED)
          If (bSelected) Then
              ' Only draw selected in the combo when the
              ' focus is on the control:
              If (ItemState And ODS_COMBOBOXEDIT) = ODS_COMBOBOXEDIT Then
                  bSelected = False
              End If
          End If
          
          ' Set the Text Colour of the DC to according to
          ' the selection state:
          If bSelected Then
             ' Draw selected:
             If m_eStyle <> eccxDropDownList Or bFocus Then
                lCol = GetSysColor(vbHighlightText And &H1F&)
                SetTextColor hdc, lCol
                lCol = GetSysColor(vbHighlight And &H1F&)
             Else
                lCol = GetSysColor(vbWindowText And &H1F&)
                SetTextColor hdc, lCol
                OleTranslateColor m_oBackColor, 0, lCol
                 'GetSysColor(vbWindowBackground And &H1F&)
             End If
          Else
              ' Draw normal:
              OleTranslateColor UserControl.ForeColor, 0, lCol
              SetTextColor hdc, lCol
             ' Determine the back colour for this item:
             OleTranslateColor m_oBackColor, 0, lCol
          End If
                      
          
         ' We only need to clear the background when
         ' the entire list box is being redrawn, or when
         ' the full-row select mode is on and the row is
         ' selected (this avoids some flicker):
         If (ItemAction = ODA_SELECT) Then
            'hBrush = CreateSolidBrush(lCol)
            'LSet tTR = tR
            'FillRect hdc, tTR, hBrush
            'DeleteObject hBrush
         End If
         
         SetBkColor hdc, lCol
          
          lLeft = tR.Left
                      
          ' Show the indent if this is not the edit box
          ' portion of the combo box:
          If (ItemState And ODS_COMBOBOXEDIT) <> ODS_COMBOBOXEDIT Then
              tR.Left = tR.Left + ItemIndent(ItemId)
          End If
          
          ' If we have an icon, then draw it:
          If (ItemIcon(ItemId) > -1) Then
            ' Use the image list handle specified via the
            ' ImageList property:
            ImageList_Draw m_hIml, ItemIcon(ItemId), hdc, tR.Left + 2, tR.Top,
             ILD_TRANSPARENT
              ' Adjust draw position for the icon:
              tR.Left = tR.Left + m_lIconSizeY + 4
          End If
                    
          ' Draw the text of the item:
          pDrawText hdc, ItemState, sItem, lLeft, DT_SINGLELINE Or
           DT_WORD_ELLIPSIS Or DT_NOPREFIX Or DT_LEFT, tR
          
      End If
   End Select
End Sub
Private Sub pDrawColorPicker( _
        ByVal hdc As Long, _
        ByVal Index As Long, _
        ByVal ItemAction As Long, _
        ByVal ItemState As Long, _
        ByVal LeftPixels As Long, ByVal TopPixels As Long, ByVal RightPixels As
         Long, ByVal BottomPixels As Long _
    )
Dim tR As RECT, hBrush As Long, tS As RECT
Dim bSelected As Boolean
Dim lCol As Long
    
   If (Index <> -1) Then
      ' Debug.Print "DrawColorPicker"
    
      bSelected = ((ItemState And ODS_SELECTED) = ODS_SELECTED)

      SetBkMode hdc, TRANSPARENT
      
      tR.Top = TopPixels
      tR.Bottom = BottomPixels
      tR.Left = LeftPixels
      tR.Right = RightPixels
      If (bSelected) Then
         hBrush = GetSysColorBrush(vbHighlight And &H1F&)
          'CreateSolidBrush(gTranslateColor(vbHighlight))
         FillRect hdc, tR, hBrush
         DeleteObject hBrush
      Else
         If (ItemAction = ODA_SELECT) Then
            'hBrush = GetSysColorBrush(vbWindowBackground And &H1F&)
             'CreateSolidBrush(gTranslateColor(vbWindowBackground))
            FillRect hdc, tR, m_hBrBack 'hBrush
            'DeleteObject hBrush
         End If
      End If
      
      'Debug.Print Index, hDC, bSelected, bEnabled, LeftPixels, TopPixels,
       RightPixels, BottomPixels
      
      tR.Top = TopPixels + 1
      tR.Bottom = BottomPixels - 1
      tR.Left = LeftPixels + 2
      If (m_eClientDraw = eccxColourPickerNoNames) Then
         tR.Top = tR.Top + 1
         tR.Bottom = tR.Bottom - 1
         tR.Right = RightPixels - 2
      Else
         tR.Right = tR.Left + (tR.Bottom - tR.Top)
      End If
      ' Draw sunken border:
      DrawEdge hdc, tR, BDR_SUNKENOUTER Or BDR_SUNKENINNER, (BF_RECT Or
       BF_MIDDLE)
      
      ' Draw the sample colour:
      OleTranslateColor ItemData(Index), 0, lCol
      hBrush = CreateSolidBrush(lCol)
      LSet tS = tR
      tS.Left = tS.Left + 2
      tS.Right = tS.Right - 2
      tS.Top = tS.Top + 2
      tS.Bottom = tS.Bottom - 2
      FillRect hdc, tS, hBrush
      DeleteObject hBrush
      
      If (m_eClientDraw <> eccxColourPickerNoNames) Then
         ' Now write the caption
         If (bSelected) Then
            SetTextColor hdc, GetSysColor(vbHighlightText And &H1F&)
         Else
            SetTextColor hdc, GetSysColor(vbWindowText And &H1F&)
         End If
         tR.Left = tR.Right + 2
         tR.Right = RightPixels
         DrawText hdc, List(Index), -1, tR, DT_LEFT Or DT_WORD_ELLIPSIS Or
          DT_SINGLELINE Or DT_NOPREFIX
      End If
   End If
    
End Sub
Private Sub pDrawText(ByVal hdc As Long, ByVal ItemState As Long, ByVal sItem
 As String, ByVal lLeft As Long, ByVal lAlign As Long, ByRef tR As RECT)
Dim tCR As RECT
Dim iColCount As Integer
Dim iCol As Integer
Dim sColVals() As String
   
   ' We potentially have > 1 column.  If this isn't the edit portion of a combo
   ' box, and we have specified that there are > 1 columns for the box,
   ' then draw according to the specified column widths.  Otherwise, use default
   ' drawing means.
   If (m_iColCount > 1) And (ItemState And ODS_COMBOBOXEDIT) <>
    ODS_COMBOBOXEDIT Then
      ' Split sItem according to vbTab:
      gSplitDelimitedString sItem, vbTab, sColVals(), iColCount
      ' Add attributes to truncate text and draw ellipsis (..) if too long
      lAlign = lAlign Or DT_END_ELLIPSIS Or DT_MODIFYSTRING Or DT_NOPREFIX
      ' Set up rectangle for first column
      LSet tCR = tR
      tCR.Right = lLeft + m_lColWidth(1)
      ' Always Draw the first item:
      If (m_eCoLType(1) = eccxImageListIcon) Then
         ImageList_Draw m_hIml, glCStr(sColVals(1), -1), hdc, tCR.Left, tCR.Top
          - 2, ILD_TRANSPARENT
      Else
         DrawTextExAsNull hdc, sColVals(1), -1, tCR, lAlign, 0
      End If
      For iCol = 2 To iColCount
         If (iCol > m_iColCount) Then
            ' Don't attempt to draw columns that we don't have:
            Exit For
         End If
         tCR.Left = tCR.Right + 1
         tCR.Right = tCR.Left + m_lColWidth(iCol)
         Select Case m_eCoLType(iCol)
         Case eccxImageListIcon
            ImageList_Draw m_hIml, glCStr(sColVals(iCol), -1), hdc, tCR.Left,
             tCR.Top - 2, ILD_TRANSPARENT
         Case Else
            DrawTextExAsNull hdc, sColVals(iCol), -1, tCR, lAlign, 0
         End Select
      Next iCol
   Else
      lAlign = DT_LEFT Or DT_NOPREFIX
      DrawTextExAsNull hdc, sItem, -1, tR, lAlign, 0
   End If
        
End Sub


Public Property Get AutoCompleteItemsAreSorted() As Boolean
Attribute AutoCompleteItemsAreSorted.VB_Description = "Gets/sets whether items
 should be regarded as sorted by the Auto-Completion code."
   AutoCompleteItemsAreSorted = m_bDataIsSorted
End Property
Public Property Let AutoCompleteItemsAreSorted(ByVal bstate As Boolean)
   m_bDataIsSorted = bstate
   PropertyChanged "AutoCompleteItemsAreSorted"
End Property
Public Property Get AutoCompleteListItemsOnly() As Boolean
Attribute AutoCompleteListItemsOnly.VB_Description = "Gets/sets whether the
 Auto Completion code allows items not in the list to be typed in."
   AutoCompleteListItemsOnly = m_bOnlyAutoCompleteItems
End Property
Public Property Let AutoCompleteListItemsOnly(ByVal bstate As Boolean)
   m_bOnlyAutoCompleteItems = bstate
   PropertyChanged "AutoCompleteItemsListItemsOnly"
End Property
Public Property Get DoAutoComplete() As Boolean
Attribute DoAutoComplete.VB_Description = "Sets whether the control will
 attempt to automatically complete the user's typing into the text box portion
 of the combo."
   If (m_eStyle = eccxDropDownCombo) Or (m_eStyle = eccxSimple) Then
      DoAutoComplete = m_bDoAutoComplete
   Else
      'Err.Raise 383, App.EXEName & ".vbalComboEx"
      DoAutoComplete = False
   End If
End Property
Public Property Let DoAutoComplete(ByVal bstate As Boolean)
   m_bDoAutoComplete = bstate
   PropertyChanged "DoAutoComplete"
End Property

Public Sub AutoCompleteKeyPress( _
      ByRef iKeyAscii As Integer _
   )
Attribute AutoCompleteKeyPress.VB_Description = "The code automatically run in
 response to a key down when DoAutoComplete is set True."
Dim sTotal As String
Dim sLTotal As String
Dim sUnSel As String
Dim sLUnSel As String
Dim lLen As Long
Dim iFound As Long
Dim i As Long
Dim lS As Long, lW As Long
Dim iStart As Long, iSelStart As Long, iSelLength As Long
Dim sText As String

On Error GoTo ErrorHandler

   If (iKeyAscii = vbKeyReturn) Then
      If (ListIndex > -1) Then
        SelStart = 0
        SelLength = Len(List(ListIndex))
        RaiseEvent AutoCompleteSelection(List(ListIndex), ListIndex)
        Exit Sub
      End If
   ElseIf (iKeyAscii = vbKeyEscape) Then
      Exit Sub
   End If
   
   lS = SelStart
   lW = SelLength
   
   If (lS > 0) Then
      sUnSel = Left$(Text, lS)
   End If
   If (iKeyAscii = 8) Then
      If (Len(sUnSel) > 1) Then
         sTotal = Left$(sUnSel, Len(sUnSel) - 1)
      Else
         sUnSel = ""
         iKeyAscii = 0
         Text = ""
         Exit Sub
      End If
   Else
      sTotal = sUnSel & Chr$(iKeyAscii)
   End If
   
   ' try to match the the string entered:
   iFound = -1
   sLTotal = LCase$(sTotal)
   lLen = Len(sLTotal)
   For i = 0 To ListCount - 1
      If StrComp(LCase$(Left$(List(i), lLen)), sLTotal) = 0 Then
         iFound = i
         Exit For
      End If
   Next i
   
   If (iFound > -1) Then
      ListIndex = iFound
      iSelStart = Len(sTotal)
      iSelLength = Len(List(iFound)) - iSelStart
      'Debug.Print iSelStart, iSelLength
      SelStart = iSelStart
      SelLength = iSelLength
      'Debug.Print SelStart, SelLength
      iKeyAscii = 0
   Else
      If (m_bOnlyAutoCompleteItems) Then
         ' is there anything we can choose which has the same unmatched letters?
         iStart = ListIndex
         sLUnSel = LCase$(sUnSel)
         lLen = Len(sLUnSel)
         If (lLen > 0) Then
            If (m_bDataIsSorted) Then
               ' Its either the next one down or the first in the list:
               i = iStart + 1
               If StrComp(LCase$(Left$(List(i), lLen)), sLUnSel) = 0 Then
                  iFound = i
               Else
                  For i = 0 To iStart - 1
                     If StrComp(LCase$(Left$(List(i), lLen)), sLUnSel) = 0 Then
                        iFound = i
                        Exit For
                     End If
                  Next i
               End If
            Else
               ' it could be anything following list index, or anything
                preceeding it:
               For i = iStart + 1 To ListCount - 1
                  If StrComp(LCase$(Left$(List(i), lLen)), sLUnSel) = 0 Then
                     iFound = i
                     Exit For
                  End If
               Next i
               If (iFound < 0) Then
                  For i = 0 To iStart - 1
                     If StrComp(LCase$(Left$(List(i), lLen)), sLUnSel) = 0 Then
                        iFound = i
                        Exit For
                     End If
                  Next i
               End If
            End If
            If (iFound > -1) Then
               ListIndex = iFound
               SelStart = lLen
               SelLength = Len(List(iFound)) - SelStart + 1
            End If
         Else
             Beep
         End If
         iKeyAscii = 0
      Else
         Debug.Print "Not found, still works?"
         'SendMessageLong m_hWnd, CB_SETCURSEL, -1, 0
      End If
   End If
   Exit Sub
   
ErrorHandler:
   If (m_bOnlyAutoCompleteItems) Then
      iKeyAscii = 0
   End If
   Exit Sub
   
End Sub

Public Property Get ExtendedStyle(ByVal eStyle As ECCXExtendedStyle) As Boolean
Attribute ExtendedStyle.VB_Description = "Gets/sets extended style properties
 of the control, e.g. case sensitivity and whether images shown in the edit
 portion."
   ExtendedStyle = ((m_eExStyle And eStyle) = eStyle)
End Property
Public Property Let ExtendedStyle(ByVal eStyle As ECCXExtendedStyle, ByVal
 bstate As Boolean)
   If bstate Then
      m_eExStyle = m_eExStyle Or eStyle
   Else
      m_eExStyle = m_eExStyle And Not eStyle
   End If
   If m_hWnd <> 0 Then
      SendMessageLong m_hWnd, CBEM_SETEXSTYLE, 0, m_eExStyle
   End If
End Property
Public Property Get DrawStyle() As ECCXDrawMode
Attribute DrawStyle.VB_Description = "Gets/sets the way in which items in the
 control will be drawn."
   DrawStyle = m_eClientDraw
End Property
Public Property Let DrawStyle(ByVal eStyle As ECCXDrawMode)
   If eStyle <> m_eClientDraw Then
      m_eClientDraw = eStyle
      PropertyChanged "DrawStyle"
   End If
End Property

Public Property Get Font() As StdFont
Attribute Font.VB_Description = "Gets/sets the default font used to draw the
 control's items."
   ' Get the control's default font:
   Set Font = UserControl.Font
End Property
Public Property Set Font(fntThis As StdFont)
Dim hFnt As Long
Dim tFnt As LOGFONT
Dim lH As Long
Dim tR As RECT

   ' Set the control's default font:
   Set UserControl.Font = fntThis
   ' Store a log font structure for this font:
   pOLEFontToLogFont fntThis, UserControl.hdc, tFnt
   ' Store old font handle:
   hFnt = m_hFnt
   ' Create a new version of the font:
   m_hFnt = CreateFontIndirect(tFnt)
   If (m_hWnd <> 0) Then
      ' Ensure the control has the correct font:
      SendMessageLong m_hWnd, WM_SETFONT, m_hFnt, 1
   End If
   ' Delete previous version, if we had one:
   If (hFnt <> 0) Then
      DeleteObject hFnt
   End If
   
   ' Make sure the User Control's height is correct:
   If m_eStyle <> eccxSimple Then
      lH = SendMessageLong(m_hWnd, CB_GETITEMHEIGHT, -1, 0)
      Debug.Print "Height;"; lH
      UserControl.Extender.Height = (lH + 6) * Screen.TwipsPerPixelY
   End If
   Set m_fnt = fntThis
   PropertyChanged "Font"
   
End Property
Private Property Get BackColor() As OLE_COLOR
   BackColor = m_oBackColor
End Property
Private Property Let BackColor(ByVal oColor As OLE_COLOR)
   m_oBackColor = oColor
Dim lC As Long
   If (m_hBrBack = 0) Then
      DeleteObject m_hBrBack
   End If
   OleTranslateColor oColor, 0, lC
   m_hBrBack = CreateSolidBrush(lC)
End Property
Private Property Get plDefaultItemHeight() As Long
Dim tR As RECT
Dim lHeight As Long
   DrawText UserControl.hdc, "Xg", -1, tR, DT_CALCRECT
   lHeight = (tR.Bottom - tR.Top) + 2
   If (lHeight < m_lIconSizeY) Then
      lHeight = m_lIconSizeY
   End If
   plDefaultItemHeight = lHeight
End Property
Private Sub pOLEFontToLogFont(fntThis As StdFont, hdc As Long, tLF As LOGFONT)
Dim sFont As String
Dim iChar As Integer

    ' Convert an OLE StdFont to a LOGFONT structure:
    With tLF
        sFont = fntThis.Name
        ' There is a quicker way involving StrConv and CopyMemory, but
        ' this is simpler!:
        For iChar = 1 To Len(sFont)
            .lfFaceName(iChar - 1) = CByte(Asc(Mid$(sFont, iChar, 1)))
        Next iChar
        ' Based on the Win32SDK documentation:
        .lfHeight = -MulDiv((fntThis.Size), (GetDeviceCaps(hdc, LOGPIXELSY)),
         72)
        .lfItalic = fntThis.Italic
        If (fntThis.Bold) Then
            .lfWeight = FW_BOLD
        Else
            .lfWeight = FW_NORMAL
        End If
        .lfUnderline = fntThis.Underline
        .lfStrikeOut = fntThis.Strikethrough
        
        .lfCharSet = fntThis.Charset
    End With

End Sub
Friend Function TranslateAccelerator(lpMsg As MSG) As Long
   TranslateAccelerator = S_FALSE
   ' Here you can modify the response to the key down
   ' accelerator command using the values in lpMsg.  This
   ' can be used to capture Tabs, Returns, Arrows etc.
   ' Just process the message as required and return S_OK.
   If lpMsg.message = WM_KEYDOWN Or lpMsg.message = WM_KEYUP Then
   
      Dim bToEdit As Boolean
      Dim iKey As KeyCodeConstants
      Dim iSel As Long, iLen As Long
      Dim iShift As ShiftConstants
            
      iKey = lpMsg.wParam And &HFFFF&
      Select Case iKey
      Case vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyPageDown,
       vbKeyPageUp, vbKeyHome, vbKeyEnd, vbKeyReturn
         
         TranslateAccelerator = S_OK

         bToEdit = (GetFocus() = m_hWndEdit)
         If m_eStyle = eccxDropDownCombo Then
            If iKey = vbKeyHome Or iKey = vbKeyEnd Or iKey = vbKeyReturn Then
               If ComboIsDropped Then
                  If iKey = vbKeyHome Then
                     Debug.Print "Attempting to parse HOME"
                     iShift = piGetShiftState()
                     If (iShift And vbShiftMask) = vbShiftMask Then
                        iSel = SelStart
                        SelStart = 0
                        If iSel > 0 Then
                           SelLength = iSel + 1
                        End If
                     Else
                        SelStart = 0
                        SelLength = 0
                     End If
                     Exit Function
                  ElseIf iKey = vbKeyEnd Then
                     Debug.Print "Attempting to parse END"
                     iShift = piGetShiftState()
                     If (iShift And vbShiftMask) = vbShiftMask Then
                        iSel = SelStart
                        iLen = Len(Text)
                        If iLen - iSel >= 0 Then
                           SelLength = iLen - iSel
                        End If
                     Else
                        pSetSelStartEnd Len(Text), Len(Text)
                     End If
                     Exit Function
                  Else
                     Debug.Print "Forwarding"
                     bToEdit = True
                  End If
               End If
            End If
         End If
         If bToEdit Then
            SendMessageLong m_hWndEdit, lpMsg.message, lpMsg.wParam,
             lpMsg.lParam
         Else
            SendMessageLong m_hWndCbo, lpMsg.message, lpMsg.wParam, lpMsg.lParam
         End If
      End Select
      
   End If
   
End Function

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Gets/sets whether the control is enabled."
   Enabled = m_bEnabled
End Property
Public Property Let Enabled(ByVal bstate As Boolean)
   If Not (m_bEnabled = bstate) Then
      m_bEnabled = bstate
      UserControl.Enabled = m_bEnabled
      EnableWindow UserControl.hwnd, Abs(m_bEnabled)
      If Not (m_hWnd = 0) Then
         EnableWindow m_hWnd, Abs(m_bEnabled)
      End If
      PropertyChanged "Enabled"
   End If
End Property

Public Property Get Style() As ECCXComboStyle
Attribute Style.VB_Description = "Gets/sets whether the control appears as a
 Drop-Down Combo, a Drop-Down List or a Simple Combo."
   Style = m_eStyle
End Property
Public Property Let Style(ByVal eStyle As ECCXComboStyle)
   If Not (m_eStyle = eStyle) Then
      m_eStyle = eStyle
      If Not (m_hWnd = 0) Then
         pCache True
         plCreate
         pCache
      End If
      UserControl_Resize
      PropertyChanged "Style"
   End If
End Property
Public Property Get Sorted() As Boolean
Attribute Sorted.VB_Description = "Gets/sets whether the control is sorted."
   Sorted = m_bSorted
End Property
Public Property Let Sorted(ByVal bstate As Boolean)
   If m_bSorted <> bstate Then
      m_bSorted = bstate
      If Not (m_hWnd = 0) Then
         pCache True
         Clear
         pCache
      End If
      PropertyChanged "Sorted"
   End If
End Property
Private Sub pCache(Optional ByVal bstate As Boolean)
Static s_tCBItem() As COMBOBOXEXITEM
Static s_iCount As Long
Static s_iListIndex As Long
Static s_sText As String
Dim i As Long
Dim sTemp As String
Dim sBuf As String

   If bstate Then
      ' Cache:
      s_iCount = ListCount
      If s_iCount > 0 Then
         ReDim s_tCBItem(1 To s_iCount) As COMBOBOXEXITEM
         For i = 0 To s_iCount - 1
            With s_tCBItem(i + 1)
               .mask = CBEIF_TEXT Or CBEIF_IMAGE Or CBEIF_SELECTEDIMAGE Or
                CBEIF_OVERLAY Or CBEIF_INDENT Or CBEIF_LPARAM
               .iItem = i
               sTemp = String$(260, 0)
               sBuf = StrConv(sTemp, vbFromUnicode)
               .cchTextMax = LenB(sBuf)
               .pszText = sBuf
            End With
            SendMessage m_hWnd, CBEM_GETITEM, 0, s_tCBItem(i + 1)
         Next i
         s_iListIndex = ListIndex
      Else
         Erase s_tCBItem
      End If
      s_sText = Text
   Else
      ' Uncache:
      Redraw = False
      If s_iCount > 0 Then
         For i = 0 To s_iCount - 1
            With s_tCBItem(i + 1)
               AddItemAndData .pszText, .iImage, .iSelectedImage, .lParam,
                .iIndent
            End With
         Next i
         ListIndex = s_iListIndex
      End If
      If m_eStyle <> eccxDropDownList Then
         Text = s_sText
      End If
      Redraw = True
   End If
   
End Sub
Public Property Get DropDownWidth() As Long
Attribute DropDownWidth.VB_Description = "Gets/sets the width of the drop-down
 portion of the combo box."
   ' Get the width of the drop down portion of a combo box
   ' in pixels:
   DropDownWidth = m_lWidth
End Property
Public Property Let DropDownWidth(lWidth As Long)
Dim lR As Long
Dim lAWidth As Long
   ' Set the width of the drop down portion of a combo box
   ' in pixels:
   If Not (m_lWidth = lWidth) Then
      m_lWidth = lWidth
      If Not (m_hWnd = 0) Then
         If lWidth = -1 Then
            lWidth = UserControl.ScaleWidth \ Screen.TwipsPerPixelY
         End If
         ' The width of a combo box's drop down is set
         ' in dialog units which are basically the size
         ' of an average character in the system font:
         'lAWidth = lWidth \ plGetFontDialogUnits(m_hWnd)
         lR = SendMessageLong(m_hWnd, CB_SETDROPPEDWIDTH, lWidth, 0)
      End If
      PropertyChanged "DropDownWidth"
   End If
End Property
Private Function plGetFontDialogUnits( _
        ByVal hwnd As Long _
    ) As Long

Dim hFont As Long
Dim hFontOld As Long
Dim r As Long
Dim avgWidth As Long
Dim hdc As Long
Dim tmp As String
Dim sz As SIZEAPI
   
   'get the hdc to the main window
    hdc = GetDC(hwnd)
   
   'with the current font attributes, select the font
    hFont& = GetStockObject(ANSI_VAR_FONT)
    hFontOld& = SelectObject(hdc, hFont&)
   
   'get it's length, then calculate the average character width
    tmp$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
    r& = GetTextExtentPoint32(hdc, tmp$, 52, sz)
    avgWidth& = (sz.cX \ 52)
   
   're-select the previous font & delete the hDc
    r& = SelectObject(hdc, hFontOld&)
    r& = DeleteObject(hFont&)
    r& = ReleaseDC(hwnd, hdc)
   
   'return the average character width
    plGetFontDialogUnits = avgWidth

End Function

Public Property Get ComboIsDropped() As Boolean
Attribute ComboIsDropped.VB_Description = "Gets/sets whether the drop down
 portion of the control is visible."
   ComboIsDropped = (SendMessageLong(m_hWnd, CB_GETDROPPEDSTATE, 0, 0) <> 0)
End Property
Public Sub ShowDropDown(ByVal bstate As Boolean)
Attribute ShowDropDown.VB_Description = "Forces the drop-down portion of the
 control to show."
Dim wP As Long
Dim lR As Long
   ' In a combo box, show or hide the drop down portion:
   If Not (m_eStyle = eccxSimple) Then
      If Not (m_hWnd = 0) Then
         wP = -1 * bstate
         lR = SendMessageLong(m_hWnd, CB_SHOWDROPDOWN, wP, 0)
      End If
   Else
      Err.Raise 383, App.EXEName & ".vbalComboEx"
   End If
End Sub
Public Property Get ListCount() As Long
Attribute ListCount.VB_Description = "Gets the number of list items in the
 control."
   ListCount = SendMessageLong(m_hWnd, CB_GETCOUNT, 0, 0)
End Property
Public Property Get ListIndex() As Long
Attribute ListIndex.VB_Description = "Gets/sets the currently selected item in
 the control."
   ListIndex = SendMessageLong(m_hWnd, CB_GETCURSEL, 0, 0)
End Property
Public Property Let ListIndex(ByVal lIndex As Long)
Dim lR As Long
   lR = SendMessageLong(m_hWnd, CB_SETCURSEL, lIndex, 0)
   If lR = CB_ERR And lIndex <> -1 Then
      Err.Raise 381, App.EXEName & ".vbalComboEx"
   Else
      RaiseEvent Click
   End If
End Property
Public Property Get NewIndex() As Long
Attribute NewIndex.VB_Description = "Gets the ListIndex of the last item added
 to the control."
   NewIndex = m_lNewIndex
End Property
Private Sub pGetSelStartEnd(lStart As Long, lEnd As Long)
Dim lParam As Long
   ' Get the start and end of the selection in the edit
   ' box portion of a drop down combo box:
   If Not (m_hWnd = 0) Then
      lParam = SendMessageByref(m_hWndEdit, EM_GETSEL, lStart, lEnd)
   End If
End Sub
Private Sub pSetSelStartEnd(ByVal lStart As Long, ByVal lEnd As Long)
Dim lParam As Long
Dim lR As Long
   ' Set the start and end of the selection in the edit
   ' box portion of a drop down combo box:
   If Not (m_hWnd = 0) Then
      lStart = lStart And &H7FFF&
      lEnd = lEnd And &H7FFF&
      lR = SendMessageLong(m_hWndEdit, EM_SETSEL, lStart, lEnd)
      Debug.Print lEnd, lStart
   End If
End Sub

Property Get SelLength() As Long
Attribute SelLength.VB_Description = "Gets the length of the selected text in
 the control."
Dim lStart As Long, lEnd As Long
   ' Return the length of the selected text in the edit
   ' box portion of a dropdown combo:
   If (m_eStyle = eccxDropDownList) Then
      If ListIndex > -1 Then
         SelLength = Len(List(ListIndex))
      Else
         SelLength = 0
      End If
   Else
      pGetSelStartEnd lStart, lEnd
      SelLength = lEnd - lStart
   End If
End Property
Property Let SelLength(ByVal lLength As Long)
Dim lStart As Long, lEnd As Long
   ' Set the length of the selected text in the edit
   ' box portion of a dropdown combo:
   If (m_eStyle <> eccxDropDownList) Then
      pGetSelStartEnd lStart, lEnd
      If (lEnd - lStart <> lLength) Then
         pSetSelStartEnd lStart, lStart + lLength
      End If
   Else
      Err.Raise 383, "vbalComboEx." & App.EXEName
   End If
End Property
Property Get SelStart() As Long
Attribute SelStart.VB_Description = "Gets the 0-based index of the first
 selected character in the text portion of the control."
Dim lStart As Long, lEnd As Long
   ' Return the start of the selected text in the edit
   ' box portion of a dropdown combo:
   If (m_eStyle <> eccxDropDownList) Then
      pGetSelStartEnd lStart, lEnd
      SelStart = lStart
   Else
      'Err.Raise 383, "vbalComboEx." & App.EXEName
   End If
End Property
Property Let SelStart(ByVal lStart As Long)
Dim lOStart As Long, lEnd As Long
   ' Set the start of the selected text in the edit
   ' box portion of a dropdown combo:
   If (m_eStyle <> eccxDropDownList) Then
      pGetSelStartEnd lOStart, lEnd
      If (lStart <> lOStart) Then
         pSetSelStartEnd lStart, lEnd
      End If
   Else
      Err.Raise 383, "vbalComboEx." & App.EXEName
   End If
End Property

Property Get SelText() As String
Attribute SelText.VB_Description = "Gets the selected text from the text
 portion of the control."
   ' Return the selected text from the edit
   ' box portion of a dropdown combo:
   If (m_eStyle = eccxDropDownList) Then
      Dim sText As String
      Dim lStart As Long, lEnd As Long
      
      pGetSelStartEnd lStart, lEnd
      sText = Text
      If (lEnd > 0) And Len(sText) > 0 Then
         If (lStart <= 0) Then
            lStart = 1
         End If
         lEnd = lEnd + 1
         If (lEnd > Len(sText)) Then lEnd = Len(sText)
         SelText = Mid$(sText, lStart, (lEnd - lStart))
      End If
   Else
      SelText = Text
   End If
End Property
Property Get Text() As String
Attribute Text.VB_Description = "Gets/sets the text in the text portion of the
 control."
Dim lR As Long
Dim sText As String
Dim iPos As Long
   ' Returns either the text in the EditBox portion of a
   ' drop down combo or the text of the (first) selected
   ' list item:
   If Not (m_hWnd = 0) Then
      If Not (m_eStyle = eccxDropDownList) Then
         'Text = List(-1)  --> ' This works correctly in IE4+ only
         lR = SendMessageLong(m_hWndEdit, WM_GETTEXTLENGTH, 0, 0)
         If (lR > 0) Then
            sText = String$(lR + 1, Chr$(0))
            lR = SendMessageString(m_hWndEdit, WM_GETTEXT, (lR + 1), sText)
            If (lR > 0) Then
               iPos = InStr(sText, vbNullChar)
               If iPos <> 0 Then
                  lR = iPos - 1
               End If
               Text = Left$(sText, lR)
            End If
         End If
         
      Else
         If (ListIndex > -1) Then
            Text = List(ListIndex)
         Else
            Text = ""
         End If
      End If
   End If
End Property
Property Let Text(ByVal sText As String)
   ' Can only set the text in a drop down combo box:
   If Not (m_eStyle = eccxDropDownList) Then
      SendMessageString m_hWnd, WM_SETTEXT, 0, sText & Chr$(0)
      'List(-1) = sText
   Else
      Err.Raise 383, "vbalComboEx." & App.EXEName
   End If
End Property
Public Property Get MaxLength() As Long
Attribute MaxLength.VB_Description = "Gets/sets the maximum length of text
 which can be typed into the edit portion of the control."
   ' Same as MaxLength property of a Text control.  Only
   ' valid for drop down combo boxes:
   If Not (m_eStyle = eccxDropDownList) Then
      MaxLength = m_lMaxLength
   Else
      'Err.Raise 383, "vbalComboEx." & App.EXEName
   End If
End Property
Public Property Let MaxLength(ByVal lLength As Long)
   ' Same as MaxLength property of a Text control.  Only
   ' valid for drop down combo boxes:
   If Not (m_eStyle = eccxDropDownCombo) Then
      ' Don't be silly:
      If (lLength > 30000&) Or (lLength <= 0) Then lLength = 30000&
      ' Set:
      m_lMaxLength = lLength
      SendMessageLong m_hWnd, CB_LIMITTEXT, lLength, 0
   Else
      Err.Raise 383, "vbalComboEx." & App.EXEName
   End If
End Property
Public Property Get Redraw() As Boolean
Attribute Redraw.VB_Description = "Gets/sets whether the control redraws itself
 in response to changes.  Set to False to speed up the addition of items."
   Redraw = m_bRedraw
End Property
Public Property Let Redraw(ByVal bstate As Boolean)
   If m_bRedraw <> bstate Then
      m_bRedraw = bstate
      If Not (m_hWnd = 0) Then
         SendMessageLong m_hWnd, WM_SETREDRAW, Abs(m_bRedraw), 0
      End If
      PropertyChanged "Redraw"
   End If
End Property
Public Property Get hwnd() As Long
Attribute hwnd.VB_Description = "Gets the window handle of the control."
   hwnd = UserControl.hwnd
End Property
Public Property Get hWndComboEx() As Long
Attribute hWndComboEx.VB_Description = "Gets the window handle of the
 ComboBoxEx container of the combo box control."
   hWndComboEx = m_hWnd
End Property
Public Property Get hWndCombo() As Long
Attribute hWndCombo.VB_Description = "Gets the window handle of the drop-down
 combo portion of the combo box control."
   hWndCombo = m_hWndCbo
End Property
Public Property Get hWndEdit() As Long
Attribute hWndEdit.VB_Description = "Returns the window handle of the Edit
 portion of the combo box control."
   hWndEdit = m_hWndEdit
End Property
Public Sub Clear()
Attribute Clear.VB_Description = "Removes all items from the ComboBox's list."
   SendMessageLong m_hWnd, CB_RESETCONTENT, 0, 0
   m_lNewIndex = -1
End Sub
Public Property Get ExtendedUI() As Boolean
Attribute ExtendedUI.VB_Description = "Gets/sets whether the control drops down
 in response to the Return key rather than F4."
   ExtendedUI = m_bExtendedUI
End Property
Public Property Let ExtendedUI(ByVal bstate As Boolean)
   If m_bExtendedUI <> bstate Then
      m_bExtendedUI = bstate
      If Not (m_hWnd = 0) Then
         SendMessageLong m_hWnd, CB_SETEXTENDEDUI, Abs(bstate), 0
      End If
      PropertyChanged "ExtendedUI"
   End If
End Property
Public Sub AddItem(ByVal sText As String)
Attribute AddItem.VB_Description = "Adds an item to the list."
   InsertItemAndData sText
End Sub
Public Sub AddItemAndData( _
      ByVal sText As String, _
      Optional ByVal iIcon As Long = -1, _
      Optional ByVal iIconSelected As Long = -1, _
      Optional ByVal lItemData As Long = 0, _
      Optional ByVal lIndent As Long = 0 _
   )
Attribute AddItemAndData.VB_Description = "Adds an item to the list, optionally
 setting other properties at the same time.  Quicker if you want to set
 multiple properties for each item being added."
   InsertItemAndData sText, , iIcon, iIconSelected, lItemData, lIndent
End Sub
Public Sub InsertItem( _
      ByVal sText As String, _
      Optional ByVal lIndexBefore As Long = -1 _
   )
Attribute InsertItem.VB_Description = "Same as AddItem but instead Inserts the
 item into the control."
   InsertItemAndData sText, lIndexBefore
End Sub
Public Sub InsertItemAndData( _
      ByVal sText As String, _
      Optional ByVal lIndexBefore As Long = -1, _
      Optional ByVal iIcon As Long = -1, _
      Optional ByVal iIconSelected As Long = -1, _
      Optional ByVal lItemData As Long = 0, _
      Optional ByVal lIndent As Long = 0 _
   )
Attribute InsertItemAndData.VB_Description = "Same as AddItemAndData but
 instead inserts the item and associated information into the control."
Dim tCBItem As COMBOBOXEXITEM
Dim lR As Long
Dim i As Long
Dim iStart As Long
Dim iEnd As Long
Dim iComp As Long
Dim iRes As Long
Dim eCompare As VbCompareMethod
Static s_sLastText As String

   If m_bSorted Then
      ' We force the index to the appropriate point.
      ' Use a binary search...
      If ListCount > 0 Then
         If ExtendedStyle(eccxCaseSensitiveSearch) Then
            eCompare = vbBinaryCompare
         Else
            eCompare = vbTextCompare
         End If
         lIndexBefore = -1
         iEnd = ListCount - 1
         If iEnd > 0 Then
            Do While iEnd > iStart
               iComp = iStart + (iEnd - iStart) \ 2
               iRes = StrComp(sText, List(iComp), eCompare)
               If iRes = 0 Then
                  lIndexBefore = iComp
                  iStart = 0: iEnd = 0
               ElseIf iRes > 0 Then
                  iStart = iComp + 1
               Else
                  iEnd = iComp - 1
               End If
            Loop
         End If
            
         If lIndexBefore = -1 Then
            If iStart = iEnd Then
               If StrComp(sText, List(iEnd), eCompare) < 0 Then
                  lIndexBefore = iEnd
               Else
                  lIndexBefore = iEnd + 1
               End If
            Else
               If iEnd < iStart Then
                  If StrComp(sText, List(iStart), eCompare) < 0 Then
                     lIndexBefore = iStart
                  Else
                     Debug.Assert False
                  End If
               Else
                  Debug.Assert False
               End If
            End If
            If lIndexBefore >= ListCount Then
               lIndexBefore = -1
            End If
         End If
         
      End If
   End If

   With tCBItem
      .mask = CBEIF_TEXT Or CBEIF_INDENT _
               Or CBEIF_IMAGE Or CBEIF_LPARAM Or _
               CBEIF_SELECTEDIMAGE
      .pszText = sText
      .cchTextMax = Len(sText)
      .iIndent = lIndent
      .iImage = iIcon
      .iSelectedImage = iIconSelected
      .lParam = lItemData
      .iItem = lIndexBefore
   End With
   m_lNewIndex = SendMessage(m_hWnd, CBEM_INSERTITEM, lIndexBefore, tCBItem)
   If m_lNewIndex > -1 Then
      s_sLastText = sText
   End If
End Sub
Public Function FindItemIndex( _
        ByVal sToFind As String, _
        Optional ByVal bExactMatch As Boolean = False _
    ) As Long
Attribute FindItemIndex.VB_Description = "Attempts to find the specified item,
 either exactly matching or partially matching, and returns the index if found
 or -1 otherwise."
Dim lR As Long
Dim lFlag As Long
   ' Find the index of the item sToFind, optionally
   ' exact matching.  Return -1 if the item is not
   ' found.
   If Not (m_hWnd = 0) Then
      ' Set the message to send to the control:
      If (bExactMatch) Then
         lFlag = CB_FINDSTRINGEXACT
      Else
         lFlag = CB_FINDSTRING
      End If
      ' Find:
      lR = -1
      lR = SendMessageString(m_hWnd, lFlag, 0, sToFind)
      ' Return value:
      FindItemIndex = lR
   End If
End Function
Public Property Get ItemIndent(ByVal lIndex As Long) As Long
Attribute ItemIndent.VB_Description = "Gets/sets the indentation of an  item in
 the control's list.  Indentation is set in multiples of the ImageList icon
 size, or defaulting to 16 pixels if there is no ImageList."
Dim tCBItem As COMBOBOXEXITEM
   tCBItem.mask = CBEIF_INDENT
   If GetItem(lIndex, tCBItem) Then
      ItemIndent = tCBItem.iIndent
   End If
End Property
Public Property Let ItemIndent(ByVal lIndex As Long, ByVal lIndent As Long)
Dim tCBItem As COMBOBOXEXITEM
   tCBItem.mask = CBEIF_INDENT
   tCBItem.iIndent = lIndent
   SetItem lIndex, tCBItem
End Property
Public Property Get ItemIcon(ByVal lIndex As Long) As Long
Attribute ItemIcon.VB_Description = "Gets/sets the 0-based icon index 
 associated with an item in the control's list."
Dim tCBItem As COMBOBOXEXITEM
   tCBItem.mask = CBEIF_IMAGE
   If GetItem(lIndex, tCBItem) Then
      ItemIcon = tCBItem.iImage
   End If
End Property
Public Property Let ItemIcon(ByVal lIndex As Long, ByVal lIcon As Long)
Dim tCBItem As COMBOBOXEXITEM
   tCBItem.mask = CBEIF_IMAGE
   tCBItem.iImage = lIcon
   SetItem lIndex, tCBItem
End Property
Public Property Get ItemData(ByVal lIndex As Long) As Long
Attribute ItemData.VB_Description = "Gets/sets a long value associated with an
 item in the control's list."
Dim tCBItem As COMBOBOXEXITEM
   tCBItem.mask = CBEIF_LPARAM
   If GetItem(lIndex, tCBItem) Then
      ItemData = tCBItem.lParam
   End If
End Property
Public Property Let ItemData(ByVal lIndex As Long, ByVal lData As Long)
Dim tCBItem As COMBOBOXEXITEM
   tCBItem.mask = CBEIF_LPARAM
   tCBItem.lParam = lData
   SetItem lIndex, tCBItem
End Property
Public Property Get ItemIconSelected(ByVal lIndex As Long) As Long
Attribute ItemIconSelected.VB_Description = "Gets/sets the 0-based icon index 
 to be used when the item is selected associated with an item in the control's
 list."
Dim tCBItem As COMBOBOXEXITEM
   tCBItem.mask = CBEIF_SELECTEDIMAGE
   If GetItem(lIndex, tCBItem) Then
      ItemIconSelected = tCBItem.iSelectedImage
   End If
End Property
Public Property Let ItemIconSelected(ByVal lIndex As Long, ByVal lIcon As Long)
Dim tCBItem As COMBOBOXEXITEM
   tCBItem.mask = CBEIF_SELECTEDIMAGE
   tCBItem.iSelectedImage = lIcon
   SetItem lIndex, tCBItem
End Property
Public Property Get List(ByVal lIndex As Long) As String
Attribute List.VB_Description = "Gets/sets the text for a list item in the
 control."
Dim tCBItem As COMBOBOXEXITEM
Dim sBuf As String
Dim sTemp As String
Dim iPos As Long
   If lIndex = -1 Then
      If m_eStyle = eccxDropDownCombo Then
         List = Text
      Else
         List = ""
      End If
   Else
      tCBItem.mask = CBEIF_TEXT
      sTemp = String$(260, 0)
      sBuf = StrConv(sTemp, vbFromUnicode)
      tCBItem.cchTextMax = LenB(sBuf)
      tCBItem.pszText = sBuf
      If GetItem(lIndex, tCBItem) Then
         sTemp = tCBItem.pszText
         iPos = InStr(sTemp, vbNullChar)
         If (iPos > 1) Then
            List = Left$(sTemp, (iPos - 1))
         Else
            List = sTemp
         End If
      End If
   End If
End Property
Public Property Let List(ByVal lIndex As Long, ByVal sItem As String)
Dim tCBItem As COMBOBOXEXITEM
   tCBItem.mask = CBEIF_TEXT
   tCBItem.cchTextMax = LenB(sItem)
   tCBItem.pszText = sItem
   SetItem lIndex, tCBItem
End Property

Private Function GetItem(ByVal lIndex As Long, ByRef tCBItem As COMBOBOXEXITEM)
 As Boolean
Dim lR As Long
   If InRange(lIndex) Then
      tCBItem.iItem = lIndex
      lR = SendMessage(m_hWnd, CBEM_GETITEM, 0, tCBItem)
   End If
   If (lR = 0) And (lIndex <> -1) Then
      Err.Raise 381, App.EXEName & ".vbalComboEx"
   Else
      GetItem = True
   End If
End Function
Private Function SetItem(ByVal lIndex As Long, ByRef tCBItem As COMBOBOXEXITEM)
 As Boolean
Dim lR As Long
   If InRange(lIndex) Then
      tCBItem.iItem = lIndex
   End If
   lR = SendMessage(m_hWnd, CBEM_SETITEM, 0, tCBItem)
   If (lR = 0) Then
      Err.Raise 381, App.EXEName & ".vbalComboEx"
   Else
      SetItem = True
   End If
End Function
Private Property Get InRange(ByVal lIndex As Long) As Boolean
   InRange = (lIndex >= 0) And (lIndex < ListCount)
End Property
Public Sub RemoveItem( _
      ByVal lIndex As Long _
   )
Attribute RemoveItem.VB_Description = "Removes an Item from the control."
   If SendMessage(m_hWnd, CBEM_DELETEITEM, lIndex, 0) = CB_ERR Then
      Err.Raise 381, App.EXEName & ".vbalComboEx"
   End If
End Sub
Public Property Let ImageList(ByRef vThis As Variant)
Attribute ImageList.VB_Description = "Associates an ImageList with the
 ComboBoxEx control.  This can be a Microsoft COMCTL32 ImageList or any valid
 Image List handle."
Dim hIml As Long
Dim lX As Long

   ' Set the ImageList handle property either from a VB
   ' image list or directly:
   If VarType(vThis) = vbObject Then
       ' Assume VB ImageList control.  Note that unless
       ' some call has been made to an object within a
       ' VB ImageList the image list itself is not
       ' created.  Therefore hImageList returns error. So
       ' ensure that the ImageList has been initialised by
       ' drawing into nowhere:
       On Error Resume Next
       ' Get the image list initialised..
       vThis.ListImages(1).Draw 0, 0, 0, 1
       hIml = vThis.hImageList
       If (Err.Number <> 0) Then
         Err.Clear
         hIml = vThis.hIml
         If (Err.Number <> 0) Then
            hIml = 0
         End If
       End If
       On Error GoTo 0
   ElseIf VarType(vThis) = vbLong Then
       ' Assume ImageList handle:
       hIml = vThis
   Else
       Err.Raise vbObjectError + 1049, "vbalDriveCboEx." & App.EXEName,
        "ImageList property expects ImageList object or long hImageList handle."
   End If
    
   ' If we have a valid image list, then associate it with the control:
   If (hIml <> 0) Then
      m_hIml = hIml
      ImageList_GetIconSize m_hIml, lX, m_lIconSizeY
      'Set the Imagelist for the ComboBox
      SendMessageLong m_hWnd, CBEM_SETIMAGELIST, 0, m_hIml
      Set Font = m_fnt
   End If
End Property

Private Function plCreate()
Dim dwStyle As Long
Dim lWidth As Long
Dim lHeight As Long
   
   pDestroy

   dwStyle = WS_CHILD
   Select Case m_eStyle
   Case eccxSimple
      dwStyle = dwStyle Or CBS_SIMPLE
   Case eccxDropDownList
      dwStyle = dwStyle Or CBS_DROPDOWNLIST
   Case eccxDropDownCombo
      dwStyle = dwStyle Or CBS_DROPDOWN
   Case Else
      Debug.Assert False
      dwStyle = dwStyle Or CBS_DROPDOWN
   End Select
   lWidth = UserControl.ScaleWidth \ Screen.TwipsPerPixelX
   lHeight = (UserControl.ScaleHeight \ Screen.TwipsPerPixelX) * 8
   m_hWndParent = UserControl.hwnd
   m_hWnd = CreateWindowEX(0, WC_COMBOBOXEX, "", _
         dwStyle, _
         0, 0, lWidth, lHeight, _
         m_hWndParent, 0&, App.hInstance, 0&)

   If UserControl.Ambient.UserMode Then
      If m_hIml <> 0 Then
         'Set the Imagelist for the ComboBox
         SendMessageLong m_hWnd, CBEM_SETIMAGELIST, 0, m_hIml
      End If
      
      AttachMessage Me, m_hWndParent, WM_COMMAND
      AttachMessage Me, m_hWndParent, WM_SETFOCUS
      AttachMessage Me, m_hWndParent, WM_NOTIFY
      AttachMessage Me, m_hWnd, WM_CTLCOLORLISTBOX
      AttachMessage Me, m_hWnd, WM_DRAWITEM

      m_hWndCbo = SendMessageLong(m_hWnd, CBEM_GETCOMBOCONTROL, 0, 0)
      AttachMessage Me, m_hWndCbo, WM_SETFOCUS
      AttachMessage Me, m_hWndCbo, WM_MOUSEACTIVATE
      
      If m_eStyle = eccxDropDownCombo Then
         m_hWndEdit = SendMessageLong(m_hWnd, CBEM_GETEDITCONTROL, 0, 0)
         AttachMessage Me, m_hWndEdit, WM_SETFOCUS
         AttachMessage Me, m_hWndEdit, WM_MOUSEACTIVATE
         AttachMessage Me, m_hWndEdit, WM_KEYDOWN
         AttachMessage Me, m_hWndEdit, WM_CHAR
         AttachMessage Me, m_hWndEdit, WM_KEYUP
         AttachMessage Me, m_hWndCbo, WM_KEYDOWN
         AttachMessage Me, m_hWndCbo, WM_CHAR
         AttachMessage Me, m_hWndCbo, WM_KEYUP
         AttachMessage Me, m_hWndCbo, WM_CTLCOLOREDIT
      ElseIf m_eStyle = eccxSimple Then
         ' **** PROBLEM **** - can't get hWnd...
         m_hWndEdit = FindWindowEx(m_hWndParent, ByVal 0&, "Edit", ByVal 0&)
         If m_hWndEdit <> 0 Then
            AttachMessage Me, m_hWndEdit, WM_SETFOCUS
            AttachMessage Me, m_hWndEdit, WM_MOUSEACTIVATE
            AttachMessage Me, m_hWndEdit, WM_KEYDOWN
            AttachMessage Me, m_hWndEdit, WM_CHAR
            AttachMessage Me, m_hWndEdit, WM_KEYUP
            AttachMessage Me, m_hWndCbo, WM_CTLCOLOREDIT
         End If
      Else
         AttachMessage Me, m_hWndCbo, WM_KEYDOWN
         AttachMessage Me, m_hWndCbo, WM_CHAR
         AttachMessage Me, m_hWndCbo, WM_KEYUP
      End If
      m_bSubclass = True
      
   End If
   
   SetParent m_hWnd, m_hWndParent
   MoveWindow m_hWnd, 0, 0, lWidth, lHeight, 1
   ShowWindow m_hWnd, SW_SHOWNORMAL
   EnableWindow m_hWnd, Abs(m_bEnabled)
   SendMessageLong m_hWnd, CBEM_SETEXSTYLE, 0, m_eExStyle
   SendMessageLong m_hWnd, WM_SETREDRAW, Abs(m_bRedraw), 0
   
End Function

Private Function pDestroy()
   If m_bSubclass Then
      DetachMessage Me, m_hWndParent, WM_COMMAND
      DetachMessage Me, m_hWndParent, WM_SETFOCUS
      DetachMessage Me, m_hWndParent, WM_NOTIFY
      If m_hWnd <> 0 Then
         DetachMessage Me, m_hWnd, WM_DRAWITEM
         DetachMessage Me, m_hWnd, WM_CTLCOLORLISTBOX
         If m_hWndCbo <> 0 Then
            DetachMessage Me, m_hWndCbo, WM_SETFOCUS
            DetachMessage Me, m_hWndCbo, WM_MOUSEACTIVATE
            DetachMessage Me, m_hWndCbo, WM_KEYDOWN
            DetachMessage Me, m_hWndCbo, WM_CHAR
            DetachMessage Me, m_hWndCbo, WM_KEYUP
            
            If m_eStyle = eccxDropDownCombo Or m_eStyle = eccxSimple Then
               If m_hWndEdit <> 0 Then
                  DetachMessage Me, m_hWndEdit, WM_SETFOCUS
                  DetachMessage Me, m_hWndEdit, WM_MOUSEACTIVATE
                  DetachMessage Me, m_hWndEdit, WM_KEYDOWN
                  DetachMessage Me, m_hWndEdit, WM_CHAR
                  DetachMessage Me, m_hWndEdit, WM_KEYUP
                  DetachMessage Me, m_hWndCbo, WM_CTLCOLOREDIT
               End If
            Else
               DetachMessage Me, m_hWndCbo, WM_KEYDOWN
               DetachMessage Me, m_hWndCbo, WM_CHAR
               DetachMessage Me, m_hWndCbo, WM_KEYUP
            End If
         End If
      End If
      m_bSubclass = False
   End If
      
   If Not (m_hWnd = 0) Then
      ShowWindow m_hWnd, SW_HIDE
      SetParent m_hWnd, 0
      DestroyWindow m_hWnd
      m_hWnd = 0
      m_hWndEdit = 0
   End If
   
   m_hWndParent = 0
   
   If Not (m_hFnt = 0) Then
      DeleteObject m_hFnt
   End If
      
   If Not (m_hBrBack = 0) Then
      DeleteObject m_hBrBack
      m_hBrBack = 0
   End If
      
End Function
Private Function piGetShiftState() As ShiftConstants
Dim iR As Integer
Dim lR As Long
Dim lKey As Long
    iR = iR Or (-1 * pbKeyIsPressed(vbKeyShift))
    iR = iR Or (-2 * pbKeyIsPressed(vbKeyMenu))
    iR = iR Or (-4 * pbKeyIsPressed(vbKeyControl))
    piGetShiftState = iR
End Function
Private Function pbKeyIsPressed( _
        ByVal nVirtKeyCode As KeyCodeConstants _
    ) As Boolean
Dim lR As Long
    lR = GetAsyncKeyState(nVirtKeyCode)
    If (lR And &H8000&) = &H8000& Then
        pbKeyIsPressed = True
    End If
End Function

Private Function plDrawItem(ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tDis As DRAWITEMSTRUCT
Dim bEnabled As Boolean
Dim bSelected As Boolean
Dim tLF As LOGFONT
Dim hMem As Long

   ' Debug.Print "OwnerDraw.."
   
   CopyMemory tDis, ByVal lParam, Len(tDis)
   
   ' Evaluate enabled/selected state of item:
   bEnabled = Not ((tDis.ItemState And ODS_DISABLED) = ODS_DISABLED)
   bSelected = ((tDis.ItemState And ODS_SELECTED) = ODS_SELECTED)
   If (bSelected) Then
       ' Only draw selected in the combo when the
       ' focus is on the control:
       If (tDis.ItemState And ODS_COMBOBOXEDIT) = ODS_COMBOBOXEDIT Then
           If (tDis.ItemState And ODS_FOCUS) <> ODS_FOCUS Then
               bSelected = False
           End If
       End If
   End If

   ' Ensure we have the correct font and colours selected:
   If (m_hFnt = 0) Then
       pOLEFontToLogFont UserControl.Font, UserControl.hdc, tLF
       m_hFnt = CreateFontIndirect(m_tlF)
   End If
   ' Get the item data for this item:
   
   If (tDis.ItemState And ODS_COMBOBOXEDIT) = ODS_COMBOBOXEDIT Then
       If Not (pbIsCurrentFont(m_tULF)) Then
           DeleteObject m_hFnt
           LSet m_tlF = m_tULF
           m_hFnt = CreateFontIndirect(m_tlF)
       End If
   End If
   m_hFntOld = SelectObject(tDis.hdc, m_hFnt)

   If m_eClientDraw <> eccxOwnerDraw Then
       ' Draw by default mechanism:
       pDefaultDrawItem tDis.hdc, tDis.ItemId, tDis.ItemAction, tDis.ItemState,
        _
           tDis.rcItem.Left, tDis.rcItem.Top, tDis.rcItem.Right,
            tDis.rcItem.Bottom
   End If
   If m_eClientDraw <> eccxDrawDefault And m_eClientDraw <> eccxDrawODCboList
    Then
       ' Notify the client its time to draw:
       RaiseEvent DrawItem(tDis.ItemId, tDis.hdc, _
                           bSelected, bEnabled, _
                           tDis.rcItem.Left, tDis.rcItem.Top,
                            tDis.rcItem.Right, tDis.rcItem.Bottom, _
                           m_hFntOld)
   End If
   
   SelectObject tDis.hdc, m_hFntOld
   
   plDrawItem = 1
    
End Function
Private Function pbIsCurrentFont(tLF As LOGFONT) As Boolean
Dim sCurrentFace As String
Dim sItemFace As String
    If (tLF.lfFaceName(0) = 0) Then
        ' Default
        pbIsCurrentFont = True
    Else
        If (tLF.lfWeight = m_tlF.lfWeight) And (tLF.lfItalic = m_tlF.lfItalic)
         And (tLF.lfHeight = m_tlF.lfHeight) Then
            sCurrentFace = StrConv(tLF.lfFaceName, vbUnicode)
            sItemFace = StrConv(m_tlF.lfFaceName, vbUnicode)
            If (sCurrentFace = sItemFace) Then
                pbIsCurrentFont = True
            End If
        End If
    End If
End Function

Private Property Let ISubClass_MsgResponse(ByVal RHS As EMsgResponse)
   '
End Property

Private Property Get ISubClass_MsgResponse() As EMsgResponse
   Select Case CurrentMessage
   Case WM_MOUSEACTIVATE, WM_CHAR, WM_KEYDOWN, WM_DRAWITEM
      ISubClass_MsgResponse = emrConsume
   Case Else
      ISubClass_MsgResponse = emrPreprocess
   End Select
End Property

Private Function ISubClass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tNMH As NMHDR
Dim tNMHE As NMCBEENDEDIT
Dim tNMHEW As NMCBEENDEDITW
Dim tR As RECT
Dim tDis As DRAWITEMSTRUCT
Dim bCancel As Boolean
Dim sMsg As String
Dim iPos As Long
Dim iKeyCode As Integer
Dim sText As String

   '
   Select Case iMsg
   Case WM_DRAWITEM
      If m_eClientDraw = eccxDrawDefault Or m_eClientDraw = eccxFontPicker Or
       m_eClientDraw = eccxDriveList Then
         ISubClass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
         Exit Function
      End If
      ISubClass_WindowProc = plDrawItem(wParam, lParam)
      
   Case WM_NOTIFY
      CopyMemory tNMH, ByVal lParam, Len(tNMH)
      If tNMH.hwndFrom = m_hWnd Then
         Select Case tNMH.code
         Case CBEN_BEGINEDIT
            RaiseEvent BeginEdit(ListIndex)
         Case CBEN_DELETEITEM
            ' ... no need to intercept
         Case CBEN_INSERTITEM
            ' ... no need to intercept
         Case CBEN_ENDEDITW
            ' Debug.Print "EndEditW"
            CopyMemory tNMHEW, ByVal lParam, LenB(tNMHEW)
            sMsg = tNMHEW.szText
            iPos = InStr(sMsg, vbNullChar)
            If iPos > 1 Then
               sMsg = Left$(sMsg, iPos - 1)
            ElseIf iPos = 1 Then
               sMsg = ""
            End If
            RaiseEvent EndEdit(ListIndex, (tNMHEW.fChanged <> 0), sMsg,
             tNMHEW.iWhy, tNMHEW.iNewSelection)
         Case CBEN_ENDEDITA
            ' Debug.Print "EndEditA"
            CopyMemory tNMHE, ByVal lParam, LenB(tNMHE)
            sMsg = StrConv(tNMHE.szText, vbUnicode)
            iPos = InStr(sMsg, vbNullChar)
            If iPos > 1 Then
               sMsg = Left$(sMsg, iPos - 1)
            ElseIf iPos = 1 Then
               sMsg = ""
            End If
            RaiseEvent EndEdit(ListIndex, (tNMHE.fChanged <> 0), sMsg,
             tNMHE.iWhy, tNMHE.iNewSelection)
         End Select
      End If
      
   Case WM_CTLCOLORLISTBOX, WM_CTLCOLOREDIT
      ' This is the only way to get the handle of the
      ' list box portion of a combo box:
      If (iMsg = WM_CTLCOLORLISTBOX) Then
         If m_eStyle <> eccxSimple Then
            If (m_hWndDropDown = 0) Then
               m_hWndDropDown = lParam
               If (IsWindow(m_hWndDropDown)) Then
                  GetWindowRect m_hWndDropDown, tR
                  bCancel = False
                  RaiseEvent RequestDropDownResize(tR.Left, tR.Top, tR.Right,
                   tR.Bottom, bCancel)
                  If Not bCancel Then
                     MoveWindow m_hWndDropDown, tR.Left, tR.Top, tR.Right -
                      tR.Left, tR.Bottom - tR.Top, 1
                  End If
               End If
               If m_hWndEdit <> 0 Then
                  SetFocusAPI m_hWndEdit
               End If
            End If
         End If
      End If
      Debug.Print "WM_CTLCOLOR", Hex(iMsg)
      ISubClass_WindowProc = m_hBrBack
      
   Case WM_COMMAND
      If lParam = m_hWnd Then
         ' Debug.Print "WM_COMMAND"
         Select Case (wParam \ &H10000) And &HFFFF&
         Case CBN_DBLCLK
            RaiseEvent DblClick
         Case CBN_DROPDOWN
            RaiseEvent DropDown
         Case CBN_CLOSEUP
            m_hWndDropDown = 0
            RaiseEvent CloseUp
         Case CBN_SETFOCUS, CBN_KILLFOCUS
            ' Not required, handed by UserControl
         Case CBN_SELCHANGE
            RaiseEvent Change
            RaiseEvent Click
         Case CBN_EDITCHANGE
            RaiseEvent Change
         End Select
      End If
            
   
   Case WM_KEYDOWN
      iKeyCode = (wParam And &HFF)
      RaiseEvent KeyDown(iKeyCode, piGetShiftState())
      If (iKeyCode = 0) Then
         ' consume
      Else
         If iKeyCode <> 0 Then
            wParam = wParam And Not &HFF&
            wParam = wParam Or (iKeyCode And &HFF&)
            ISubClass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
            If m_eStyle = eccxDropDownCombo And m_bDoAutoComplete Then
               If ComboIsDropped And iKeyCode = vbKeyReturn Then
                  sText = Text
                  ShowDropDown False
                  Text = sText
               End If
            End If
         End If
      End If
      
   Case WM_CHAR
      iKeyCode = (wParam And &HFF)
      If hwnd = m_hWndCbo Then
         If m_eStyle <> eccxDropDownList Then
            ' Forward the message on to the edit box:
            SendMessageLong m_hWndEdit, iMsg, wParam, lParam
            iKeyCode = 0
         End If
      End If
         
      If iKeyCode <> 0 Then
         RaiseEvent KeyPress(iKeyCode)
         If (iKeyCode = 0) Then
            ' consume:
         Else
            If (m_eStyle <> eccxDropDownList) Then
               If (m_bDoAutoComplete) Then
                  AutoCompleteKeyPress iKeyCode
                  Debug.Print iKeyCode
                  If (iKeyCode = vbKeyEscape) Then
                     ' consume:
                     Debug.Print "Escape"
                     ISubClass_WindowProc = CallOldWindowProc(hwnd, iMsg,
                      wParam, lParam)
                     If ComboIsDropped Then
                        ShowDropDown False
                     End If
                     RaiseEvent AutoCompleteSelection(List(ListIndex),
                      ListIndex)
                  End If
               End If
            End If
            wParam = wParam And Not &HFF&
            wParam = wParam Or (iKeyCode And &HFF&)
            If (iKeyCode <> 0) Then
               ISubClass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam,
                lParam)
            End If
         End If
      End If
      
   Case WM_KEYUP
      ' Debug.Print "sending to ", hwnd
      iKeyCode = (wParam And &HFF)
      RaiseEvent KeyUp(iKeyCode, piGetShiftState())
      If (iKeyCode = 0) Then
         ' consume
      Else
         wParam = wParam And Not &HFF&
         wParam = wParam Or (iKeyCode And &HFF&)
         ISubClass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      End If
            
   '
    ----------------------------------------------------------------------------
   --
   ' Implement focus.  Many many thanks to Mike Gainer for showing me this
   ' code.
   Case WM_SETFOCUS
      If Not m_bInFocus Then
         If IsWindowVisible(hwnd) Then
            If (m_hWndCbo = hwnd) Or (m_hWndEdit = hwnd) Or (m_hWnd = hwnd) Then
               ' The combo box itself
               Dim pOleObject                  As IOleObject
               Dim pOleInPlaceSite             As IOleInPlaceSite
               Dim pOleInPlaceFrame            As IOleInPlaceFrame
               Dim pOleInPlaceUIWindow         As IOleInPlaceUIWindow
               Dim pOleInPlaceActiveObject     As IOleInPlaceActiveObject
               Dim PosRect                     As RECT
               Dim ClipRect                    As RECT
               Dim FrameInfo                   As OLEINPLACEFRAMEINFO
               Dim grfModifiers                As Long
               Dim AcceleratorMsg              As MSG
               
               'Get in-place frame and make sure it is set to our in-between
               'implementation of IOleInPlaceActiveObject in order to catch
               'TranslateAccelerator calls
               Set pOleObject = Me
               Set pOleInPlaceSite = pOleObject.GetClientSite
               pOleInPlaceSite.GetWindowContext pOleInPlaceFrame,
                pOleInPlaceUIWindow, VarPtr(PosRect), VarPtr(ClipRect),
                VarPtr(FrameInfo)
               CopyMemory pOleInPlaceActiveObject,
                m_IPAOHookStruct.ThisPointer, 4
               pOleInPlaceFrame.SetActiveObject pOleInPlaceActiveObject,
                vbNullString
               If Not pOleInPlaceUIWindow Is Nothing Then
                  pOleInPlaceUIWindow.SetActiveObject pOleInPlaceActiveObject,
                   vbNullString
               End If
               CopyMemory pOleInPlaceActiveObject, 0&, 4
               m_bInFocus = True
            Else
               ' The user control - forward focus to the
               ' Comboex control window:
               SetFocusAPI m_hWnd
            End If
         End If
      End If
      
   Case WM_MOUSEACTIVATE
      If Not m_bInFocus Then
         If GetFocus() <> m_hWndCbo And GetFocus() <> m_hWndEdit Then
            ' Click mouse down but miss the contained control; eat
            ' activate and setfocus to the the user control, this in
            ' turn focuses the contained Comboex
            SetFocusAPI UserControl.hwnd
            ISubClass_WindowProc = MA_NOACTIVATE
            Exit Function
         Else
            ISubClass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
         End If
      Else
         ISubClass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      End If
   ' End Implement focus.
   '
    ----------------------------------------------------------------------------
   --
   End Select
   
End Function

Private Sub UserControl_Initialize()
Dim iccex As tagInitCommonControlsEx
   debugmsg "vbalComboEx:Initialize"
   
   ' Ensure CC available:
   With iccex
       .lngSize = LenB(iccex)
       .lngICC = ICC_USEREX_CLASSES
   End With
   InitCommonControlsEx iccex
   
   ' Default conditions:
   m_bEnabled = True
   m_bRedraw = True
   
   ' Attach custom IOleInPlaceActiveObject interface
   Dim IPAO As IOleInPlaceActiveObject

   With m_IPAOHookStruct
      Set IPAO = Me
      CopyMemory .IPAOReal, IPAO, 4
      CopyMemory .TBEx, Me, 4
      .lpVTable = IPAOVTable
      .ThisPointer = VarPtr(m_IPAOHookStruct)
   End With
   
End Sub

Private Sub UserControl_InitProperties()
   m_bDesignTime = Not (UserControl.Ambient.UserMode)
   plCreate
   Set Font = UserControl.Ambient.Font
   BackColor = vbWindowBackground
End Sub

Private Sub UserControl_LostFocus()
   Debug.Print "LostFocus"
   m_bInFocus = False
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Dim lH As Long

   m_bDesignTime = Not (UserControl.Ambient.UserMode)
   Debug.Print UserControl.Extender.Name
   
   Style = PropBag.ReadProperty("Style", eccxDropDownCombo)
   Enabled = PropBag.ReadProperty("Enabled", True)
   plCreate
      
   ExtendedUI = PropBag.ReadProperty("ExtendedUI", True)
   DropDownWidth = PropBag.ReadProperty("DropDownWidth", -1)
   AutoCompleteListItemsOnly =
    PropBag.ReadProperty("AutoCompleteListItemsOnly", False)
   AutoCompleteItemsAreSorted =
    PropBag.ReadProperty("AutoCompleteItemsAreSorted", False)
   DoAutoComplete = PropBag.ReadProperty("DoAutoComplete", False)
   DrawStyle = PropBag.ReadProperty("DrawStyle", eccxDrawDefault)
   Redraw = PropBag.ReadProperty("Redraw", True)
   BackColor = vbWindowBackground
   
   AddItem "To Allow SetFont/Height"
   Dim iFnt As IFont, iFntCopy As IFont
   Set iFnt = UserControl.Font
   iFnt.Clone iFntCopy
   Set m_fnt = iFntCopy
   Set Font = PropBag.ReadProperty("Font", m_fnt)
   Clear
   
   If Not (m_bDesignTime) Then
      Select Case DrawStyle
      Case eccxDriveList
         LoadDriveList Me, (m_lIconSizeY > 16)
      Case eccxSysColourPicker
         LoadSysColorList Me
      Case eccxFontPicker
         LoadFontList Me, "", -1, -1
      End Select
   End If
   
   ' for VB6
   UserControl_Resize
   
   m_bEvents = True
End Sub

Private Sub UserControl_Resize()
Dim tR As RECT
Dim lHeight As Long

   If Not (m_hWnd = 0) Then
      If Not (m_eStyle = eccxSimple) Then
         If m_bDesignTime Then
            ' Make sure the User Control's height is correct:
            lHeight = SendMessageLong(m_hWnd, CB_GETITEMHEIGHT, -1, 0)
            UserControl.Extender.Height = (lHeight + 6) * Screen.TwipsPerPixelY
         End If
      End If
      
      GetClientRect UserControl.hwnd, tR
      MoveWindow m_hWnd, 0, 0, tR.Right - tR.Left, tR.Bottom - tR.Top, 1
      If m_eStyle <> eccxSimple Then
         lHeight = tR.Bottom - tR.Top + 2 + SendMessageLong(m_hWnd,
          CB_GETITEMHEIGHT, 0, 0) * 8
      Else
         lHeight = tR.Bottom - tR.Top
      End If
      MoveWindow m_hWndCbo, 0, 0, tR.Right - tR.Left, lHeight, 1
   End If

End Sub

Private Sub UserControl_Terminate()
   ' Detach the custom IOleInPlaceActiveObject interface
   ' pointers.
   With m_IPAOHookStruct
      CopyMemory .IPAOReal, 0&, 4
      CopyMemory .TBEx, 0&, 4
   End With
   
   pDestroy
   
   debugmsg "vbalComboEx:Terminate"
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   PropBag.WriteProperty "Style", Style, eccxDropDownCombo
   PropBag.WriteProperty "Enabled", Enabled, True
   PropBag.WriteProperty "Font", Font
   PropBag.WriteProperty "ExtendedUI", ExtendedUI, True
   PropBag.WriteProperty "DropDownWidth", DropDownWidth, -1
   PropBag.WriteProperty "AutoCompleteListItemsOnly",
    AutoCompleteListItemsOnly, False
   PropBag.WriteProperty "AutoCompleteItemsAreSorted",
    AutoCompleteItemsAreSorted, False
   PropBag.WriteProperty "DoAutoComplete", DoAutoComplete, False
   PropBag.WriteProperty "DrawStyle", DrawStyle, eccxDrawDefault
   PropBag.WriteProperty "Redraw", Redraw, True
   'PropBag.WriteProperty "BackColor", BackColor, vbWindowBackground
End Sub