clscombobox.cls

一个clock的 vb 源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsComboBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Private Declare Function SendDlgItemMessageString Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

' ComboBox Style
Private Const CBS_SORT = &H100
Private Const CBS_AUTOHSCROLL = &H40
Private Const CBS_DROPDOWNLIST = &H3

' ComboBox control Message
Private Const CB_ERR = (-1)
Private Const CB_GETCOUNT = &H146
Private Const CB_GETCURSEL = &H147
Private Const CB_ADDSTRING = &H143
Private Const CB_SETCURSEL = &H14E
Private Const CB_GETLBTEXT = &H148
Private Const CB_DELETESTRING = &H144
Private Const CB_GETLBTEXTLEN = &H149
Private Const CBS_NOINTEGRALHEIGHT = &H400

Private I As Long
Private hWndCB(88) As Long

Public Function CreateCombox(hWndParent As Long, ID&, X&, Y&, nWidth&, nHeight&, Optional hWndFont As Long, Optional Style As Long)
    hWndCB(I) = CreateWindowEx(0&, "COMBOBOX", vbNullString, Style Or WS_CHILD Or WS_VISIBLE Or _
    WS_TABSTOP Or CBS_AUTOHSCROLL Or CBS_NOINTEGRALHEIGHT Or CBS_DROPDOWNLIST, X, Y, _
    nWidth, nHeight, hWndParent, ID, App.hInstance, ByVal 0&)
    Call SendMessage(hWndCB(I), WM_SETFONT, hWndFont, 1)
    I = I + 1
End Function

Public Sub AddItem(hDlg As Long, ID As Long, strItem As String)
    Call SendDlgItemMessageString(hDlg, ID, CB_ADDSTRING, 0, strItem)
End Sub
Public Sub ListIndex(hDlg As Long, ID As Long, Index As Long)
    SendDlgItemMessage hDlg, ID, CB_SETCURSEL, Index, ByVal 0
End Sub
Public Function GetSelItem(hDlg As Long, ID As Long) As Long
    GetSelItem = SendDlgItemMessage(hDlg, ID, CB_GETCURSEL, 0, 0)
End Function

Public Function ListCount(hDlg As Long, ID As Long) As Long
      ListCount = SendDlgItemMessage(hDlg, ID, CB_GETCOUNT, 0, 0)
End Function
Public Function DeleteItem(hDlg As Long, ID As Long) As Long
    Dim nIndex As Long, I As Long
    nIndex = SendDlgItemMessage(hDlg, ID, CB_GETCOUNT, 0, 0)
    For I = nIndex To 1 Step -1
        Call SendDlgItemMessage(hDlg, ID, CB_DELETESTRING, I, 0)
    Next
    SendDlgItemMessage hDlg, ID, CB_SETCURSEL, 0, ByVal 0
End Function
Public Function SelIndexText(hDlg As Long, ID As Long) As String
    Dim Index  As Long, LenBuffer As Long
    Dim lpszBuffer As String
        Index = SendDlgItemMessage(hDlg, ID, CB_GETCURSEL, 0, 0) ' Get Combox Select Index
            If Index <> CB_ERR Then
                LenBuffer = SendDlgItemMessage(hDlg, ID, CB_GETLBTEXTLEN, Index, 0)
                    If LenBuffer <> CB_ERR Then
                        lpszBuffer = String$(LenBuffer, 0)
                        Call GetDlgItemText(hDlg, ID, lpszBuffer, 260)
                        SelIndexText = lpszBuffer
                    End If
            End If
End Function
Public Property Get hWnd(hWndNumber) As Long
    hWnd = hWndCB(hWndNumber)
End Property

Private Sub Class_Initialize()
    I = 0
End Sub

Private Sub Class_Terminate()
    ' 破坏所有被创建的下拉列表框
    Dim N As Long
    If hWndCB(0) <> 0 Then
        For N = 0 To I - 1
            DestroyWindow hWndCB(N)
            hWndCB(N) = 0
        Next
    End If
End Sub