运用ActiveX组件技术创建通用的查询控件

珠海远都软件有限公司  卞国斌

---- Microsoft 的ActiveX 技 术, 为 应 用 程 序 开 发 提 供 了 强 大 的 工 具。 程 序 开 发 人 员 通 过 使 用ActiveX 控 件, 例 如 系 统 定 制 的 按 钮、 文 本 框、 列 表 框、 组 合 框, 或 者 由 自 己 创 建 的 更 加 复 杂 的 组 合 控 件, 可 以 轻 松 快 捷 地 开 发 出 各 种 应 用 程 序。

---- 笔 者 运 用ActiveX 组 件 技 术, 在Visual Basic 5 ( 简 体 中 文 版) 环 境 下, 创 建 了 一 个 通 用 的 查 询 控 件。 该 控 件 的 功 能 是, 根 据 用 户 的 选 择, 生 成 对 数 据 库 表 的 各 种 查 询 组 合, 即 查 询 语 句 的Where 子 句。

控 件 的 实 现 步 骤
---- 1. 建 立 控 件 工 程

---- 从" 文 件" 菜 单 里 选 择" 新 建 工 程" 命 令。 在 新 建 工 程 对 话 框 里, 选 择"ActiveX 控 件" 图 标, 用" 查 询 控 件.VBP" 文 件 名 保 存 工 程。 这 时 在 工 具 栏 中 已 经 添 加 了" 查 询 控 件" 的 图 标, 并 且 该 控 件 和OLE 控 件 的 图 标 都 处 于 隙 式 状 态。 只 要" 查 询 控 件" 可 见, 它 们 就 始 终 为 此 状 态。

---- 2. 建 立 控 件 窗 体

---- 对 工 程 中 的UserControl1( 用 户 控 件) 模 块 进 行 处 理, 建 立 如 图 所 示 的 控 件 对 象 窗 体:

---- (1) 放 置1 个 标 签 框。 设 置Caption 属 性 为" 选 择 查 询 条 件:";

---- (2) 放 置7 个 检 查 框。 检 查 框 由 上 而 下 名 为Check1(0)-Check1(6), 且Check1(6) 的Caption 属 性 设 为" 显 示 查 询 字 符 串";

---- (3) 放 置18 个 组 合 框。 组 合 框 分 左、 中、 右3 列6 横 行, 自 左 至 右、 由 上 而 下, 名 为Combo1(0)-Combo1(17)。 给 中 间 列6 个 组 合 框 的List 属 性 输 入: =、< =、 >=、< 、 >、Like 等 关 系 运 算 符;

---- (4) 放 置10 个 选 择 按 钮。 按 钮 自 左 到 右、 由 上 而 下 名 为Option1(0) -Option1(9), 且 左 列 的Text 的 属 性 设 为" 与", 右 列 设 为" 或"。

---- (5) 放 置2 个 命 令 按 钮。 按 钮 名 为Command1(0) 和Command1(1), 设 置Caption 属 性 分 别 为" 确 定" 和" 取 消"。

---- 3. 定 义 控 件 属 性 和 事 件

---- 控 件 属 性 和 事 件, 是 控 件 的 使 用 者 与 控 件 交 互 的 接 口。 由 于 该 控 件 要 根 据 使 用 者 的 要 求 查 询 指 定 的 数 据 库 表, 并 返 回 查 询 字 符 串, 故 需 定 义Connect( 数 据 库 连 接 信 息)、Database( 数 据 库 名)、Tablename( 表 名) 三 个 属 性 和GetSelectionSql( 获 取 查 询 字 符 串) 一 个 事 件。

---- 定 义 控 件 属 性 有 几 种 方 法: 一 是 使 用 类 属 性 过 程。 二 是 建 立 属 性 页。 这 里 使 用 最 简 单 的 方 法, 向 控 件 模 块 添 加 公 共 变 量。

---- 在 控 件 代 码 的" 通 用 声 明" 区 域 输 入 下 述 代 码:

Public Connect, Database, Tablename As String
Public Event GetSelectionSql(ByVal SelectionSql As String)
同时定义几个临时变量:
Dim db As Database, rs, rs1 As Recordset
Dim SelectionSql,Msg As String
Dim i As Integer

---- 4. 为 控 件 编 程

---- 为 了 实 现 控 件 功 能, 需 要 对 控 件 的 事 件 编 程。( 以 下 程 序 都 经 过 实 际 运 行 测 试, 可 以 原 样 复 制 使 用)

(1) o1(Index + 2), Combo1(Index).Text)
    End Select
End Sub

---- (6) 单 击 命 令 按 钮: 单 击" 确 定" 时, 根 据 用 户 的 选 择 建 立 查 询 字 符 串, 并 引 发GetSelectionSql 事 件 返 回 字 符 串; 单 击" 取 消" 时, 关 闭 查 询 窗 体。

Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0 注释：确定
SelectionSql = " WHERE "
For i = 0 To Check1.Count - 1
     If Check1(i).Value = 1 Then
         If SelectionSql <  > " WHERE " Then
  If Option1((i - 1) * 2) Then
      SelectionSql = SelectionSql & " AND "
  Else
      SelectionSql = SelectionSql & " OR "
  End If
         End If  
         If Combo1(i * 3) <  > "" Then
  SelectionSql = SelectionSql & Combo1(i * 3)  
         Else
  SelectionSql = ""
  MsgBox "该项还未设值!", 64, "查询条件:"
  Combo1(i * 3).SetFocus
  Exit Sub
         End If  
         If Combo1(i * 3 + 1) <  > "" Then
  SelectionSql = SelectionSql & " " & Combo1(i * 3 + 1) _ & " "
         Else
  SelectionSql = ""
  MsgBox "该项还未设值!", 64, "查询条件:"
  Combo1(i * 3 + 1).SetFocus
  Exit Sub
         End If  
         SelectionSql = SelectionSql _
    & CheckType(rs(Combo1(i * 3).Text).Type, _ Combo1(i * 3 + 2))
     End If
Next i  
If SelectionSql = " WHERE " Then SelectionSql = ""
If Check2.Value = 1 Then
     MsgBox "SelectionSql = " & SelectionSql , 64, "查询字符串:"
End If
RaiseEvent GetSelectionSql(SelectionSql)
Unload Parent
        Case 1 注释：取消
Unload Parent
    End Select
End Sub

---- (7) 自 定 义 过 程: 给 左 列 组 合 框 置 值- 表 的 列 名 。

Private Sub LoadCboLeft(ByVal Cbo As ComboBox)
    If rs.EOF And rs.BOF Then
MsgBox Tablename & "表中无记录!", 64, "查询条件:"
        Exit Sub
    End If
    rs.MoveFirst    
    For i = 0 To rs.Fields.Count - 1
        Cbo.AddItem rs(i).Name
    Next
    Cbo.Text = Cbo.List(0)
End Sub

---- (8) 自 定 义 过 程: 给 右 列 组 合 框 置 值 - 根 据 左 列 组 合 框 中 表 的 列 名 置 相 应 的 列 值。

Private Sub LoadCboRight(ByVal Cbo As
ComboBox, ByVal ColName As String)
    If rs.EOF And rs.BOF Then
        MsgBox Tablename & "表中无记录!", 64, "查找条件:"
        Exit Sub
    End If    
    Cbo.Clear    
    Set rs1 = db.OpenRecordset _
("select DISTINCT " & ColName & " from " & Tablename)
    Do While Not rs1.EOF
        If Not IsNull(rs1(0)) Then
Cbo.AddItem rs1(0)
        End If
        rs1.MoveNext
    Loop    
    Cbo.Text = Cbo.List(0)
End Sub

---- (9) 自 定 义 函 数: 检 查 数 据 类 型。

Public Function CheckType(ByVal sType As String, _
            ByVal sValue As String) As String      
    Select Case sType
        Case dbBoolean
If sValue = ("true" Or "false" Or 0 Or 1) Then
     CheckType = CBool(sValue)
     Exit Function
End If
        Case dbByte
If IsNumeric(sValue) Then
     CheckType = CByte(sValue)
     Exit Function
End If
        Case dbInteger
If IsNumeric(sValue) Then
     CheckType = CInt(sValue)
     Exit Function
End If
        Case dbLong
If IsNumeric(sValue) Then
     CheckType = CLng(sValue)
     Exit Function
End If
        Case dbCurrency
If IsNumeric(sValue) Then
     CheckType = CCur(sValue)
     Exit Function
End If
        Case dbSingle
If IsNumeric(sValue) Then
     CheckType = CSng(sValue)
     Exit Function
End If
        Case dbDouble
If IsNumeric(sValue) Then
     CheckType = CDbl(sValue)
     Exit Function
End If
        Case dbDate
If IsDate(sValue) Then
     CheckType = "CDate(注释：" & sValue & "注释：)"
     Exit Function
End If
        Case dbText
CheckType = "注释：" & CStr(sValue) & "注释："
Exit Function
        Case Else
MsgBox
"该项超出查询范围或数据类型不对!", 16, "查询条件:"
CheckType = ""
    End Select
End Function

---- 5. 生 成OCX 文 件

---- 在" 工 程 组" 窗 口 里 选 定" 查 询 控 件.VBP" 工 程。 从" 文 件" 菜 单 里 选 择" 生 成 查 询 控 件.OCX", 生 成 工 程 窗 口 打 开, 选 择 好 保 存 控 件 的 路 径 和 文 件 名 后, 按 确 定 按 钮。

---- 至 此," 查 询 控 件" 已 创 建 完 毕。Visual Basic 已 在 您 的 操 作 系 统 注 册 表 里 注 册 了 这 个 控 件。 在Windows 95 中 控 件 的 注 册 位 置 是:HKEY_LOCAL MACHINE\SOFTWARE\CLASSES\CLSID。

控 件 的 使 用 说 明
---- 控 件 创 建 好 后, 就 可 以 提 供 给 他 人 使 用 了。 可 以 通 过 创 建CAB 文 件, 经 国 际 互 连 网 发 行 给 用 户 使 用。 这 里 仅 说 明 在Visual Basic 编 程 环 境 下 的 使 用。
---- 1. 将" 查 询 控 件.OCX"、" 查 询 控 件.EXP"、" 查 询 控 件.LIB" 这 三 个 文 件 复 制 到 您 的 服 务 器 或 工 作 站 的 某 一 路 径 下。 例 如:C:\ 用 户 控 件。

---- 2. 从" 工 程" 菜 单 里, 打 开" 部 件" 窗 口, 选 定" 查 询 控 件"。 如 果 在 选 择 窗 口 中 未 显 示" 查 询 控 件", 则 通 过 浏 览 按 钮 来 选 定。 选 定 好 后, 按 确 定 按 钮 返 回," 查 询 控 件" 图 标 将 显 式 地 显 示 在 工 具 栏 中。

---- 3. 新 建 或 添 加 一 个" 标 准EXE" 工 程, 双 击 或 拖 放" 查 询 控 件" 图 标 到 工 程 的 窗 体 上。

---- 4. 选 中 窗 体 上 的" 查 询 控 件", 在 窗 体 的 属 性 栏 或 代 码 窗 口 "Form_Load" 事 件 中 为 属 性 赋 值。 例 如: Private Sub Form_Load()

---- 查 询 控 件.Connect = "Aclearcase/" target="_blank" >ccess"
---- 查 询 控 件.Database = "d:\my documents\access\myweb.mdb"
---- 查 询 控 件.Tablename = "address"
---- End Sub

---- 5. 在 窗 体 代 码 窗 口 的" 查 询 控 件_GetSelectionSql" 自 定 义 事 件 中 获 取 查 询 字 符 串。 将 该 字 符 串 连 接 到 显 示 窗 体 或 需 要 地 方 的SELECT 语 句 上, 即 可 完 成 各 种 情 况 的 组 合 查 询。 例 如:

---- Private Sub 查 询 控 件_GetSelectionSql(ByVal SelectionSql As String)
---- MySelectionSql = SelectionSql
---- End Sub 

原文转自：http://www.ltesting.net