数据库字段:VB里面超长OLE数据库字段的操纵(2)来源: 发布时间:星期四, 2009年2月12日 浏览:104次 评论:0
orm_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 Dyna 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.Record.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.Record.RecordCount > 1 Then Data1.Record.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.MousePoer = 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.MousePoer = 0 bBusy = False End If Case 2 \'Data1 执 行 了MovePrevious If Not bBusy Then \' 用 于 防 止 程 序 重 入 bBusy = True \' Screen.MousePoer = 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.MousePoer = 0 bBusy = False End If Case 3 \'MoveNext ...... Case 4 \'MoveLast ...... Case 5 \' 增 加 个 新 记 录 If Not bBusy Then bBusy = True Screen.MousePoer = 11 DoEvents If bUpdated Then Call PutOLEObject \' 保 存 当 前OLE 控 件 中 内 容 DoEvents bUpdated = False End If \'执行tbOLEObjects.AddNew修改tbOLEObjects记录数、指针等 \'本例子中未给出这部分代码中在增加按钮Click事件中执行 Screen.MousePoer = 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.Record.FindFirst \"File_ID = \'\" + stLName + \"\'\" \'Data 控 件 也 要 到 该 记 录 eError = FieldToOLE(OLE1, tbOLEObjects(\"File_Cont\")) \' 取 出OLE 字 段 内 容 Outline1.SetFocus \' 将 焦 点 放 在Outline 控 件 上 ElseIf nRecordCount = 1 Then Data1.Record.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\" 错 误 笔 者 没 有 找 到 产 生 这 个 问 题 原 因 和 解 决 方 法 如 果 有 朋 友 告 知 解 决 方 法 笔 者 十 分 感 谢 0
相关文章读者评论发表评论 |