ACCESS 中的类

Option Compare Database
Option Explicit

' 声明一个带事件的下拉框变量
Private WithEvents mcboSearch As ComboBox
Private mblnAfterUpdate       As Boolean ' 记录是否在AfterUpdate事件后
Private mstrSearchField       As String  ' 搜索字段
Private mstrSELECT            As String  ' SELECT 子句
Private mstrFROM              As String  ' FROM 子句
Private mstrWHERE             As String  ' WHERE 子句
Private mstrORDERBY           As String  ' ORDER BY 子句

' 初始化方法，设置下拉框及相关参数
Public Sub Init(Combo As ComboBox, _
                SearchField As String, _
                SELECT_Clause As String, _
                FROM_Clause As String, _
                Optional WHERE_Clause As String, _
                Optional ORDER_BY_Clause As String)
    Set mcboSearch = Combo ' 将传入的下拉框赋值给局部变量
    mcboSearch.OnKeyDown = "[Event Procedure]" ' 设置按键按下时的事件处理
    mcboSearch.OnChange = "[Event Procedure]" ' 设置内容变更时的事件处理
    mcboSearch.AfterUpdate = "[Event Procedure]" ' 设置更新后事件处理
    mcboSearch.OnGotFocus = "[Event Procedure]" ' 设置获取焦点时的事件处理
    mcboSearch.OnNotInList = "[Event Procedure]" ' 设置不在列表中的事件处理
    mcboSearch.AutoExpand = False ' 禁用自动扩展
    mstrSearchField = SearchField ' 设置搜索字段
    mstrSELECT = "SELECT " & SELECT_Clause ' 准备SELECT子句
    mstrFROM = " FROM " & FROM_Clause ' 准备FROM子句
    If Len(WHERE_Clause) > 0 Then mstrWHERE = " WHERE " & WHERE_Clause ' 如果有WHERE子句，设置对应变量
    If Len(ORDER_BY_Clause) > 0 Then mstrORDERBY = " ORDER BY " & ORDER_BY_Clause ' 如果有ORDER BY子句，设置对应变量
End Sub
 
' 下拉框更新后事件
Private Sub mcboSearch_AfterUpdate()
    mblnAfterUpdate = True ' 设置更新标记
End Sub

' 下拉框内容改变事件
Private Sub mcboSearch_Change()
    Dim strTemp As String
    Dim strSQL As String
    
    ' 如果是更新后状态
    If mblnAfterUpdate Then
        ' 构建SQL查询语句
        strSQL = mstrSELECT & mstrFROM & mstrWHERE & mstrORDERBY
        If mcboSearch.RowSource <> strSQL Then
            mcboSearch.RowSource = strSQL ' 如果RowSource不一致，则更新
        End If
        mblnAfterUpdate = False ' 重置更新标记
    Else
        ' 清除输入中的单引号
        strTemp = Trim(Replace(mcboSearch.Text, "'", "''"))
        If Len(strTemp) = 0 Then
            ' 如果没有输入内容，使用默认SQL
            strSQL = mstrSELECT & mstrFROM & mstrWHERE & mstrORDERBY
        Else
            ' 构建带有LIKE条件的WHERE子句
            If Len(mstrWHERE) > 0 Then
                strTemp = mstrWHERE & " AND " & mstrSearchField & " Like '*" & strTemp & "*'"
            Else
                strTemp = " WHERE " & mstrSearchField & " Like '*" & strTemp & "*'"
            End If
            strSQL = mstrSELECT & mstrFROM & strTemp & mstrORDERBY ' 完整SQL查询
        End If
        If mcboSearch.RowSource <> strSQL Then
            mcboSearch.RowSource = strSQL ' 如果RowSource不一致，则更新
        End If
        mcboSearch.Dropdown ' 显示下拉列表
    End If
End Sub

' 下拉框获取焦点事件
Private Sub mcboSearch_GotFocus()
    mcboSearch.RowSource = mstrSELECT & mstrFROM & mstrWHERE & mstrORDERBY ' 更新RowSource
End Sub

' 下拉框按键按下事件
Private Sub mcboSearch_KeyDown(KeyCode As Integer, Shift As Integer)
    If Shift = 0 Then
        Select Case KeyCode
        Case vbKeyUp, vbKeyDown
            mcboSearch.OnChange = "" ' 在上/下箭头时禁用OnChange事件
        Case Else
            mcboSearch.OnChange = "[Event Procedure]" ' 其他按键恢复OnChange事件
        End Select
    End If
End Sub

' 下拉框不在列表中事件
Private Sub mcboSearch_NotInList(NewData As String, Response As Integer)
    mcboSearch.Undo ' 撤销当前输入
    Response = acDataErrContinue ' 设置响应为继续
    mcboSearch.RowSource = mstrSELECT & mstrFROM & mstrWHERE & mstrORDERBY ' 更新RowSource
End Sub