发信人: msnet()
整理人: cobe(1999-12-17 11:46:53), 站内信件
|
自我推荐
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
您好！
欢迎光临我的网页：http://wcwyj.yeah.net
敬请指导。友情连接。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
a VB 5.0下工具条的制作
工 具 条(Tool bar) 是Windows 环 境 下 应 用 程 序 常 用 的 界 面 元 素
。 把 菜 单 中 常 用 的 命 令 做 成 按 钮 安 排 在 工 具 条 中， 配 上
适 当 的 图 标 符 号 和 文 本 提 示， 确 实 极 大 地 方 便 了 用 户。
以Microsoft Word 7.0 for Windows 95 的 工 具 条 为 例， 其 中 的 内 容
和 功 能 非 常 丰 富。Word 7.0 工 具 条 中 不 仅 包 含 与 文 件 操 作
等 有 关 的 常 规 图 标 按 钮， 还 有 设 置 字 体 字 号 等 等 的 组 合
框(Combo box)。 按 钮 之 间 可 以 分 组， 例 如 设 置 段 落 对 齐 方
式 的 一 组 按 钮， 同 组 中 的 按 钮 每 次 只 允 许 有 一 个 被 按 下
， 按 下 一 个 按 钮 时， 同 组 中 其 它 按 钮 自 动 弹 起。 另 外，Wo
rd 7.0 的 工 具 条 还 有 用 户 裁 剪(Customize) 功 能。 用 户 在 工 具
条 上 双 击 鼠 标 时， 工 具 条 弹 出 一 个 裁 剪 对 话 框， 用 户 可
以 隐 藏、 显 示 以 及 重 新 排 列 工 具 条 中 的 按 钮。 如 果 在 我
们 自 己 开 发 的 软 件 界 面 中 加 上 这 样 的 工 具 条， 我 们 的 软
件 就 可 以 与 商 业 软 件 相 媲 美 了。
---- 在 诸 多Windows 应 用 程 序 开 发 平 台 中，Microsoft Visual BASI
C 以 易 学 易 用、 功 能 强 大 的 优 点 特 出 独 立， 成 为 开 发Windo
ws 应 用 程 序 的 首 选 平 台 之 一。 在VB 4.0 及 以 前 的 版 本 中，
开 发 象Word 7.0 中 的 工 具 条 还 是 颇 费 辛 苦 的。 一 般 思 路 是
在 窗 体(Form) 中 安 放 一 个 图 片 框(PictureBox) 作 为 容 器(Contain
er)， 再 往 其 中 加 入 图 象(Image) 控 件， 用 图 象 控 件 载 入 图 标
来 模 拟 按 钮。 对 多 个 按 钮 的 控 制 要 分 别 完 成， 管 理 较 为
复 杂。 在VB 5.0 中， 系 统 提 供 了 一 个 专 门 的 工 具 条 控 件Too
lbar。 用Toolbar 来 实 现 类 似Word 7.0 中 的 工 具 条 非 常 方 便。
工 具 条 控 件Toolbar 简 介 ---- 1. 在 工 具 箱 中 加 入Toolbar
---- 工 具 条 控 件Toolbar 不 在VB 5.0 工 具 箱(Toolbox) 的 常 规 标 准
控 件 之 列， 因 此 在 首 次 安 装VB 5.0 后， 工 具 箱 中 并 没 有Too
lbar。 在 工 具 箱 中 加 入Toolbar 要 通 过Project 菜 单 中 的Componen
ts 命 令， 该 命 令 弹 出 一 个 选 择 安 装 组 件 的 窗 口。 在Compone
nts 窗 口 的Controls 组 中 找 到“Microsoft Windows Common Controls 5.
0” 项， 单 击 标 记 该 项， 然 后 单 击“ 确 定” 按 钮，Toolbar 和 另
外 一 些 控 件 就 加 入 工 具 箱 了。
---- 2. Toolbar 的 功 能
---- Toolbar 中 可 以 加 入 按 钮， 每 个 按 钮 都 可 以 载 入 自 己 的
图 象、 设 置 标 题(Caption)。 还 可 以 为 每 个 按 钮 设 置 简 短 的
提 示 字 符 串， 程 序 运 行 时， 当 鼠 标 指 针 移 到 按 钮 上 时，
在 指 针 附 近 会 自 动 浮 出 提 示 字 符 串。 在 程 序 运 行 时， 可
以 随 时 增 加 或 删 除 按 钮。Toolbar 为 其 中 的 按 钮 提 供 了 分 组
功 能， 用 户 只 需 简 单 地 设 置 一 个 按 钮 的Style 属 性 就 能 实
现 按 钮 之 间 的 分 组。Toolbar 同 时 还 是 一 个 容 器 类 控 件， 可
以 在 其 中 加 入 组 合 框 等 其 它 控 件。Toolbar 的AllowCustomize 属
性 允 许 用 户 在 程 序 运 行 时 双 击 工 具 条 对 其 中 的 内 容 进
行 裁 剪。 根 据 这 些 功 能， 用 户 就 可 以 轻 而 易 举 地 在 自 己
开 发 的 应 用 程 序 中 加 入 类 似Word 7.0 风 格 的 工 具 条 了。
Toolbar 的 制 作
---- Toolbar 的 制 作 包 括 以 下 步 骤： 在 窗 体 中 加 入Toolbar 控
件； 在Toolbar 中 加 入 按 钮； 为 按 钮 载 入 图 象 并 设 置 其 它 属
性。
---- 1. 在 窗 体 中 加 入Toolbar 控 件
---- 双 击 工 具 箱 中 的Toolbar，Toolbar 就 自 动 加 入 窗 体 并 放 置
在 窗 体 客 户 区 的 顶 端。 如 果 要 把Toolbar 放 置 在 其 它 位 置，
可 以 在 属 性 窗 口 中 改 变Toolbar 的Align 属 性。Toolbar 的Align 属
性 中 可 供 选 择 的 有5 个 值：
---- 0 - vbAlignNone， 不 对 齐
---- 1 - vbAlignTop， 对 齐 窗 口 客 户 区 顶 端
---- 2 - vbAlignBottom， 对 齐 窗 口 客 户 区 底 端
---- 3 - vbAlignLeft， 对 齐 窗 口 客 户 区 左 边
---- 4 - vbAlignRight， 对 齐 窗 口 客 户 区 右 边
---- 2. 在Toolbar 中 加 入 按 钮
---- 用 鼠 标 右 键 单 击Toolbar， 会 弹 出Toolbar 的 属 性 菜 单。 单
击 菜 单 的 最 后 一 项“Properties”， 会 弹 出Toolbar 的 属 性 页(P
roperty Pages) 窗 口。 在 属 性 页 窗 口 中 可 以 设 置 控 件 的 一 些
非 常 规 属 性。
---- 在Toolbar 属 性 页 中 选Buttons 组， 其 中 的“Insert Button” 和
“Remove Button” 两 个 按 钮 分 别 用 于 在Toolbar 中 加 入 和 删 除
按 钮。Toolbar 控 件 的 所 有 按 钮 构 成 一 个 按 钮 集 合(Collection
)， 名 为Buttons。 在Toolbar 中 加 入 和 删 除 按 钮 实 际 上 是 对Too
lbar 的Buttons 集 合 进 行 加 入 和 删 除 元 素 操 作。 对 于Toolbar 中
各 个 按 钮 的 访 问， 也 是 通 过Buttons 集 合 进 行 的。 用“Insert
Button” 加 入 按 钮 后， 可 以 在Toolbar 属 性 页Buttons 中 设 置 新
加 入 的 按 钮 的 属 性。 这 些 属 性 包 括： 索 引(Index)、 标 题(Ca
ption)、 描 述 信 息(Description)、 关 键 字(Key)、 初 态(Value)、 模
式(Style)、 宽 度(Width)、 提 示 信 息(ToolTipText) 等。
---- (1) Index 和Key
---- Toolbar 中 的 按 钮 是 通 过 集 合Buttons 来 访 问 的。 集 合 中
每 个 按 钮 都 有 唯 一 与 之 对 应 的 标 识，Index 和Key 就 是 与 按
钮 一 一 对 应 的 标 识。Index 是 整 数 类 型 的， 类 似 于 数 组 的 下
标。Key 是 字 符 串 类 型 的 类 似 于 对 象 的 名 字， 但 它 与 名 字
不 同 的 是 引 用 时 必 须 加 双 引 号， 并 且 它 中 间 可 以 包 含 任
意 的 字 符。 按 钮 的Key 属 性 是 可 选 的， 可 以 为 空。 访 问 按
钮 时 可 以 引 用Index 和Key 二 者 之 一。 例 如， 在 名 为Toolbar1 的
Toolbar 中 加 入 按 钮， 其Index 为1，Key 设 置 为“1st button”。 在
程 序 中 可 以 通 过 以 下 两 种 方 式 之 一 访 问 该 按 钮：
Toolbar1.Buttons(1)
或
Toolbar1.Buttons("1st button")
---- (2) Caption
---- Caption 属 性 对 应 按 钮 上 显 示 的 文 本， 与 普 通 按 钮 的Ca
ption 属 性 相 同。
---- (3) ToolTipText 和Description
---- ToolTipText 和Description 都 是 字 符 串 类 型， 用 于 设 置 按 钮
的 提 示 文 本 和 描 述 信 息。 设 置 了ToolTipText 后， 程 序 启 动
运 行 后， 当 用 户 把 鼠 标 指 针 移 到 按 钮 上 时，ToolTipText 对 应
的 文 本 字 符 串 自 动 浮 出。 该 属 性 用 于 在 程 序 运 行 时 提 示
用 户 按 钮 的 功 能。 程 序 启 动 运 行 后， 用 户 双 击 工 具 条 对
其 中 的 内 容 进 行 裁 剪 时， 对 话 窗 中 每 个 按 钮 旁 边 显 示 的
是 按 钮 的Description 属 性。
---- (4) Style
---- Style 属 性 设 置 按 钮 的 模 式， 不 同 模 式 的 按 钮 具 有 不
同 的 风 格 和 作 用。 可 供 选 择 的Style 属 性 有 以 下5 种：
---- 0 - tbrDefault， 一 般 按 钮
---- 1 - tbrCheck， 开 关 按 钮
---- 2 - tbrButtonGroup， 编 组 按 钮
---- 3 - tbrSeparator， 分 隔 按 钮
---- 4 - tbrPlaceholder， 占 位 按 钮
---- 一 般 按 钮 与 普 通 的 按 钮 控 件 在 操 作 风 格 上 基 本 相 同
。 开 关 按 钮 具 有 二 值 状 态： 按 下 和 放 开。 编 组 按 钮 用 于
实 现 按 钮 之 间 的 分 组， 相 邻 的 编 组 按 钮 都 属 于 同 一 组。
编 组 按 钮 同 时 也 是 开 关 按 钮， 同 组 内 至 多 只 允 许 一 个 按
钮 处 于 按 下 状 态。 分 隔 按 钮 在Toolbar 中 并 不 显 示， 而 是 把
它 左 右 的 按 钮 分 隔 开 来。Toolbar 中 的 按 钮 本 来 是 紧 挨 着
排 列 的， 使 用 分 隔 按 钮 可 以 让 同 类 或 同 组 的 按 钮 并 列 排
放 而 与 邻 近 的 组 分 开。 占 位 按 钮 在Toolbar 中 也 不 显 示， 它
仅 仅 起 到 占 位 的 作 用。 在 占 位 按 钮 处 可 以 安 放 其 它 控 件
诸 如 组 合 框 之 类。 占 位 按 钮 是 唯 一 可 以 设 置 宽 度(Width)
属 性 的 按 钮。
---- (5) Value
---- Value 属 性 设 置 按 钮 的 按 下 和 放 开 状 态。 该 属 性 一 般
用 于 设 置 开 关 按 钮 和 编 组 按 钮 的 初 态。
---- (6) Width
---- 在 属 性 页 的Buttons 组 中 可 以 看 到，Width 属 性 后 有 一 个P
laceholder 的 附 加 说 明。 只 有 当 按 钮 的Style 设 置 为Placeholder
时， 该 属 性 才 能 被 设 置， 其 它 情 况 下 该 属 性 被 禁 止。
---- 3. 为 按 钮 载 入 图 象
---- 工 具 条 按 钮 的 一 个 突 出 特 点 是 包 含 形 象 的 图 象， 用
以 提 示 按 钮 的 功 能。 在Toolbar 中 加 入 所 需 的 按 钮 后， 就 可
以 为 每 个 按 钮 载 入 图 象 了。Toolbar 按 钮 与 普 通 的Image 和Pi
ctureBox 不 同， 它 们 没 有Picture 属 性。 要 给Toolbar 按 钮 载 入 图
象 需 要 借 助 于 另 一 个 控 件ImageList。
---- ImageList 是 在“Microsoft Windows Common Controls 5.0” 中 与Too
lbar 一 并 提 供 的 控 件。 该 控 件 不 单 独 使 用， 而 是 专 门 为 其
它 控 件 提 供 图 象 库。Toolbar 中 按 钮 的 图 象 就 要 从ImageList
的 图 象 库 中 提 取。
---- 为Toolbar 按 钮 载 入 图 象 的 方 法 是： 首 先 在Toolbar 所 在 的
窗 体 中 加 入ImageList 控 件， 其 次 在ImageList 中 加 入 图 象， 然
后 建 立Toolbar 和ImageList 的 关 联 关 系， 最 后 从ImageList 的 图
象 库 中 选 择 图 象 载 入Toolbar 的 按 钮。
---- (1) 在ImageList 中 加 入 图 象
---- 与Toolbar 控 件 类 似， 鼠 标 右 键 单 击 窗 体 中 的ImageList 控
件 时， 会 弹 出 其 属 性 菜 单。 选 菜 单 的 最 后 一 项“Properties
” 会 弹 出ImageList 的 属 性 页 窗 口。 在 属 性 页 窗 口 中 选Images
组， 在 这 里 可 以 为ImageList 的 图 象 库 中 加 入 图 象， 并 为 每
个 图 象 设 置 关 键 字 属 性。
---- 单 击“Insert Picture” 按 钮 可 以 在 图 象 库 中 插 入 图 片。
系 统 弹 出 一 个 选 择 图 片(Select picture) 的 窗 口， 从 该 窗 口 中
可 以 选 定 一 个 或 多 个 图 象 文 件。 单 击“ 打 开” 按 钮， 选 定
的 图 片 就 插 入 图 象 库 了。ImageList 允 许 插 入 位 图 文 件(.bmp
) 和 图 标(.ico) 文 件。
---- (2) 建 立Toolbar 和ImageList 的 关 联 关 系
---- 打 开Toolbar 的 属 性 页 窗 口， 在General 组 中 有 一 个 标 题 为
ImageList 的 下 拉 式 列 表 框。 单 击 打 开 该 列 表 框， 其 中 列 出
了 本 窗 体 中 所 有 的ImageList 控 件。 单 击 选 定 一 个ImageList 控
件，Toolbar 就 与 该ImageList 建 立 了 关 联 关 系。
---- (3) 为Toolbar 按 钮 载 入 图 象
---- 建 立 好Toolbar 和ImageList 的 关 联 关 系 后，Toolbar 属 性 页 窗
口 的Buttons 组 中Image 项 就 从 禁 止 状 态 变 为 有 效 了。 在Image
项 的 文 本 框 中 输 入ImageList 图 象 库 里 某 个 图 片 的Index 值，
该 图 片 就 被 载 入 该 按 钮 了。
Toolbar 的 常 用 属 性 和 方 法
---- 设 置 好Toolbar 之 后， 有 必 要 对 其 常 用 的 属 性 和 方 法 作
一 了 解， 以 便 在 程 序 中 对 它 进 行 控 制。Toolbar 与 其 它 控 件
类 似 的 常 用 属 性 在 此 不 作 赘 述。
---- 1. 常 用 属 性
---- (1) ImageList
---- 该 属 性 设 置 与Toolbar 相 关 联 的ImageList 对 象。
---- (2) AllowCustomize
---- 该 属 性 设 置 是 否 允 许 用 户 在 程 序 运 行 时 对Toolbar 的 内
容 进 行 裁 剪。 该 属 性 的 缺 省 值 是True。
---- (3) ShowTips
---- 该 属 性 决 定 程 序 运 行 过 程 中， 当 鼠 标 指 针 移 到Toolbar
按 钮 上 时， 是 否 浮 出 该 按 钮 的ToolTipText 文 本 提 示。 该 属
性 的 缺 省 值 是True。
---- (4) ToolTipText
---- 该 属 性 设 置Toolbar 自 己 的 文 本 提 示 字 符 串。Toolbar 的 每
个 按 钮 可 以 有 自 己 的ToolTipText， 同 时Toolbar 本 身 也 可 以 有
自 己 的ToolTipText。 程 序 运 行 过 程 中， 当 鼠 标 指 针 移 到Tool
bar 按 钮 上 时， 如 果Toolbar 和 按 钮 都 设 置 了ToolTipText， 则 两
个 提 示 字 符 串 都 会 浮 出。
---- 2. 常 用 方 法
---- 对Toolbar 的 控 制 主 要 是 针 对 其 中 的 按 钮，Toolbar 中 的 按
钮 是 作 为 一 个 名 为Buttons 的 集 合 对 象 供 程 序 访 问 的。Butt
ons 的 常 用 方 法 包 括 增 加 一 个 按 钮(Add)、 删 除 一 个 按 钮(Re
move) 和 删 除 所 有 按 钮(Clear)。
---- (1) Add
---- Add 方 法 的 语 法 为：
---- Toolbar 控 件 名.Buttons.Add(index, key, caption, style, image)
---- 整 型 参 数index 指 定 新 增 按 钮 的 索 引 值， 该 索 引 值 也 决
定 了 按 钮 在Toolbar 中 的 位 置。index 参 数 可 以 省 略( 注 意， 省
略index 参 数 时 其 后 的 逗 号 要 照 写)， 缺 省 情 况 下 新 增 按 钮
加 到Buttons 集 合 的 最 后。
---- 字 符 串 型 参 数key 指 定 新 增 按 钮 的 关 键 字， 该 参 数 可
以 省 略。
---- 字 符 串 型 参 数caption 指 定 新 增 按 钮 的 标 题， 该 参 数 可
以 省 略。
---- 整 型 参 数style 指 定 新 增 按 钮 的Style 属 性， 其 合 法 取 值
有5 个， 参 见 前 面Style 属 性 的 介 绍。 该 参 数 可 以 省 略， 缺
省 时 自 动 取0(tbrDefault)。
---- 参 数image 指 定 给 新 增 按 钮 载 入 的 图 象， 图 象 必 须 是 与
该Toolbar 相 关 联 的ImageList 控 件 图 象 库 中 的 一 个。image 参 数
可 以 是 一 个 整 数， 对 应ImageList 图 象 库 中 某 个 图 片 的Index
值， 也 可 以 是 一 个 字 符 串， 对 应 图 片 的 关 键 字Key。
---- (2) Remove
---- Remove 方 法 的 语 法 为：
---- Toolbar 控 件 名.Buttons.Remove 按 钮 的Index 值
---- 或
---- Toolbar 控 件 名.Buttons.Remove 按 钮 的Key 字 符 串
---- (3) Clear
---- Clear 方 法 的 语 法 为：
---- Toolbar 控 件 名.Buttons.Clear
在 程 序 中 生 成Toolbar
---- 以 上 从 设 计 阶 段(design time) 和 程 序 角 度 介 绍 了Toolbar
的 生 成 和 使 用。 下 面 我 们 结 合 实 例 来 看 看 如 何 为 自 己 的
应 用 程 序 添 加 功 能 强 大、 方 便 用 户 的 工 具 条。
---- 下 面 的 例 子 中， 窗 口 工 具 条 内 有 两 个 分 别 代 表 打 开
文 件 和 文 件 存 盘 的 按 钮， 另 外 还 有 一 个 设 置 窗 口 客 户 区
颜 色 的 组 合 框。 为 免 去 烦 琐 地 介 绍 工 具 条 的 设 置 过 程，
在 窗 体 制 作 时 仅 仅 加 入 一 个Toolbar 控 件 和 一 个ImageList 控
件， 另 外 在Toolbar 中 加 入 一 个 组 合 框ComboBox。 其 它 所 有 与
Toolbar 的 设 置 和 控 制 有 关 的 操 作 都 在 程 序 代 码 中 实 现，
包 括 为ImageList1 加 入 图 片 库、 建 立Toolbar1 和ImageList1 的 关 联
关 系、 在Toolbar1 中 加 入 按 钮 并 为 每 个 按 钮 设 置 属 性、 对C
ombo1 进 行 初 始 化 等 等。 下 面 给 出 窗 体Form1 的 程 序 代 码。
Private Sub Form_Load()
' Create object variable for the ImageList.
Dim imgX As ListImage
' Load pictures into the ImageList control.
Set imgX = ImageList1.ListImages. _
Add(, "open", LoadPicture("Graphics\bitmaps\tlbr_w95\open.bmp"))
Set imgX = ImageList1.ListImages. _
Add(, "save", LoadPicture("Graphics\bitmaps\tlbr_w95\save.bmp"))
Toolbar1.ImageList = ImageList1
' Create object variable for the Toolbar.
Dim btnX As Button
' Add button objects to Buttons collection using the
' Add method. After creating each button, set both
' Description and ToolTipText properties.
Toolbar1.Buttons.Add , , , tbrSeparator
Set btnX = Toolbar1.Buttons.Add(, "open", , tbrDefault, "open")
btnX.ToolTipText = "Open File"
btnX.Description = btnX.ToolTipText
Set btnX = Toolbar1.Buttons.Add(, "save", , tbrDefault, "save")
btnX.ToolTipText = "Save File"
btnX.Description = btnX.ToolTipText
Set btnX = Toolbar1.Buttons.Add(, , , tbrSeparator)
' The next button has the Placeholder style. A
' ComboBox control will be placed on top of this button.
Set btnX = Toolbar1.Buttons.Add(, "combo1", , tbrPlaceholder)
btnX.Width = 1500 ' Placeholder width to accommodate a combobox.
Show ' Show form to continue configuring ComboBox.
' Configure ComboBox control to be at same location as the
' Button object with the PlaceHolder style (key = "combo1").
With Combo1
.Width = Toolbar1.Buttons("combo1").Width
.Top = Toolbar1.Buttons("combo1").Top
.Left = Toolbar1.Buttons("combo1").Left
.AddItem "Black" ' Add colors for text.
.AddItem "Blue"
.AddItem "Red"
.ListIndex = 0
End With
End Sub
Private Sub Form_Resize()
' Configure ComboBox control.
With Combo1
.Width = Toolbar1.Buttons("combo1").Width
.Top = Toolbar1.Buttons("combo1").Top
.Left = Toolbar1.Buttons("combo1").Left
End With
End Sub
Private Sub toolbar1_ButtonClick(ByVal Button As Button)
' Use the Key property with the SelectCase statement to specify
' an action.
Select Case Button.Key
Case Is = "open" ' Open file.
MsgBox "Add code to open file here!"
Case Is = "save" ' Save file.
MsgBox "Add code to save file here!"
End Select
End Sub
Private Sub Combo1_Click()
' Change backcolor of form using the ComboBox.
Select Case Combo1.ListIndex
Case 0
Form1.BackColor = vbBlack
Case 1
Form1.BackColor = vbBlue
Case 2
Form1.BackColor = vbRed
End Select
End Sub
b VB 中 超 长OLE 数 据 库 字 段 的 操 纵 方 法
现 在， 多 数 数 据 库 都 支 持OLE 类 型 的 数 据 库 字 段， 利 用 这
种 字 段， 可 以 存 放Word 文 档 和Excel 表 格 等 任 何 种 类 的 文 件
， 而 且， 使 用OLE Automation 方 法， 可 直 接 激 活 文 件 的 原 始 编
辑 器， 也 就 是 它 们 的OLE Server。 这 样， 我 们 就 有 了 一 个 安
全 可 靠 的 保 存 各 类 重 要 文 件 的 方 法。 但 是， 因 为 这 些 文
件 常 常 是 很 大， 几 十K ， 甚 至 上 百K， 就 要 求 我 们 有 一 种
切 实 可 行 的 操 纵 方 法， 实 现 对 这 种 字 段 的 存 取。
VB 为 程 序 员 提 供 了 数 据 库 控 件Data， 使 用 它， 可 以 方 便 地
操 纵 数 据 库， 如 浏 览 数 据 库， 增 加 新 记 录， 编 辑 且 更 新
现 存 的 记 录， 删 除 记 录 等。 但 这 些 功 能 是 对 普 通 的 数 据
库 而 言 的， 当 数 据 库 中 有 超 长 的OLE 字 段 时， 仅 仅 使 用Data
则 不 能 完 成 上 述 操 作 了。 此 时， 需 要 解 决 二 个 问 题： 第
一， 如 何 存 取OLE 字 段 中 的 内 容； 第 二， 如 何 同 步 存 取Data
控 件 所 显 示 记 录 中OLE 字 段 与 其 它 字 段 的 内 容。
针 对 上 述 二 个 问 题， 介 绍 一 种 解 决 方 法。
第 一、 如 何 存 取OLE 字 段 中 的 内 容。
VB 提 供 了 文 件 存 取 的 方 法， 利 用 这 种 方 法 我 们 可 以 方 便
地 存 取OLE 数 据 库 字 段。 下 面 给 出 的 函 数 就 利 用 文 件 存 取
的 方 法， 实 现 了 对OLE 数 据 库 字 段 的 存 取 操 作。 这 里， 使
用Get、Put、Seek 等 语 句， 以 二 进 制 形 式 打 开 一 个 临 时 文 件，
把 它 作 为OLE 字 段 与OLE 控 件 的 中 间 缓 冲 器， 当 从OLE 字 段 向
OLE 控 件 中 读 数 据 时， 先 将OLE 字 段 的 数 据 写 入 临 时 文 件，
再 将 临 时 文 件 用OLE 控 件 的OLE_LOAD_FROM_FILE 动 作 插 入OLE 控
件； 当 把OLE 控 件 的 数 据 写 入OLE 字 段 时， 则 先 用OLE 控 件 的O
LE_SAVE_TO_FILE 动 作， 将 其 存 入 临 时 文 件， 再 将 临 时 文 件 写
入OLE 字 段。 这 里， 以 固 定 块 长 的 方 式 读 写OLE 字 段 和 临 时
文 件。 这 些 函 数 都 没 有 错 误 检 测 部 分。
下 面 所 有 例 子 使 用 的 都 是Access2.0 数 据 库。
变 量 声 明：
Option Explicit
Const OLE_SAVE_TO_FILE = 11 'OLE Action 常 量
Const OLE_LOAD_FROM_FILE = 12 'OLE Action 常 量
Const CHUNK_SIZE = 32000 ' 文 件 读 写 块 的 大 小
下 面 的 函 数 将Access 1.x 数 据 库 中OLE 字 段 的 内 容 取 出 并 插
入OLE2 控 件 中。
Function AccessFieldToOLE
(oleObject As Control, fdObject As Field)
Dim eError As Integer
Dim iFileNumber As Integer
Dim wOffsetToObject As Integer
iFileNumber = FreeFile
' 获 取 文 件 号
Open App.Path & "\OLE.TMP" For Binary As iFileNumber
' 创 建 临 时 文 件
eError = FieldToFileStream(iFileNumber, fdObject)
' 将 字 段 的 内 容 写 到 文 件 中
Get iFileNumber, 3, wOffsetToObject
' 获 得Object 的 偏 移 地 址
Seek iFileNumber, wOffsetToObject + 1
' 到 object 的 起 始 位 置
oleObject.FileNumber = iFileNumber
' 将 OLE control 指 向 临 时 文 件
oleObject.Action = OLE_LOAD_FROM_FILE
' 从 文 件 中 取 出 OLE object
Close iFileNumber
' 关 闭 临 时 文 件
Kill App.Path & "\OLE.TMP"
' 删 除 临 时 文 件
AccessFieldToOLE = 0
' 返 回
End Function
下 面 的 函 数 将OLE 字 段 中 的 内 容 写 到 临 时 文 件 中。
Function FieldToFileStream
(iFileNumber As Integer, fdObject As Field) As Integer
Dim sChunkHolder As String
Dim lChunkCount As Long
Dim lChunkRemainder As Long
Dim i As Long
lChunkCount = fdObject.FieldSize() \ CHUNK_SIZE
' 获 得 文 件 的 块 数
lChunkRemainder = fdObject.FieldSize() Mod CHUNK_SIZE
' 整 块 后 余 下 的 数 据
For i = 0 To lChunkCount - 1
sChunkHolder = fdObject.GetChunk
(i * CHUNK_SIZE, CHUNK_SIZE)
' 取 一 块
Put iFileNumber, , sChunkHolder
' 将 块 写 入 临 时 文 件
Next
If lChunkRemainder > 0 Then
sChunkHolder = fdObject.GetChunk
(lChunkCount * CHUNK_SIZE, lChunkRemainder)
' 取 余 下 的 数 据
Put iFileNumber, , sChunkHolder
' 将 其 写 入 临 时 文 件
End If
FieldToFileStream = 0
' 返 回
End Function
下 面 的 函 数 将OLE2 数 据 库 字 段 的 内 容 取 出 并 插 入OLE2 控 件
中。
Function FieldToOLE
(oleObject As Control, fdObject As Field)
Dim eError As Integer
Dim iFileNumber As Integer
iFileNumber = FreeFile
' 获 取 文 件 号
Open App.Path & "\OLE.TMP" For Binary As iFileNumber
' 创 建 临 时 文 件
eError = FieldToFileStream(iFileNumber, fdObject)
' 将 字 段 的 内 容 写 到 临 时 文 件 中
Seek iFileNumber, 1
' 到 object 的 起 始 位 置
oleObject.FileNumber = iFileNumber
'OLE 控 件 指 向 临 时 文 件
oleObject.Action = OLE_LOAD_FROM_FILE
' 从 文 件 中 取 出 OLE object
Close iFileNumber
' 关 闭 临 时 文 件
Kill App.Path & "\OLE.TMP"
' 删 除 临 时 文 件
FieldToOLE = 0
' 返 回
End Function
下 面 的 函 数 将 临 时 文 件 写 入 数 据 库 的OLE2 字 段 中。
Function FileStreamToField
(iFileNumber As Integer, fdObject As Field) As Integer
Dim sChunkHolder As String
Dim lChunkCount As Long
Dim lChunkRemainder As Long
Dim i As Long
sChunkHolder = Space$(CHUNK_SIZE)
' 临 时 存 贮 块
lChunkCount = (LOF(iFileNumber) - Seek(iFileNumber) + 1)
\ CHUNK_SIZE ' 取 块 数
lChunkRemainder = (LOF(iFileNumber) - Seek
(iFileNumber) + 1) Mod CHUNK_SIZE
' 取 整 块 后 余 下 的 数 据
For i = 1 To lChunkCount
Get iFileNumber, , sChunkHolder
' 从 文 件 中 取 出 一 块
fdObject.AppendChunk (sChunkHolder)
' 将 块 写 入 字 段 中
Next
If lChunkRemainder > 0 Then
sChunkHolder = Space$(lChunkRemainder)
' 临 时 存 贮 块
Get iFileNumber, , sChunkHolder
' 取 出 该 块
fdObject.AppendChunk (sChunkHolder)
' 写 入 字 段 中
End If
FileStreamToField = 0
' 返 回
End Function
下 面 的 函 数 将OLE2 Object 从OLE2 控 件 中 取 出， 并 存 入 数 据 库
字 段 中。
Function OLEToField (oleObject As Control,
fdObject As Field) As Integer
Dim eError As Integer
Dim iFileNumber As Integer
iFileNumber = FreeFile
' 获 取 文 件 号
Open App.Path & "\OLE.TMP" For Binary As iFileNumber
' 创 建 临 时 文 件
oleObject.FileNumber = iFileNumber
'OLE 控 件 指 向 临 时 文 件
oleObject.Action = OLE_SAVE_TO_FILE
' 将 字 段 的 内 容 写 到 临 时 文 件 中
Seek iFileNumber, 1
' 到 object 的 起 始 位 置
fdObject = "" 清 空OLE2 字 段
eError = FileStreamToField(iFileNumber, fdObject)
' 将 文 件 写 入OLE2 字 段 中
Close iFileNumber
' 关 闭 临 时 文 件
Kill App.Path & "\OLE.TMP"
' 删 除 临 时 文 件
OLEToField = 0 ' 返 回
End Function
上 述 函 数 的 调 用 方 法 十 分 简 单， 下 面 的 两 个 子 程 序 给 出
了 调 用 例 子。
将OLE2 字 段 中 的 内 容 取 出 并 插 入OLE 控 件 中
Sub GetOLEObject()
Dim eError As Integer
' 将OLE 字 段File_Cont 中 的 内 容 取 出 并 插 入OLE 控 件OLE1 中
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
End Sub
将OLE2 控 件 中 的 内 容 写 入OLE2 字 段
Sub PutOLEObject()
Dim eError As Integer
tbOLEObjects.Edit ' 修 改OLEObjects 的 工 作 方 式
eError = OLEToField(OLE1, tbOLEObjects("File_Cont"))
' 保 存OLE 控 件OLE1 中 的 内 容
tbOLEObjects.Update ' 更 新tbOLEObjects
DoEvents
End Sub
因 为Access1.x 的OLE 字 段 格 式 与OLE2 字 段 的 格 式 不 同， 所 以，
若 是OLE2 字 段， 在 读 取 字 段 内 容 时， 应 使 用FieldToOLE 函 数；
若 是Access1.x 的 OLE 字 段， 应 使 用AccessFieldToOLE 函 数。 这 两
种 格 式OLE 字 段 的 存 贮 过 程 是 相 同 的。 当 使 用Access2.0 建 立
数 据 库 并 存 贮OLE 字 段 时， 它 是OLE2 格 式 的， 应 使 用FieldToO
LE 函 数。 用VB3 编 程 时， 系 统 中 应 安 装VB/Access2.0 兼 容 层， 否
则 无 法 操 纵Access2.0 数 据 库。
第 二、 如 何 使Data 控 件 显 示 的 记 录 与OLE 字 段 的 内 容 同 步。
这 个 问 题 是 因 为Data 控 件 不 支 持 超 长 的OLE 字 段 引 起 的。 对
于 普 通 的 数 据 库 字 段， 把 显 示 该 字 段 内 容 控 件 的DataSour
ce 和DataField 属 性 分 别 置 为Data 控 件 和 数 据 库 的 字 段 名， 就
可 以 由Data 控 件 正 确 地 显 示 数 据 库 记 录 的 字 段 内 容。 而
用 于 显 示OLE2 字 段 内 容 的OLE 控 件 的 数 据 是 无 法 用Data 控 件
来 存 取 的， 必 须 用 上 面 提 供 的 函 数 来 存 取。 这 时， 关 键
问 题 是 使OLE 控 件 显 示 的 内 容 是Data 控 件 所 在 记 录 中OLE 字
段 的 内 容， 也 就 是OLE 控 件 要 与Data 控 件 同 步。
实 现 方 法：
声 明 一Dynaset 类 型 的Object：tbOLEObjects。
在Form_Load 事 件 的 执 行 程 序 中， 将Data1.RecordSet 赋 给tbOLEObje
cts ， 并 记 录tbOLEObjects 中 的 记 录 数。
在Data1_Validate 事 件 的 执 行 程 序 中， 使tbOLEObjects 执 行 的 动
作 与Data1 一 致， 即： 在Data1 的Data1_Validate 事 件 执 行 程 序 中，
当Data1 执 行Data1.RecordSet.MoveNext 或Data1.RecordSet.MoveFirst 时，
tbOLEObjects 也 要 执 行tbOLEObjects.MoveNext 或tbOLEObjects.MoveFirst
。 实 现 时， 先 保 存 当 前OLE 控 件 中 的 内 容， 然 后 执 行tbOLEOb
jects.MoveNext 或tbOLEObjects.MoveFirst 方 法， 再 取 出OLE 字 段 中 的
内 容， 插 入 到OLE 控 件 中。
当 系 统 执 行 了 一 个SQL 语 句 后，Data1 显 示 的 记 录 直 接 跳 到
某 一 记 录， 对tbOLEObjects 来 说， 则 要 执 行 一 查 找 过 程， 使 得
tbOLEObjects 的 当 前 记 录 与Data1 的 当 前 记 录 一 致。 实 现 时，
先 保 存 当 前OLE 控 件 中 的 内 容， 再 在tbOLEObjects 中 查 找Data1
的 当 前 记 录， 找 到 后， 将 其OLE 字 段 中 的 内 容 取 出 并 插 入
到OLE 控 件 中。
下 面 给 出 的 实 现 例 子 是 从 本 人 编 写 的 一 个 软 件 中 摘 录 出
来 的， 它 说 明 了 具 体 的 实 现 方 法， 但 不 可 以 直 接 使 用，
要 结 合 自 己 的 程 序， 加 上 其 它 必 要 的 部 分。 例 子 中 的 数
据 库 是 一 个 公 文 数 据 库， 保 存 用 户 的 重 要 公 文， 其 中 的O
LE 字 段 保 存 的 就 是Word 文 档， 名 字 为File_Cont， 其 它 字 段 是
文 档 的 相 关 信 息， 如 文 档 的 标 题(File_Title)、 等 级(File_Cla
ss)、 关 键 字(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 事 件 中 执 行， 完 成 对tbOLEO
bjects 赋 值 并 计 算 出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" 错 误， 笔 者 没 有 找 到 产 生 这 个 问 题 的 原
因 和 解 决 方 法， 如 果 有 朋 友 告 知 解 决 方 法， 笔 者 十 分 感
谢。
=========================================================
欢迎投稿：[email protected]
=========================================================
请订阅：
http://server.com/WebApps/mail-list-subscribe.cgi?id=16852
---- 在 诸 多Windows 应 用 程 序 开 发 平 台 中，Microsoft Visual BASI
C 以 易 学 易 用、 功 能 强 大 的 优 点 特 出 独 立， 成 为 开 发Windo
ws 应 用 程 序 的 首 选 平 台 之 一。 在VB 4.0 及 以 前 的 版 本 中，
开 发 象Word 7.0 中 的 工 具 条 还 是 颇 费 辛 苦 的。 一 般 思 路 是
在 窗 体(Form) 中 安 放 一 个 图 片 框(PictureBox) 作 为 容 器(Contain
er)， 再 往 其 中 加 入 图 象(Image) 控 件， 用 图 象 控 件 载 入 图 标
来 模 拟 按 钮。 对 多 个 按 钮 的 控 制 要 分 别 完 成， 管 理 较 为
复 杂。 在VB 5.0 中， 系 统 提 供 了 一 个 专 门 的 工 具 条 控 件Too
lbar。 用Toolbar 来 实 现 类 似Word 7.0 中 的 工 具 条 非 常 方 便。
工 具 条 控 件Toolbar 简 介 ---- 1. 在 工 具 箱 中 加 入Toolbar
---- 工 具 条 控 件Toolbar 不 在VB 5.0 工 具 箱(Toolbox) 的 常 规 标 准
控 件 之 列， 因 此 在 首 次 安 装VB 5.0 后， 工 具 箱 中 并 没 有Too
lbar。 在 工 具 箱 中 加 入Toolbar 要 通 过Project 菜 单 中 的Componen
ts 命 令， 该 命 令 弹 出 一 个 选 择 安 装 组 件 的 窗 口。 在Compone
nts 窗 口 的Controls 组 中 找 到“Microsoft Windows Common Controls 5.
0” 项， 单 击 标 记 该 项， 然 后 单 击“ 确 定” 按 钮，Toolbar 和 另
外 一 些 控 件 就 加 入 工 具 箱 了。
---- 2. Toolbar 的 功 能
---- Toolbar 中 可 以 加 入 按 钮， 每 个 按 钮 都 可 以 载 入 自 己 的
图 象、 设 置 标 题(Caption)。 还 可 以 为 每 个 按 钮 设 置 简 短 的
提 示 字 符 串， 程 序 运 行 时， 当 鼠 标 指 针 移 到 按 钮 上 时，
在 指 针 附 近 会 自 动 浮 出 提 示 字 符 串。 在 程 序 运 行 时， 可
以 随 时 增 加 或 删 除 按 钮。Toolbar 为 其 中 的 按 钮 提 供 了 分 组
功 能， 用 户 只 需 简 单 地 设 置 一 个 按 钮 的Style 属 性 就 能 实
现 按 钮 之 间 的 分 组。Toolbar 同 时 还 是 一 个 容 器 类 控 件， 可
以 在 其 中 加 入 组 合 框 等 其 它 控 件。Toolbar 的AllowCustomize 属
性 允 许 用 户 在 程 序 运 行 时 双 击 工 具 条 对 其 中 的 内 容 进
行 裁 剪。 根 据 这 些 功 能， 用 户 就 可 以 轻 而 易 举 地 在 自 己
开 发 的 应 用 程 序 中 加 入 类 似Word 7.0 风 格 的 工 具 条 了。
Toolbar 的 制 作
---- Toolbar 的 制 作 包 括 以 下 步 骤： 在 窗 体 中 加 入Toolbar 控
件； 在Toolbar 中 加 入 按 钮； 为 按 钮 载 入 图 象 并 设 置 其 它 属
性。
---- 1. 在 窗 体 中 加 入Toolbar 控 件
---- 双 击 工 具 箱 中 的Toolbar，Toolbar 就 自 动 加 入 窗 体 并 放 置
在 窗 体 客 户 区 的 顶 端。 如 果 要 把Toolbar 放 置 在 其 它 位 置，
可 以 在 属 性 窗 口 中 改 变Toolbar 的Align 属 性。Toolbar 的Align 属
性 中 可 供 选 择 的 有5 个 值：
---- 0 - vbAlignNone， 不 对 齐
---- 1 - vbAlignTop， 对 齐 窗 口 客 户 区 顶 端
---- 2 - vbAlignBottom， 对 齐 窗 口 客 户 区 底 端
---- 3 - vbAlignLeft， 对 齐 窗 口 客 户 区 左 边
---- 4 - vbAlignRight， 对 齐 窗 口 客 户 区 右 边
---- 2. 在Toolbar 中 加 入 按 钮
---- 用 鼠 标 右 键 单 击Toolbar， 会 弹 出Toolbar 的 属 性 菜 单。 单
击 菜 单 的 最 后 一 项“Properties”， 会 弹 出Toolbar 的 属 性 页(P
roperty Pages) 窗 口。 在 属 性 页 窗 口 中 可 以 设 置 控 件 的 一 些
非 常 规 属 性。
---- 在Toolbar 属 性 页 中 选Buttons 组， 其 中 的“Insert Button” 和
“Remove Button” 两 个 按 钮 分 别 用 于 在Toolbar 中 加 入 和 删 除
按 钮。Toolbar 控 件 的 所 有 按 钮 构 成 一 个 按 钮 集 合(Collection
)， 名 为Buttons。 在Toolbar 中 加 入 和 删 除 按 钮 实 际 上 是 对Too
lbar 的Buttons 集 合 进 行 加 入 和 删 除 元 素 操 作。 对 于Toolbar 中
各 个 按 钮 的 访 问， 也 是 通 过Buttons 集 合 进 行 的。 用“Insert
Button” 加 入 按 钮 后， 可 以 在Toolbar 属 性 页Buttons 中 设 置 新
加 入 的 按 钮 的 属 性。 这 些 属 性 包 括： 索 引(Index)、 标 题(Ca
ption)、 描 述 信 息(Description)、 关 键 字(Key)、 初 态(Value)、 模
式(Style)、 宽 度(Width)、 提 示 信 息(ToolTipText) 等。
---- (1) Index 和Key
---- Toolbar 中 的 按 钮 是 通 过 集 合Buttons 来 访 问 的。 集 合 中
每 个 按 钮 都 有 唯 一 与 之 对 应 的 标 识，Index 和Key 就 是 与 按
钮 一 一 对 应 的 标 识。Index 是 整 数 类 型 的， 类 似 于 数 组 的 下
标。Key 是 字 符 串 类 型 的 类 似 于 对 象 的 名 字， 但 它 与 名 字
不 同 的 是 引 用 时 必 须 加 双 引 号， 并 且 它 中 间 可 以 包 含 任
意 的 字 符。 按 钮 的Key 属 性 是 可 选 的， 可 以 为 空。 访 问 按
钮 时 可 以 引 用Index 和Key 二 者 之 一。 例 如， 在 名 为Toolbar1 的
Toolbar 中 加 入 按 钮， 其Index 为1，Key 设 置 为“1st button”。 在
程 序 中 可 以 通 过 以 下 两 种 方 式 之 一 访 问 该 按 钮：
Toolbar1.Buttons(1)
或
Toolbar1.Buttons("1st button")
---- (2) Caption
---- Caption 属 性 对 应 按 钮 上 显 示 的 文 本， 与 普 通 按 钮 的Ca
ption 属 性 相 同。
---- (3) ToolTipText 和Description
---- ToolTipText 和Description 都 是 字 符 串 类 型， 用 于 设 置 按 钮
的 提 示 文 本 和 描 述 信 息。 设 置 了ToolTipText 后， 程 序 启 动
运 行 后， 当 用 户 把 鼠 标 指 针 移 到 按 钮 上 时，ToolTipText 对 应
的 文 本 字 符 串 自 动 浮 出。 该 属 性 用 于 在 程 序 运 行 时 提 示
用 户 按 钮 的 功 能。 程 序 启 动 运 行 后， 用 户 双 击 工 具 条 对
其 中 的 内 容 进 行 裁 剪 时， 对 话 窗 中 每 个 按 钮 旁 边 显 示 的
是 按 钮 的Description 属 性。
---- (4) Style
---- Style 属 性 设 置 按 钮 的 模 式， 不 同 模 式 的 按 钮 具 有 不
同 的 风 格 和 作 用。 可 供 选 择 的Style 属 性 有 以 下5 种：
---- 0 - tbrDefault， 一 般 按 钮
---- 1 - tbrCheck， 开 关 按 钮
---- 2 - tbrButtonGroup， 编 组 按 钮
---- 3 - tbrSeparator， 分 隔 按 钮
---- 4 - tbrPlaceholder， 占 位 按 钮
---- 一 般 按 钮 与 普 通 的 按 钮 控 件 在 操 作 风 格 上 基 本 相 同
。 开 关 按 钮 具 有 二 值 状 态： 按 下 和 放 开。 编 组 按 钮 用 于
实 现 按 钮 之 间 的 分 组， 相 邻 的 编 组 按 钮 都 属 于 同 一 组。
编 组 按 钮 同 时 也 是 开 关 按 钮， 同 组 内 至 多 只 允 许 一 个 按
钮 处 于 按 下 状 态。 分 隔 按 钮 在Toolbar 中 并 不 显 示， 而 是 把
它 左 右 的 按 钮 分 隔 开 来。Toolbar 中 的 按 钮 本 来 是 紧 挨 着
排 列 的， 使 用 分 隔 按 钮 可 以 让 同 类 或 同 组 的 按 钮 并 列 排
放 而 与 邻 近 的 组 分 开。 占 位 按 钮 在Toolbar 中 也 不 显 示， 它
仅 仅 起 到 占 位 的 作 用。 在 占 位 按 钮 处 可 以 安 放 其 它 控 件
诸 如 组 合 框 之 类。 占 位 按 钮 是 唯 一 可 以 设 置 宽 度(Width)
属 性 的 按 钮。
---- (5) Value
---- Value 属 性 设 置 按 钮 的 按 下 和 放 开 状 态。 该 属 性 一 般
用 于 设 置 开 关 按 钮 和 编 组 按 钮 的 初 态。
---- (6) Width
---- 在 属 性 页 的Buttons 组 中 可 以 看 到，Width 属 性 后 有 一 个P
laceholder 的 附 加 说 明。 只 有 当 按 钮 的Style 设 置 为Placeholder
时， 该 属 性 才 能 被 设 置， 其 它 情 况 下 该 属 性 被 禁 止。
---- 3. 为 按 钮 载 入 图 象
---- 工 具 条 按 钮 的 一 个 突 出 特 点 是 包 含 形 象 的 图 象， 用
以 提 示 按 钮 的 功 能。 在Toolbar 中 加 入 所 需 的 按 钮 后， 就 可
以 为 每 个 按 钮 载 入 图 象 了。Toolbar 按 钮 与 普 通 的Image 和Pi
ctureBox 不 同， 它 们 没 有Picture 属 性。 要 给Toolbar 按 钮 载 入 图
象 需 要 借 助 于 另 一 个 控 件ImageList。
---- ImageList 是 在“Microsoft Windows Common Controls 5.0” 中 与Too
lbar 一 并 提 供 的 控 件。 该 控 件 不 单 独 使 用， 而 是 专 门 为 其
它 控 件 提 供 图 象 库。Toolbar 中 按 钮 的 图 象 就 要 从ImageList
的 图 象 库 中 提 取。
---- 为Toolbar 按 钮 载 入 图 象 的 方 法 是： 首 先 在Toolbar 所 在 的
窗 体 中 加 入ImageList 控 件， 其 次 在ImageList 中 加 入 图 象， 然
后 建 立Toolbar 和ImageList 的 关 联 关 系， 最 后 从ImageList 的 图
象 库 中 选 择 图 象 载 入Toolbar 的 按 钮。
---- (1) 在ImageList 中 加 入 图 象
---- 与Toolbar 控 件 类 似， 鼠 标 右 键 单 击 窗 体 中 的ImageList 控
件 时， 会 弹 出 其 属 性 菜 单。 选 菜 单 的 最 后 一 项“Properties
” 会 弹 出ImageList 的 属 性 页 窗 口。 在 属 性 页 窗 口 中 选Images
组， 在 这 里 可 以 为ImageList 的 图 象 库 中 加 入 图 象， 并 为 每
个 图 象 设 置 关 键 字 属 性。
---- 单 击“Insert Picture” 按 钮 可 以 在 图 象 库 中 插 入 图 片。
系 统 弹 出 一 个 选 择 图 片(Select picture) 的 窗 口， 从 该 窗 口 中
可 以 选 定 一 个 或 多 个 图 象 文 件。 单 击“ 打 开” 按 钮， 选 定
的 图 片 就 插 入 图 象 库 了。ImageList 允 许 插 入 位 图 文 件(.bmp
) 和 图 标(.ico) 文 件。
---- (2) 建 立Toolbar 和ImageList 的 关 联 关 系
---- 打 开Toolbar 的 属 性 页 窗 口， 在General 组 中 有 一 个 标 题 为
ImageList 的 下 拉 式 列 表 框。 单 击 打 开 该 列 表 框， 其 中 列 出
了 本 窗 体 中 所 有 的ImageList 控 件。 单 击 选 定 一 个ImageList 控
件，Toolbar 就 与 该ImageList 建 立 了 关 联 关 系。
---- (3) 为Toolbar 按 钮 载 入 图 象
---- 建 立 好Toolbar 和ImageList 的 关 联 关 系 后，Toolbar 属 性 页 窗
口 的Buttons 组 中Image 项 就 从 禁 止 状 态 变 为 有 效 了。 在Image
项 的 文 本 框 中 输 入ImageList 图 象 库 里 某 个 图 片 的Index 值，
该 图 片 就 被 载 入 该 按 钮 了。
Toolbar 的 常 用 属 性 和 方 法
---- 设 置 好Toolbar 之 后， 有 必 要 对 其 常 用 的 属 性 和 方 法 作
一 了 解， 以 便 在 程 序 中 对 它 进 行 控 制。Toolbar 与 其 它 控 件
类 似 的 常 用 属 性 在 此 不 作 赘 述。
---- 1. 常 用 属 性
---- (1) ImageList
---- 该 属 性 设 置 与Toolbar 相 关 联 的ImageList 对 象。
---- (2) AllowCustomize
---- 该 属 性 设 置 是 否 允 许 用 户 在 程 序 运 行 时 对Toolbar 的 内
容 进 行 裁 剪。 该 属 性 的 缺 省 值 是True。
---- (3) ShowTips
---- 该 属 性 决 定 程 序 运 行 过 程 中， 当 鼠 标 指 针 移 到Toolbar
按 钮 上 时， 是 否 浮 出 该 按 钮 的ToolTipText 文 本 提 示。 该 属
性 的 缺 省 值 是True。
---- (4) ToolTipText
---- 该 属 性 设 置Toolbar 自 己 的 文 本 提 示 字 符 串。Toolbar 的 每
个 按 钮 可 以 有 自 己 的ToolTipText， 同 时Toolbar 本 身 也 可 以 有
自 己 的ToolTipText。 程 序 运 行 过 程 中， 当 鼠 标 指 针 移 到Tool
bar 按 钮 上 时， 如 果Toolbar 和 按 钮 都 设 置 了ToolTipText， 则 两
个 提 示 字 符 串 都 会 浮 出。
---- 2. 常 用 方 法
---- 对Toolbar 的 控 制 主 要 是 针 对 其 中 的 按 钮，Toolbar 中 的 按
钮 是 作 为 一 个 名 为Buttons 的 集 合 对 象 供 程 序 访 问 的。Butt
ons 的 常 用 方 法 包 括 增 加 一 个 按 钮(Add)、 删 除 一 个 按 钮(Re
move) 和 删 除 所 有 按 钮(Clear)。
---- (1) Add
---- Add 方 法 的 语 法 为：
---- Toolbar 控 件 名.Buttons.Add(index, key, caption, style, image)
---- 整 型 参 数index 指 定 新 增 按 钮 的 索 引 值， 该 索 引 值 也 决
定 了 按 钮 在Toolbar 中 的 位 置。index 参 数 可 以 省 略( 注 意， 省
略index 参 数 时 其 后 的 逗 号 要 照 写)， 缺 省 情 况 下 新 增 按 钮
加 到Buttons 集 合 的 最 后。
---- 字 符 串 型 参 数key 指 定 新 增 按 钮 的 关 键 字， 该 参 数 可
以 省 略。
---- 字 符 串 型 参 数caption 指 定 新 增 按 钮 的 标 题， 该 参 数 可
以 省 略。
---- 整 型 参 数style 指 定 新 增 按 钮 的Style 属 性， 其 合 法 取 值
有5 个， 参 见 前 面Style 属 性 的 介 绍。 该 参 数 可 以 省 略， 缺
省 时 自 动 取0(tbrDefault)。
---- 参 数image 指 定 给 新 增 按 钮 载 入 的 图 象， 图 象 必 须 是 与
该Toolbar 相 关 联 的ImageList 控 件 图 象 库 中 的 一 个。image 参 数
可 以 是 一 个 整 数， 对 应ImageList 图 象 库 中 某 个 图 片 的Index
值， 也 可 以 是 一 个 字 符 串， 对 应 图 片 的 关 键 字Key。
---- (2) Remove
---- Remove 方 法 的 语 法 为：
---- Toolbar 控 件 名.Buttons.Remove 按 钮 的Index 值
---- 或
---- Toolbar 控 件 名.Buttons.Remove 按 钮 的Key 字 符 串
---- (3) Clear
---- Clear 方 法 的 语 法 为：
---- Toolbar 控 件 名.Buttons.Clear
在 程 序 中 生 成Toolbar
---- 以 上 从 设 计 阶 段(design time) 和 程 序 角 度 介 绍 了Toolbar
的 生 成 和 使 用。 下 面 我 们 结 合 实 例 来 看 看 如 何 为 自 己 的
应 用 程 序 添 加 功 能 强 大、 方 便 用 户 的 工 具 条。
---- 下 面 的 例 子 中， 窗 口 工 具 条 内 有 两 个 分 别 代 表 打 开
文 件 和 文 件 存 盘 的 按 钮， 另 外 还 有 一 个 设 置 窗 口 客 户 区
颜 色 的 组 合 框。 为 免 去 烦 琐 地 介 绍 工 具 条 的 设 置 过 程，
在 窗 体 制 作 时 仅 仅 加 入 一 个Toolbar 控 件 和 一 个ImageList 控
件， 另 外 在Toolbar 中 加 入 一 个 组 合 框ComboBox。 其 它 所 有 与
Toolbar 的 设 置 和 控 制 有 关 的 操 作 都 在 程 序 代 码 中 实 现，
包 括 为ImageList1 加 入 图 片 库、 建 立Toolbar1 和ImageList1 的 关 联
关 系、 在Toolbar1 中 加 入 按 钮 并 为 每 个 按 钮 设 置 属 性、 对C
ombo1 进 行 初 始 化 等 等。 下 面 给 出 窗 体Form1 的 程 序 代 码。
Private Sub Form_Load()
' Create object variable for the ImageList.
Dim imgX As ListImage
' Load pictures into the ImageList control.
Set imgX = ImageList1.ListImages. _
Add(, "open", LoadPicture("Graphics\bitmaps\tlbr_w95\open.bmp"))
Set imgX = ImageList1.ListImages. _
Add(, "save", LoadPicture("Graphics\bitmaps\tlbr_w95\save.bmp"))
Toolbar1.ImageList = ImageList1
' Create object variable for the Toolbar.
Dim btnX As Button
' Add button objects to Buttons collection using the
' Add method. After creating each button, set both
' Description and ToolTipText properties.
Toolbar1.Buttons.Add , , , tbrSeparator
Set btnX = Toolbar1.Buttons.Add(, "open", , tbrDefault, "open")
btnX.ToolTipText = "Open File"
btnX.Description = btnX.ToolTipText
Set btnX = Toolbar1.Buttons.Add(, "save", , tbrDefault, "save")
btnX.ToolTipText = "Save File"
btnX.Description = btnX.ToolTipText
Set btnX = Toolbar1.Buttons.Add(, , , tbrSeparator)
' The next button has the Placeholder style. A
' ComboBox control will be placed on top of this button.
Set btnX = Toolbar1.Buttons.Add(, "combo1", , tbrPlaceholder)
btnX.Width = 1500 ' Placeholder width to accommodate a combobox.
Show ' Show form to continue configuring ComboBox.
' Configure ComboBox control to be at same location as the
' Button object with the PlaceHolder style (key = "combo1").
With Combo1
.Width = Toolbar1.Buttons("combo1").Width
.Top = Toolbar1.Buttons("combo1").Top
.Left = Toolbar1.Buttons("combo1").Left
.AddItem "Black" ' Add colors for text.
.AddItem "Blue"
.AddItem "Red"
.ListIndex = 0
End With
End Sub
Private Sub Form_Resize()
' Configure ComboBox control.
With Combo1
.Width = Toolbar1.Buttons("combo1").Width
.Top = Toolbar1.Buttons("combo1").Top
.Left = Toolbar1.Buttons("combo1").Left
End With
End Sub
Private Sub toolbar1_ButtonClick(ByVal Button As Button)
' Use the Key property with the SelectCase statement to specify
' an action.
Select Case Button.Key
Case Is = "open" ' Open file.
MsgBox "Add code to open file here!"
Case Is = "save" ' Save file.
MsgBox "Add code to save file here!"
End Select
End Sub
Private Sub Combo1_Click()
' Change backcolor of form using the ComboBox.
Select Case Combo1.ListIndex
Case 0
Form1.BackColor = vbBlack
Case 1
Form1.BackColor = vbBlue
Case 2
Form1.BackColor = vbRed
End Select
End Sub
b VB 中 超 长OLE 数 据 库 字 段 的 操 纵 方 法
现 在， 多 数 数 据 库 都 支 持OLE 类 型 的 数 据 库 字 段， 利 用 这
种 字 段， 可 以 存 放Word 文 档 和Excel 表 格 等 任 何 种 类 的 文 件
， 而 且， 使 用OLE Automation 方 法， 可 直 接 激 活 文 件 的 原 始 编
辑 器， 也 就 是 它 们 的OLE Server。 这 样， 我 们 就 有 了 一 个 安
全 可 靠 的 保 存 各 类 重 要 文 件 的 方 法。 但 是， 因 为 这 些 文
件 常 常 是 很 大， 几 十K ， 甚 至 上 百K， 就 要 求 我 们 有 一 种
切 实 可 行 的 操 纵 方 法， 实 现 对 这 种 字 段 的 存 取。
VB 为 程 序 员 提 供 了 数 据 库 控 件Data， 使 用 它， 可 以 方 便 地
操 纵 数 据 库， 如 浏 览 数 据 库， 增 加 新 记 录， 编 辑 且 更 新
现 存 的 记 录， 删 除 记 录 等。 但 这 些 功 能 是 对 普 通 的 数 据
库 而 言 的， 当 数 据 库 中 有 超 长 的OLE 字 段 时， 仅 仅 使 用Data
则 不 能 完 成 上 述 操 作 了。 此 时， 需 要 解 决 二 个 问 题： 第
一， 如 何 存 取OLE 字 段 中 的 内 容； 第 二， 如 何 同 步 存 取Data
控 件 所 显 示 记 录 中OLE 字 段 与 其 它 字 段 的 内 容。
针 对 上 述 二 个 问 题， 介 绍 一 种 解 决 方 法。
第 一、 如 何 存 取OLE 字 段 中 的 内 容。
VB 提 供 了 文 件 存 取 的 方 法， 利 用 这 种 方 法 我 们 可 以 方 便
地 存 取OLE 数 据 库 字 段。 下 面 给 出 的 函 数 就 利 用 文 件 存 取
的 方 法， 实 现 了 对OLE 数 据 库 字 段 的 存 取 操 作。 这 里， 使
用Get、Put、Seek 等 语 句， 以 二 进 制 形 式 打 开 一 个 临 时 文 件，
把 它 作 为OLE 字 段 与OLE 控 件 的 中 间 缓 冲 器， 当 从OLE 字 段 向
OLE 控 件 中 读 数 据 时， 先 将OLE 字 段 的 数 据 写 入 临 时 文 件，
再 将 临 时 文 件 用OLE 控 件 的OLE_LOAD_FROM_FILE 动 作 插 入OLE 控
件； 当 把OLE 控 件 的 数 据 写 入OLE 字 段 时， 则 先 用OLE 控 件 的O
LE_SAVE_TO_FILE 动 作， 将 其 存 入 临 时 文 件， 再 将 临 时 文 件 写
入OLE 字 段。 这 里， 以 固 定 块 长 的 方 式 读 写OLE 字 段 和 临 时
文 件。 这 些 函 数 都 没 有 错 误 检 测 部 分。
下 面 所 有 例 子 使 用 的 都 是Access2.0 数 据 库。
变 量 声 明：
Option Explicit
Const OLE_SAVE_TO_FILE = 11 'OLE Action 常 量
Const OLE_LOAD_FROM_FILE = 12 'OLE Action 常 量
Const CHUNK_SIZE = 32000 ' 文 件 读 写 块 的 大 小
下 面 的 函 数 将Access 1.x 数 据 库 中OLE 字 段 的 内 容 取 出 并 插
入OLE2 控 件 中。
Function AccessFieldToOLE
(oleObject As Control, fdObject As Field)
Dim eError As Integer
Dim iFileNumber As Integer
Dim wOffsetToObject As Integer
iFileNumber = FreeFile
' 获 取 文 件 号
Open App.Path & "\OLE.TMP" For Binary As iFileNumber
' 创 建 临 时 文 件
eError = FieldToFileStream(iFileNumber, fdObject)
' 将 字 段 的 内 容 写 到 文 件 中
Get iFileNumber, 3, wOffsetToObject
' 获 得Object 的 偏 移 地 址
Seek iFileNumber, wOffsetToObject + 1
' 到 object 的 起 始 位 置
oleObject.FileNumber = iFileNumber
' 将 OLE control 指 向 临 时 文 件
oleObject.Action = OLE_LOAD_FROM_FILE
' 从 文 件 中 取 出 OLE object
Close iFileNumber
' 关 闭 临 时 文 件
Kill App.Path & "\OLE.TMP"
' 删 除 临 时 文 件
AccessFieldToOLE = 0
' 返 回
End Function
下 面 的 函 数 将OLE 字 段 中 的 内 容 写 到 临 时 文 件 中。
Function FieldToFileStream
(iFileNumber As Integer, fdObject As Field) As Integer
Dim sChunkHolder As String
Dim lChunkCount As Long
Dim lChunkRemainder As Long
Dim i As Long
lChunkCount = fdObject.FieldSize() \ CHUNK_SIZE
' 获 得 文 件 的 块 数
lChunkRemainder = fdObject.FieldSize() Mod CHUNK_SIZE
' 整 块 后 余 下 的 数 据
For i = 0 To lChunkCount - 1
sChunkHolder = fdObject.GetChunk
(i * CHUNK_SIZE, CHUNK_SIZE)
' 取 一 块
Put iFileNumber, , sChunkHolder
' 将 块 写 入 临 时 文 件
Next
If lChunkRemainder > 0 Then
sChunkHolder = fdObject.GetChunk
(lChunkCount * CHUNK_SIZE, lChunkRemainder)
' 取 余 下 的 数 据
Put iFileNumber, , sChunkHolder
' 将 其 写 入 临 时 文 件
End If
FieldToFileStream = 0
' 返 回
End Function
下 面 的 函 数 将OLE2 数 据 库 字 段 的 内 容 取 出 并 插 入OLE2 控 件
中。
Function FieldToOLE
(oleObject As Control, fdObject As Field)
Dim eError As Integer
Dim iFileNumber As Integer
iFileNumber = FreeFile
' 获 取 文 件 号
Open App.Path & "\OLE.TMP" For Binary As iFileNumber
' 创 建 临 时 文 件
eError = FieldToFileStream(iFileNumber, fdObject)
' 将 字 段 的 内 容 写 到 临 时 文 件 中
Seek iFileNumber, 1
' 到 object 的 起 始 位 置
oleObject.FileNumber = iFileNumber
'OLE 控 件 指 向 临 时 文 件
oleObject.Action = OLE_LOAD_FROM_FILE
' 从 文 件 中 取 出 OLE object
Close iFileNumber
' 关 闭 临 时 文 件
Kill App.Path & "\OLE.TMP"
' 删 除 临 时 文 件
FieldToOLE = 0
' 返 回
End Function
下 面 的 函 数 将 临 时 文 件 写 入 数 据 库 的OLE2 字 段 中。
Function FileStreamToField
(iFileNumber As Integer, fdObject As Field) As Integer
Dim sChunkHolder As String
Dim lChunkCount As Long
Dim lChunkRemainder As Long
Dim i As Long
sChunkHolder = Space$(CHUNK_SIZE)
' 临 时 存 贮 块
lChunkCount = (LOF(iFileNumber) - Seek(iFileNumber) + 1)
\ CHUNK_SIZE ' 取 块 数
lChunkRemainder = (LOF(iFileNumber) - Seek
(iFileNumber) + 1) Mod CHUNK_SIZE
' 取 整 块 后 余 下 的 数 据
For i = 1 To lChunkCount
Get iFileNumber, , sChunkHolder
' 从 文 件 中 取 出 一 块
fdObject.AppendChunk (sChunkHolder)
' 将 块 写 入 字 段 中
Next
If lChunkRemainder > 0 Then
sChunkHolder = Space$(lChunkRemainder)
' 临 时 存 贮 块
Get iFileNumber, , sChunkHolder
' 取 出 该 块
fdObject.AppendChunk (sChunkHolder)
' 写 入 字 段 中
End If
FileStreamToField = 0
' 返 回
End Function
下 面 的 函 数 将OLE2 Object 从OLE2 控 件 中 取 出， 并 存 入 数 据 库
字 段 中。
Function OLEToField (oleObject As Control,
fdObject As Field) As Integer
Dim eError As Integer
Dim iFileNumber As Integer
iFileNumber = FreeFile
' 获 取 文 件 号
Open App.Path & "\OLE.TMP" For Binary As iFileNumber
' 创 建 临 时 文 件
oleObject.FileNumber = iFileNumber
'OLE 控 件 指 向 临 时 文 件
oleObject.Action = OLE_SAVE_TO_FILE
' 将 字 段 的 内 容 写 到 临 时 文 件 中
Seek iFileNumber, 1
' 到 object 的 起 始 位 置
fdObject = "" 清 空OLE2 字 段
eError = FileStreamToField(iFileNumber, fdObject)
' 将 文 件 写 入OLE2 字 段 中
Close iFileNumber
' 关 闭 临 时 文 件
Kill App.Path & "\OLE.TMP"
' 删 除 临 时 文 件
OLEToField = 0 ' 返 回
End Function
上 述 函 数 的 调 用 方 法 十 分 简 单， 下 面 的 两 个 子 程 序 给 出
了 调 用 例 子。
将OLE2 字 段 中 的 内 容 取 出 并 插 入OLE 控 件 中
Sub GetOLEObject()
Dim eError As Integer
' 将OLE 字 段File_Cont 中 的 内 容 取 出 并 插 入OLE 控 件OLE1 中
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
End Sub
将OLE2 控 件 中 的 内 容 写 入OLE2 字 段
Sub PutOLEObject()
Dim eError As Integer
tbOLEObjects.Edit ' 修 改OLEObjects 的 工 作 方 式
eError = OLEToField(OLE1, tbOLEObjects("File_Cont"))
' 保 存OLE 控 件OLE1 中 的 内 容
tbOLEObjects.Update ' 更 新tbOLEObjects
DoEvents
End Sub
因 为Access1.x 的OLE 字 段 格 式 与OLE2 字 段 的 格 式 不 同， 所 以，
若 是OLE2 字 段， 在 读 取 字 段 内 容 时， 应 使 用FieldToOLE 函 数；
若 是Access1.x 的 OLE 字 段， 应 使 用AccessFieldToOLE 函 数。 这 两
种 格 式OLE 字 段 的 存 贮 过 程 是 相 同 的。 当 使 用Access2.0 建 立
数 据 库 并 存 贮OLE 字 段 时， 它 是OLE2 格 式 的， 应 使 用FieldToO
LE 函 数。 用VB3 编 程 时， 系 统 中 应 安 装VB/Access2.0 兼 容 层， 否
则 无 法 操 纵Access2.0 数 据 库。
第 二、 如 何 使Data 控 件 显 示 的 记 录 与OLE 字 段 的 内 容 同 步。
这 个 问 题 是 因 为Data 控 件 不 支 持 超 长 的OLE 字 段 引 起 的。 对
于 普 通 的 数 据 库 字 段， 把 显 示 该 字 段 内 容 控 件 的DataSour
ce 和DataField 属 性 分 别 置 为Data 控 件 和 数 据 库 的 字 段 名， 就
可 以 由Data 控 件 正 确 地 显 示 数 据 库 记 录 的 字 段 内 容。 而
用 于 显 示OLE2 字 段 内 容 的OLE 控 件 的 数 据 是 无 法 用Data 控 件
来 存 取 的， 必 须 用 上 面 提 供 的 函 数 来 存 取。 这 时， 关 键
问 题 是 使OLE 控 件 显 示 的 内 容 是Data 控 件 所 在 记 录 中OLE 字
段 的 内 容， 也 就 是OLE 控 件 要 与Data 控 件 同 步。
实 现 方 法：
声 明 一Dynaset 类 型 的Object：tbOLEObjects。
在Form_Load 事 件 的 执 行 程 序 中， 将Data1.RecordSet 赋 给tbOLEObje
cts ， 并 记 录tbOLEObjects 中 的 记 录 数。
在Data1_Validate 事 件 的 执 行 程 序 中， 使tbOLEObjects 执 行 的 动
作 与Data1 一 致， 即： 在Data1 的Data1_Validate 事 件 执 行 程 序 中，
当Data1 执 行Data1.RecordSet.MoveNext 或Data1.RecordSet.MoveFirst 时，
tbOLEObjects 也 要 执 行tbOLEObjects.MoveNext 或tbOLEObjects.MoveFirst
。 实 现 时， 先 保 存 当 前OLE 控 件 中 的 内 容， 然 后 执 行tbOLEOb
jects.MoveNext 或tbOLEObjects.MoveFirst 方 法， 再 取 出OLE 字 段 中 的
内 容， 插 入 到OLE 控 件 中。
当 系 统 执 行 了 一 个SQL 语 句 后，Data1 显 示 的 记 录 直 接 跳 到
某 一 记 录， 对tbOLEObjects 来 说， 则 要 执 行 一 查 找 过 程， 使 得
tbOLEObjects 的 当 前 记 录 与Data1 的 当 前 记 录 一 致。 实 现 时，
先 保 存 当 前OLE 控 件 中 的 内 容， 再 在tbOLEObjects 中 查 找Data1
的 当 前 记 录， 找 到 后， 将 其OLE 字 段 中 的 内 容 取 出 并 插 入
到OLE 控 件 中。
下 面 给 出 的 实 现 例 子 是 从 本 人 编 写 的 一 个 软 件 中 摘 录 出
来 的， 它 说 明 了 具 体 的 实 现 方 法， 但 不 可 以 直 接 使 用，
要 结 合 自 己 的 程 序， 加 上 其 它 必 要 的 部 分。 例 子 中 的 数
据 库 是 一 个 公 文 数 据 库， 保 存 用 户 的 重 要 公 文， 其 中 的O
LE 字 段 保 存 的 就 是Word 文 档， 名 字 为File_Cont， 其 它 字 段 是
文 档 的 相 关 信 息， 如 文 档 的 标 题(File_Title)、 等 级(File_Cla
ss)、 关 键 字(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 事 件 中 执 行， 完 成 对tbOLEO
bjects 赋 值 并 计 算 出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" 错 误， 笔 者 没 有 找 到 产 生 这 个 问 题 的 原
因 和 解 决 方 法， 如 果 有 朋 友 告 知 解 决 方 法， 笔 者 十 分 感
谢。
=========================================================
欢迎投稿：[email protected]
=========================================================
请订阅：
http://server.com/WebApps/mail-list-subscribe.cgi?id=16852
---- 在 诸 多Windows 应 用 程 序 开 发 平 台 中，Microsoft Visual BASI
C 以 易 学 易 用、 功 能 强 大 的 优 点 特 出 独 立， 成 为 开 发Windo
ws 应 用 程 序 的 首 选 平 台 之 一。 在VB 4.0 及 以 前 的 版 本 中，
开 发 象Word 7.0 中 的 工 具 条 还 是 颇 费 辛 苦 的。 一 般 思 路 是
在 窗 体(Form) 中 安 放 一 个 图 片 框(PictureBox) 作 为 容 器(Contain
er)， 再 往 其 中 加 入 图 象(Image) 控 件， 用 图 象 控 件 载 入 图 标
来 模 拟 按 钮。 对 多 个 按 钮 的 控 制 要 分 别 完 成， 管 理 较 为
复 杂。 在VB 5.0 中， 系 统 提 供 了 一 个 专 门 的 工 具 条 控 件Too
lbar。 用Toolbar 来 实 现 类 似Word 7.0 中 的 工 具 条 非 常 方 便。
工 具 条 控 件Toolbar 简 介 ---- 1. 在 工 具 箱 中 加 入Toolbar
---- 工 具 条 控 件Toolbar 不 在VB 5.0 工 具 箱(Toolbox) 的 常 规 标 准
控 件 之 列， 因 此 在 首 次 安 装VB 5.0 后， 工 具 箱 中 并 没 有Too
lbar。 在 工 具 箱 中 加 入Toolbar 要 通 过Project 菜 单 中 的Componen
ts 命 令， 该 命 令 弹 出 一 个 选 择 安 装 组 件 的 窗 口。 在Compone
nts 窗 口 的Controls 组 中 找 到“Microsoft Windows Common Controls 5.
0” 项， 单 击 标 记 该 项， 然 后 单 击“ 确 定” 按 钮，Toolbar 和 另
外 一 些 控 件 就 加 入 工 具 箱 了。
---- 2. Toolbar 的 功 能
---- Toolbar 中 可 以 加 入 按 钮， 每 个 按 钮 都 可 以 载 入 自 己 的
图 象、 设 置 标 题(Caption)。 还 可 以 为 每 个 按 钮 设 置 简 短 的
提 示 字 符 串， 程 序 运 行 时， 当 鼠 标 指 针 移 到 按 钮 上 时，
在 指 针 附 近 会 自 动 浮 出 提 示 字 符 串。 在 程 序 运 行 时， 可
以 随 时 增 加 或 删 除 按 钮。Toolbar 为 其 中 的 按 钮 提 供 了 分 组
功 能， 用 户 只 需 简 单 地 设 置 一 个 按 钮 的Style 属 性 就 能 实
现 按 钮 之 间 的 分 组。Toolbar 同 时 还 是 一 个 容 器 类 控 件， 可
以 在 其 中 加 入 组 合 框 等 其 它 控 件。Toolbar 的AllowCustomize 属
性 允 许 用 户 在 程 序 运 行 时 双 击 工 具 条 对 其 中 的 内 容 进
行 裁 剪。 根 据 这 些 功 能， 用 户 就 可 以 轻 而 易 举 地 在 自 己
开 发 的 应 用 程 序 中 加 入 类 似Word 7.0 风 格 的 工 具 条 了。
Toolbar 的 制 作
---- Toolbar 的 制 作 包 括 以 下 步 骤： 在 窗 体 中 加 入Toolbar 控
件； 在Toolbar 中 加 入 按 钮； 为 按 钮 载 入 图 象 并 设 置 其 它 属
性。
---- 1. 在 窗 体 中 加 入Toolbar 控 件
---- 双 击 工 具 箱 中 的Toolbar，Toolbar 就 自 动 加 入 窗 体 并 放 置
在 窗 体 客 户 区 的 顶 端。 如 果 要 把Toolbar 放 置 在 其 它 位 置，
可 以 在 属 性 窗 口 中 改 变Toolbar 的Align 属 性。Toolbar 的Align 属
性 中 可 供 选 择 的 有5 个 值：
---- 0 - vbAlignNone， 不 对 齐
---- 1 - vbAlignTop， 对 齐 窗 口 客 户 区 顶 端
---- 2 - vbAlignBottom， 对 齐 窗 口 客 户 区 底 端
---- 3 - vbAlignLeft， 对 齐 窗 口 客 户 区 左 边
---- 4 - vbAlignRight， 对 齐 窗 口 客 户 区 右 边
---- 2. 在Toolbar 中 加 入 按 钮
---- 用 鼠 标 右 键 单 击Toolbar， 会 弹 出Toolbar 的 属 性 菜 单。 单
击 菜 单 的 最 后 一 项“Properties”， 会 弹 出Toolbar 的 属 性 页(P
roperty Pages) 窗 口。 在 属 性 页 窗 口 中 可 以 设 置 控 件 的 一 些
非 常 规 属 性。
---- 在Toolbar 属 性 页 中 选Buttons 组?/TD>
|
|