ComboBox Class - Mempermudah Pembuatan Aplikasi VB6

Option Explicit 
 
Private WithEvents cbo As ComboBox 
Public AutoDropDown As Boolean 
 
Private Type POINTAPI 
    x As Long 
    y As Long 
End Type 
 
Private Type RECT 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 
 
'API Declarations 
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long 
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long 
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
 
'Contanta 
Private Const CB_GETITEMHEIGHT As Long = &H154 
Private Const CB_SHOWDROPDOWN As Long = &H14F 
Private Const CB_FINDSTRING = &H14C 
Private Const CB_SETDROPPEDWIDTH = &H160 
Private Const CB_FINDSTRINGEXACT As Long = &H158 
Private Const CB_SELECTSTRING As Long = &H14D 
 
Private Const EC_LEFTMARGIN = &H1 
Private Const EC_RIGHTMARGIN = &H2 
Private Const EC_USEFONTINFO = &HFFFF& 
Private Const EM_SETMARGINS = &HD3& 
Private Const EM_GETMARGINS = &HD4& 
 
Public Sub ChangeComboDropDownHeight(Optional ItemToDisplay As Integer = 10) 
 
    Dim pt As POINTAPI 
    Dim rc As RECT 
    Dim cWidth As Long 
    Dim newHeight As Long 
    Dim oldScaleMode As Long 
    Dim numItemsToDisplay As Long 
    Dim itemHeight As Long 
 
    numItemsToDisplay = ItemToDisplay 
 
    oldScaleMode = cbo.Parent.ScaleMode 
    cbo.Parent.ScaleMode = vbPixels 
    cWidth = cbo.Width 
 
    itemHeight = SendMessage(cbo.hwnd, CB_GETITEMHEIGHT, 0, ByVal 0) 
    newHeight = itemHeight * (numItemsToDisplay + 2) 
    Call GetWindowRect(cbo.hwnd, rc) 
 
    pt.x = rc.Left 
    pt.y = rc.Top 
 
    Call ScreenToClient(cbo.Parent.hwnd, pt) 
    Call MoveWindow(cbo.hwnd, pt.x, pt.y, cbo.Width, newHeight, True) 
    cbo.Parent.ScaleMode = oldScaleMode 
 
End Sub 
 
Public Property Let ComboBox(New_ComboBox As ComboBox) 
    Set cbo = New_ComboBox 
End Property 
 
Public Sub ShowDropDown() 
    If cbo.ListCount > 0 Then 
        SendMessage cbo.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0& 
    End If 
End Sub 
 
Private Sub cbo_GotFocus() 
    If Not AutoDropDown Then Exit Sub 
    Dim ret As Long 
    ret = SendMessage(cbo.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&) 
End Sub 
 
Public Sub SetDropWidth(lngWidth As Long) 
    SendMessageLong cbo.hwnd, CB_SETDROPPEDWIDTH, lngWidth, 0 
End Sub 
 
Public Function GetEditHwnd() As Long 
    GetEditHwnd = FindWindowEx(cbo.hwnd, 0, "EDIT", vbNullString) 
End Function 
 
Public Function Find(FindText As String, Optional SetTopIndex As Boolean) As Boolean 
    Dim ret As Long 
    ret = SendMessage(cbo.hwnd, CB_FINDSTRING, -1, ByVal FindText) 
    If ret > -1 Then 
        Find = True 
        If SetTopIndex Then 
            cbo.TopIndex = ret 
            cbo.ListIndex = ret 
        Else 
            cbo.ListIndex = ret 
        End If 
    End If 
End Function 
 
Public Function FindExact(ByVal SearchString As String, Optional ByVal StartFrom As Long = -1) As Long 
    FindExact = SendMessage(cbo.hwnd, CB_FINDSTRINGEXACT, StartFrom, ByVal SearchString) 
End Function 
 
Public Function FindSelect(ByVal SearchString As String, Optional ByVal StartFrom As Long = -1) As Long 
    FindSelect = SendMessage(cbo.hwnd, CB_SELECTSTRING, StartFrom, ByVal SearchString) 
End Function 
 
Public Sub DisableScroll() 
    Call pUnSubClassCombo(cbo) 
    glPrevWndProcC = fSubClassCombo(cbo) 
End Sub 
 
Private Sub Class_Terminate() 
    Call pUnSubClassCombo(cbo) 
End Sub