comboboxex.cls

vb得100个编程实例

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ComboBoxEx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Private ImgList As New CImageList

Private Type ComboEx
Info As String
InfoPath As String
End Type

Private Const WM_CTLCOLOREDIT = &H133
Private Const WM_SETFONT = &H30

Private NewComboFont As Long
Private cmbLeft As Integer
Private cmbTop As Integer
Private cmbFontBold As Boolean
Private cmbFontItalic As Boolean
Private cmbFontName As String
Private cmbFontHeight As Integer
Private cmbCustomize As Boolean
Private cmbFontUnderlined As Boolean

 
Private Const SYSTEM_FONT& = 13
Private LF As LOGFONT
Public Enum cbIconState
  cbNormal = 0
  cbDisabled = 1
End Enum
Private ComboInfo() As ComboEx


Private Type FONTSTRUC
    lStructSize As Long
    hWnd As Long
    hdc As Long
    lpLogFont As Long
    iPointSize As Long
    flags As Long
    rgbColors As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
    hInstance As Long
    lpszStyle As String
    nFontType As Integer
    MISSING_ALIGNMENT As Integer
    nSizeMin As Long
    nSizeMax As Long
End Type

Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lffacename As String * 32
   'lfFaceName(LF_FACESIZE) As Byte
End Type

'Get Drive Information
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6

Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SendMessageByString& Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String)
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) 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 SendMessageByLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
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 IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) As Long
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Private Declare Function SendStringMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 
Private Type TEXTMETRIC
        tmHeight As Long
        tmAscent As Long
        tmDescent As Long
        tmInternalLeading As Long
        tmExternalLeading As Long
        tmAveCharWidth As Long
        tmMaxCharWidth As Long
        tmWeight As Long
        tmOverhang As Long
        tmDigitizedAspectX As Long
        tmDigitizedAspectY As Long
        tmFirstChar As Byte
        tmLastChar As Byte
        tmDefaultChar As Byte
        tmBreakChar As Byte
        tmItalic As Byte
        tmUnderlined As Byte
        tmStruckOut As Byte
        tmPitchAndFamily As Byte
        tmCharSet As Byte
End Type

 
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Type tagInitCommonControlsEx
    lngSize As Long
    lngICC As Long
End Type

Private Const CF_BITMAP = 2
Private Const SWP_NOACTIVATE = &H10
Private ObjParent As Object
 
Private Const CB_SETCURSEL = &H14E
Private Const CB_GETCOUNT = &H146
Private Const CB_GETCURSEL = &H147
Private Const CB_GETEDITSEL = &H140
Private Const CB_GETLBTEXT = &H148
Private Const CB_GETLBTEXTLEN = &H149
Private Const CB_SELECTSTRING = &H14D
Private Const CB_FINDSTRING = &H14C
Private Const CB_FINDSTRINGEXACT = &H158
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_SETITEMHEIGHT = &H153
Private Const CB_RESETCONTENT = &H14B
 

Private cbItems As COMBOBOXEXITEMW

Const WS_VISIBLE = &H10000000
Const WS_CHILD = &H40000000
 
Private Const WM_USER = &H400
Private Const GWL_HWNDPARENT = (-8)
Private Const GWL_STYLE = (-16)
 
Private ComboExhWnd As Long

Const HWND_TOPMOST = -1
Const SW_HIDE = 0
Const SW_SHOWNORMAL = 1
 
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOREDRAW = &H8
Const SWP_SHOWWINDOW = &H40

Private Const ICC_USEREX_CLASSES = &H200

Private Const WC_COMBOBOXEXW = "ComboBoxEx32"
Private Const WC_COMBOBOXEXA = "ComboBoxEx32"
 
#If UNICODE Then
Private Const WC_COMBOBOXEX = WC_COMBOBOXEXW
#Else
Private Const WC_COMBOBOXEX = WC_COMBOBOXEXA
#End If

Private Const CBS_DROPDOWN = &H2&
Private Const CBS_DROPDOWNLIST = &H3&
Private Const CBS_HASSTRINGS = &H200&
Private Const CBS_DISABLENOSCROLL = &H800&
Private Const CBS_NOINTEGRALHEIGHT = &H400&
Private Const CBS_OWNERDRAWFIXED = &H10&
Private Const CBS_OWNERDRAWVARIABLE = &H20&
Private Const CBS_SIMPLE = &H1&
Private Const CBS_SORT = &H100&
Private Const CB_SETEDITSEL = &H142
 
Private Const CBEIF_TEXT = &H1
Private Const CBEIF_IMAGE = &H2
Private Const CBEIF_SELECTEDIMAGE = &H4
Private Const CBEIF_OVERLAY = &H8
Private Const CBEIF_INDENT = &H10
Private Const CBEIF_LPARAM = &H20
Private Const CBEIF_DI_SETITEM = &H10000000
Private Const H_MAX As Long = &HFFFF + 1
Private Const CBEN_FIRST = (H_MAX - 800&)
Private Const CBEN_LAST = (H_MAX - 830&)
Private Const CBEN_GETDISPINFO = (CBEN_FIRST - 0)
Private Const CBEN_INSERTITEM = (CBEN_FIRST - 1)
Private Const CBEN_DELETEITEM = (CBEN_FIRST - 2)
Private Const CBEN_BEGINEDIT = (CBEN_FIRST - 4)
Private Const CBEN_ENDEDITA = (CBEN_FIRST - 5)
Private Const CBEN_ENDEDITW = (CBEN_FIRST - 6)
Private Const CBN_EDITCHANGE = 5
Private Const CBN_EDITUPDATE = 6
Private Const CBN_SELCHANGE = 1
Private Const CB_DELETESTRING = &H144
Private Const CBEM_INSERTITEMA = (WM_USER + 1)
Private Const CBEM_SETIMAGELIST = (WM_USER + 2)
Private Const CBEM_GETIMAGELIST = (WM_USER + 3)
Private Const CBEM_GETITEMA = (WM_USER + 4)
Private Const CBEM_SETITEMA = (WM_USER + 5)
Private Const CBEM_DELETEITEM = CB_DELETESTRING
Private Const CBEM_GETCOMBOCONTROL = (WM_USER + 6)
Private Const CBEM_GETEDITCONTROL = (WM_USER + 7)
Private Const CBEM_SETEXSTYLE = (WM_USER + 8)
Private Const CBEM_GETEXSTYLE = (WM_USER + 9)
Private Const CBEM_HASEDITCHANGED = (WM_USER + 10)
Private Const CBEM_INSERTITEMW = (WM_USER + 11)
Private Const CBEM_SETITEMW = (WM_USER + 12)
Private Const CBEM_GETITEMW = (WM_USER + 13)

Private Type COMBOBOXEXITEMW
    mask As Long
    iItem As Long
    pszText As String
    cchTextMax  As Long
    iImage As Long
    iSelectedImage As Long
    iOverlay As Long
    iIndent As Long
    lParam As Long
End Type


#If UNICODE Then
Private Const CBEM_INSERTITEM = CBEM_INSERTITEMW
Private Const CBEM_SETITEM = CBEM_SETITEMW
Private Const CBEM_GETITEM = CBEM_GETITEMW
#Else
Private Const CBEM_INSERTITEM = CBEM_INSERTITEMA
Private Const CBEM_SETITEM = CBEM_SETITEMA
Private Const CBEM_GETITEM = CBEM_GETITEMA
#End If

Private Const CBES_EX_NOEDITIMAGE = &H1
Private Const CBES_EX_NOEDITIMAGEINDENT = &H2
Private Const CBES_EX_PATHWORDBREAKPROC = &H4

Public Function AddIcon(hIcon As Variant)
AddIcon = ImgList.AddIcon(hIcon)
End Function

Public Sub Clear()
  Dim ComboCount As Integer, Total
  Total = ListCount
 
  For ComboCount = 0 To Total - 2
  Call SendMessage(ComboExhWnd, CBEM_DELETEITEM, 0, 0)
  Next

  cbItems.mask = 0&
  cbItems.pszText = ""
  cbItems.cchTextMax = 0
  cbItems.iIndent = 0
  cbItems.iImage = -1
  cbItems.iSelectedImage = -1
  cbItems.iItem = -1
  cbItems.iOverlay = -1
  
  ReDim ComboInfo(0)
   
    
  Call SendMessage(ComboExhWnd, CBEM_INSERTITEM, -1, cbItems)
  Call SendMessage(ComboExhWnd, CBEM_DELETEITEM, 0, 0)
  
  SetIndex 0
End Sub

Public Sub RemoveItem(ByVal Item As Integer)
Call SendMessage(ComboExhWnd, CBEM_DELETEITEM, Item, 0)
SetIndex 0

End Sub
Public Sub Destroy()
ImgList.Destroy
Call DestroyWindow(ComboExhWnd)
End Sub

Public Sub GetAllDrives()
Dim LastItem As Integer
Dim Drv As String, lResult As Long, DrvLetter As String
 
 Additems "Desktop", 0, 0, 0, , 34
 Additems "My Computer", 1, 1, 1, GetWinDir & "\Explorer.exe", 0

LastItem = 2

Drv = String$(128, 0)

lResult = GetLogicalDriveStrings(1024, Drv)

   Do While Left$(Drv, 1) <> Chr$(0)

        DrvLetter = UCase$(Left$(Drv, 3))
        Drv = Mid$(Drv, 5)

        DrvType = GetDriveType(DrvLetter)

        Select Case DrvType
            Case DRIVE_REMOVABLE
                 If DrvLetter = "A:\" Then
                 Additems "3