实 现 方 法：

声 明 一Dynaset 类 型 的Object：tbOLEObjects。

在Form_Load 事 件 的 执 行 程 序 中， 将Data1.RecordSet 赋 给tbOLEObjects ， 并 记 录tbOLEObjects 中 的 记 录 数。

在Data1_Validate 事 件 的 执 行 程 序 中， 使tbOLEObjects 执 行 的 动 作 与Data1 一 致， 即： 在Data1 的Data1_Validate 事 件 执 行 程 序 中， 当Data1 执 行Data1.RecordSet.MoveNext 或Data1.RecordSet.MoveFirst 时，tbOLEObjects 也 要 执 行tbOLEObjects.MoveNext 或tbOLEObjects.MoveFirst。 实 现 时， 先 保 存 当 前OLE 控 件 中 的 内 容， 然 后 执 行tbOLEObjects.MoveNext 或tbOLEObjects.MoveFirst 方 法， 再 取 出OLE 字 段 中 的 内 容， 插 入 到OLE 控 件 中。

当 系 统 执 行 了 一 个SQL 语 句 后，Data1 显 示 的 记 录 直 接 跳 到 某 一 记 录， 对tbOLEObjects 来 说， 则 要 执 行 一 查 找 过 程， 使 得tbOLEObjects 的 当 前 记 录 与Data1 的 当 前 记 录 一 致。 实 现 时， 先 保 存 当 前OLE 控 件 中 的 内 容， 再 在tbOLEObjects 中 查 找Data1 的 当 前 记 录， 找 到 后， 将 其OLE 字 段 中 的 内 容 取 出 并 插 入 到OLE 控 件 中。
下 面 给 出 的 实 现 例 子 是 从 本 人 编 写 的 一 个 软 件 中 摘 录 出 来 的， 它 说 明 了 具 体 的 实 现 方 法， 但 不 可 以 直 接 使 用， 要 结 合 自 己 的 程 序， 加 上 其 它 必 要 的 部 分。 例 子 中 的 数 据 库 是 一 个 公 文 数 据 库， 保 存 用 户 的 重 要 公 文， 其 中 的OLE 字 段 保 存 的 就 是Word 文 档， 名 字 为File_Cont， 其 它 字 段 是 文 档 的 相 关 信 息， 如 文 档 的 标 题(File_Title)、 等 级(File_Class)、 关 键 字(File_Keyword) 和ID 号(File_ID) 等。
变 量 说 明：

Option Explicit

Dim tbOLEObjects As Dynaset
Dim nRecordCount As Integer 'tbOLEObjects 的 记 录 数
Dim nRecordNumber As Integer 'tbOLEObjects 的 记 录 指 针
Dim bBusy As Interger ' 防 止 重 入 标 志
Dim bUpdated As Integer 'OLE 控 件 的 内 容 发 生 变 化 的 标 志
下 面 的 过 程 要 在 窗 口 的Form_Load 事 件 中 执 行， 完 成 对tbOLEObjects 赋 值 并 计 算 出tbOLEObjects 中 的 记 录 数。
Sub RefreshForm()
Dim eError As Integer

NoRecord = False
Data1.RecordSource = "SELECT * from OwnFile order by File_ID"
Data1.Refresh
Set tbOLEObjects = Data1.Recordset.Clone()
' 给tbOLEObjects 赋 值
' 下 面 这 两 条 语 句 是 必 须 的， 否 则 无 法 求 出tbOLEObjects 中 的 记 录 数
tbOLEObjects.MoveLast
tbOLEObjects.MoveFirst
nRecordCount = tbOLEObjects.RecordCount
' 保 存tbOLEObjects 的 记 录 数
nRecordNumber = 1
' 使 记 录 的 指 针 在 第 一 个 记 录 上
' 设 置 各 控 件 的DataField 属 性， 以 显 示 其 字 段 的 内 容。
txtTitle.DataField = "File_Title"
txtClass.DataField = "File_Class"
txtFileID.DataField = "File_ID"
txtKeyWord.DataField = "File_KeyWord"
' 将OLE 字 段File_Cont 中 的 内 容 取 出 并 插 入OLE 控 件OLE1 中
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))

' 将Data1 指 向 第 一 个 记 录
If Data1.Recordset.RecordCount > 1 Then Data1.Recordset.MoveFirst
End Sub
下 面 是 如 何 在Data1_Validate 事 件 中 加 入 对tbOLEObjects 操 作 代 码 的 例 子。
Sub Data1_Validate(Action As Integer, Save As Integer)
Dim eError As Integer

Select Case Action
Case 1 'Data1 执 行MoveFirst
If Not bBusy Then
bBusy = True
Screen.MousePointer = 11
DoEvents
If bUpdated Then
' 如 果OLE1 中 的 内 容 发 生 了 变 化
Call PutOLEObject
' 保 存OLE1 中 的 内 容
DoEvents
bUpdated = False
End If
If nRecordNumber > 1 Then
tbOLEObjects.MoveFirst ' 到Data1 所 指 向 的 记 录
nRecordNumber = 1 ' 修 改tbOLEObjects 的 指 针
' 取 出 当 前 记 录OLE 字 段 的 内 容
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
DoEvents
End If
Screen.MousePointer = 0
bBusy = False
End If
Case 2 'Data1 执 行 了MovePrevious
If Not bBusy Then ' 用 于 防 止 程 序 重 入
bBusy = True '
Screen.MousePointer = 11
DoEvents
If bUpdated Then ' 如 果OLE1 中 的 内 容 发 生 变 化
Call PutOLEObject ' 保 存OLE1 中 的 内 容
DoEvents
bUpdated = False
End If
If nRecordNumber > 1 Then
tbOLEObjects.MovePrevious ' 到Data1 所 指 向 的 记 录
nRecordNumber = nRecordNumber - 1 ' 修 改tbOLEObjects 的 指 针
' 取 出 当 前 记 录OLE 字 段 的 内 容
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
DoEvents
End If
Screen.MousePointer = 0
bBusy = False
End If
Case 3 'MoveNext
......
Case 4 'MoveLast
......
Case 5 ' 增 加 一 个 新 记 录
If Not bBusy Then
bBusy = True
Screen.MousePointer = 11
DoEvents
If bUpdated Then
Call PutOLEObject
' 保 存 当 前OLE 控 件 中 的 内 容
DoEvents
bUpdated = False
End If
'执行tbOLEObjects.AddNew，修改tbOLEObjects的记录数、指针等
'本例子中未给出这部分代码，程序中在增加按钮的Click事件中执行
Screen.MousePointer = 0
bBusy = False
End If
Case 6 ' 更 新 数 据 库
If Save = True Then
If MsgBox
(" 保 存 所 做 的 修 改?", MSGBOX_TYPE) <> YES Then
Action = 0: Save = False
End If
Case 7
' 删 除 记 录， 与 增 加 记 录 的 过 程 作 同 样 的 考 虑
......
Case 8
......
Case 9
......
Case 10 ' 关 闭 数 据 库
If Save = True Then
If MsgBox
(" 关 闭 数 据 库 前, 保 存 所 做 的 修 改?", MSGBOX_TYPE)
<> YES Then
Save = False
End If
End Select
End Sub
下 面 的 过 程 是 用 户 用Outline 控 件 查 找 数 据 库 中 的Word 文 档， 每 一 个 记 录 对 应 一 个Outline 条 目， 当 用 户 在Outline 的 某 一 条 目 上 作Click 动 作 时， 系 统 就 显 示 出 该 记 录 的 所 有 内 容， 包 括OLE 字 段 的 内 容。 这 里，tbOLEObjects 在 查 找 记 录 时， 使 用 的 是 顺 序 查 找 方 法， 读 者 若 要 加 快 查 找 的 速 度， 可 采 用 其 它 的 查 找 方 法。
Sub Outline1_Click()
Dim stLName As String, stTmp$, eError%
Dim stFName As String

If Outline1.Indent(Outline1.ListIndex) = 2 Then
stTmp$ = Outline1.List(Outline1.ListIndex)
stLName = stGetToken$(stTmp$, ",") ' 读 取 该 记 录 的 标 志
If nRecordCount > 1 Then
tbOLEObjects.MoveFirst
nRecordNumber = 1 ' 到 第 一 个 记 录
Do While Trim$(tbOLEObjects!File_ID) <> stLName
' 开 始 查 找 该 记 录
nRecordNumber = nRecordNumber + 1
tbOLEObjects.MoveNext
Loop
Data1.Recordset.FindFirst "File_ID = '" + stLName + "'"
'Data 控 件 也 要 到 该 记 录
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
' 取 出OLE 字 段 的 内 容
Outline1.SetFocus
' 将 焦 点 放 在Outline 控 件 上
ElseIf nRecordCount = 1 Then
Data1.Recordset.FindFirst "File_ID = '" + stLName + "'"
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
Outline1.SetFocus
End If
End If
End Sub
最 后， 说 明 一 点： 以 上 的 程 序 都 是 在Windows3.2 中 文 版 和VB3 环 境 下 实 现 的， 若 在Windows 环 境 下， 用VB4 编 写 这 种 程 序， 上 面 的 程 序 要 作 改 动， 不 能 直 接 应 用。VB4 中，Data 控 件 理 论 上 是 支 持OLE 数 据 库 字 段 的， 但 这 样 使 用 时， 每 次 执 行MoveFirst 或MoveNext 等 类 似 动 作， 都 会 产 生 一 个 没 有 错 误 号 的"OLE Automation" 错 误， 笔 者 没 有 找 到 产 生 这 个 问 题 的 原 因 和 解 决 方 法， 如 果 有 朋 友 告 知 解 决 方 法， 笔 者 十 分 感 谢。

 2/2   首页 上一页 1 2