|
 |
推荐文章 |
|
|
|
|
|
|
|
|
|
|
| 作者：本站收集 日期：2005-8-4 11:23:23 |
|
|
---- Ｖ Ｂ 是 一 个 高 效 快 捷 的 ＷINDOWS 应 用 程 序 开 发 工 具， 倍 受 人 们 青 睐。 然 而， Ｖ Ｂ 也 有 其 局 限 性， 部 分 控 件 不 够 完 善， 许 多 事 件 和 属 性 没 有 提 供， 又 加 上 Ｖ Ｂ 自 身 的 封 闭 性（ 不 允 许 自 我 创 建 对 象）， 使 得 我 们 很 难 开 发 出 具 有 一 定 特 色 的 程 序， 如 Ｖ Ｂ 的 驱 动 器 列 表 框 便 是 一 例。
---- 在 要 求 不 高 的 情 况 下， Ｖ Ｂ 的 驱 动 器 列 表 框 能 很 好 的 胜 任 其 工 作。 在 使 用 它 时 候， 一 般 在 其 CHANGE 事 件 中 加 入 以 下 代 码， 用 以 改 变 当 前 路 径， 从 而 带 动 目 录 列 表 框：
DIR.PATH= DRIVE1.DRIVE
---- 其 中 DIR1、DRIVE1 分 别 是 驱 动 器 列 表 框 和 目 录 列 表 框 的 名 字（NAME 属 性， 以 下 同）。 这 样， 在 运 行 时 只 要 从 驱 动 器 列 表 框 中 任 选 一 项（ Ａ：、 Ｂ：、 Ｃ：、...）， 目 录 列 表 框 中 的 内 容 便 会 跟 着 变 动。
---- 然 而， 事 情 远 不 象 它 显 示 的 那 么 简 单， 在 程 序 运 行 时 可 能 会 出 现 以 下 情 况：
---- ⑴、 如 果 驱 动 器 中 没 有 磁 盘 便 会 产 生 运 行 时 错 误， 从 而 导 致 整 个 程 序 运 行 终 止， 这 是 我 们 所 不 想 见 到 的。 这 时 有 必 要 在 CHANGE 事 件 中 加 入 出 错 处 理：
SUB DRIVE1.CHANGE ()
DIM BACK%
ON ERROR GOTO ERRHANDL
DIR1.PATH=DRIVE1.DRIVE
EXIT SUB
ERRHANDL:
BEEP
'显示惊叹号图标和 RETRY ,CANCLE按钮
BACK=BMSGBOX (ERROR(ERR),5 OR 48,"错误")
IF BACK=4 THEN '按下 RETRY按钮
RESUME
ELSE
RESUME NEXT
ENDIF
EXIT SUB
END SUB
---- 在 这 种 情 况 下， 当 错 的 时 候， 往 驱 动 器 中 插 入 磁 盘 并 按 下 REYRY 按 钮， 程 序 得 以 正 确 运 行； 若 按 下 CANCEL 按 钮 就 会 出 现 以 下 问 题：
---- 目 录 列 表 框 的 当 前 内 容 没 有 发 生 改 变， 而 驱 动 器 列 表 框 的 内 容 则 为 刚 才 选 中 的 驱 动 器， 也 即 驱 动 器 列 表 框 和 目 录 列 表 框 的 内 容 没 有 指 向 同 一 磁 盘， 这 当 然 是 我 们 所 不 能 容 忍 的。 原 因 在 于 这 个 出 错 处 理 过 程 是 加 在 CHANGE 事 件 中 的， 而 CHANGE 事 件 是 在 当 前 驱 动 器 发 生 变 化 以 后 才 产 生 的。 如 果 驱 动 器 列 表 框 有 CLICK 事 件 的 话， 那 么 问 题 便 迎 刃 而 解 了。
---- ⑵、 若 更 换 软 驱 中 的 磁 盘， 再 次 选 中 当 前 驱 动 器 进 行 目 录 列 表 时， 则 驱 动 器 列 表 框 和 目 录 列 表 框 中 的 内 容 不 会 有 变 动， 仍 为 上 一 张 盘 的 内 容， 和 我 们 的 意 愿 很 不 相 符。 原 因 和 上 面 的 情 况 基 本 类 似， 这 是 因 为 对 驱 动 器 列 表 框 来 说， 当 前 驱 动 器 并 没 有 发 生 变 化， 也 就 不 会 引 发CHANGE 事 件， 相 应 的 其 他 事 件 也 就 不 会 触 发。
---- ⑶、 只 提 供 硬 盘 的 卷 标， 软 盘 即 使 有 也 不 显 示。
---- 这 些 问 题 的 出 现 一 方 面 和 驱 动 器 列 表 框 提 供 的 事 件 过 少 有 关； 另 一 方 面 则 说 明 驱 动 器 列 表 框 本 身 不 够 完 善（ 应 能 自 动 识 别 一 些 可 能 发 生 的 错 误）。 再 者， 驱 动 器 列 表 框 本 身 并 不 和 驱 动 器 直 接 相 关， 驱 动 器 的 驱 动 是 由 目 录 列 表 框 来 完 成 的， 驱 动 器 列 表 框 只 是 为 改 变 当 前 路 径 提 供 了 一 个 手 段。 由 于 验 证 很 简 单， 在 这 里 就 不 再 赘 述 了。
---- 为 了 解 决 以 上 问 题， 经 过 分 析 和 实 践， 笔 者 找 到 了 一 个 完 美 的 解 决 方 案。
---- 由 于 Ｖ Ｂ 的“ 封 闭 性”， 故 不 能 直 接 对 驱 动 器 列 表 框 进 行 改 动， 用 Ｃ ＋ ＋ 重 写 驱 动 器 列 表 框 对 广 大 用 户 来 说 也 不 太 可 能， 况 且 在 发 布 程 序 时 还 要 带 上 一 个 小 尾 巴 ─ ─ XXX.VBX。 故 我 们 采 用 组 合 框 来 代 替 驱 动 器 列 表 框 的 方 法。
---- 组 合 框 所 提 供 的 事 件 非 常 丰 富（ 有 十 几 种 之 多）， 在 这 里 我 们 只 用 到 以 下 两 个：Click 和 Dropdown。Click 事 件 在 用 箭 头 键 或 用 鼠 标 单 击 组 合 框 中 一 条 目 时 发 生； Dropdown 事 件 则 在 列 表 部 分 准 备 下 放 时 发 生。 对 于 本 文 所 附 程 序 来 说，Click 事 件 过 程 主 要 用 来 改 变 当 前 驱 动 器、 驱 动 目 录 列 表 框 和 获 取 并 处 理 当 前 磁 盘 的 卷 标；Dropdown 事 件 过 程 用 来 记 录 当 前 驱 动 器 的 列 表 下 标， 以 备 出 错 时 还 原 原 来 选 项， 具 体 过 程 见 所 例 程。
---- 由 于 Ｖ Ｂ 没 有 获 取 驱 动 器 数 目 的 函 数 和 方 法， 为 获 取 当 前 环 境 下 的 驱 动 器 数 目 和 当 前 驱 动 器， 我 们 可 以 采 用 以 下 两 种 方 法： ⑴、 在 当 前 窗 体 中 多 加 一 个 驱 动 器 列 表 框（ 设 置 其VISIBLE 属 性 为FALSE）， 这 样 一 来， 便 可 在 FORM_LOAD 事 件 过 程 中 将 驱 动 器 列 表 框 中 的 内 容 加 到 组 合 框 中。
---- ⑵、 调 用 WINDOWS 所 提 供 的 API 函 数 GetDriveType ()。
---- 该 函 数 的 功 能 为 返 回 指 定 驱 动 器 的 类 型， 如， 软 盘、 硬 盘 等， 但 我 们 也 可 以 根 据 其 返 回 值 来 确 定 所 测 试 的 磁 盘 是 否 存 在。
---- 该 函 数 的 原 型 为：
Declare Function GetDriveType Lib "kernel"
(ByVal nDrive as integer) as integer
---- 其 中 nDrive 为 欲 测 的 驱 动 程 序 代 号， ０ 代 表 Ａ 磁 盘， １ 代 表 Ｂ 磁 盘， ２ 代 表 Ｃ 磁 盘， 依 次 类 推。 返 回 值 的 意 义 是： 如 果 返 回 ０ 则 代 表 所 检 测 的 驱 动 器 不 存 在， ２ 代 表 所 测 试 的 驱 动 器 为 软 驱， ３ 代 表 所 测 试 的 驱 动 器 为 硬 盘， ４ 则 代 表 所 测 试 的 驱 动 器 为 CD-ROM 或 为 网 络 驱 动 器。 我 们 可 根 据 是 否 返 回 ０ 来 决 定 所 指 定 的 磁 盘 是 否 存 在。 在 检 测 过 程 中 如 果 检 测 到 硬 盘 则 读 取 硬 盘 的 卷 标。 根 据 这 一 原 理， 只 要 我 们 从 Ａ 驱 遍 历 到 Ｚ 驱， 便 可 检 测 到 当 前 机 器 上 的 所 有 磁 盘 驱 动 器。 在 程 序 中 调 用 以 下 过 程， 便 可 方 便 的 实 现 这 一 功 能：
---- ' 函 数 GetDriveType 须 在 全 局 模 块 中 加 以 声 明
Sub Chkdrive ()
On Error Resume Next
Dim i%, back%, drv$, dpath$
For i = 0 To 26 '从Ａ驱到Ｚ驱
back = getdrivetype(i) '检测指定的驱动器
If back < > 0 Then '不为０ 则检测到
drv$ = Chr$(i + 65) & ":" '指定的驱动器符
If back = 3 Then '检测到硬盘
dpath$ = drv$ & "\*.*"
'返回硬盘卷标并进行格式处理
combo1.AddItem drv$ & "
[ " & Left(Dir(dpath$, 8), 3) & "... ]"
Else
combo1.AddItem drv$ & " [ None ]"
End If
Else
Exit For '不存在则退出ＦＯＲ循环
End If
Next i
'以下返回当前驱动器
drv$=Left$(Curdir$,1)
For i= 0 to combo1.listcount-1
if instr(1,combo1.list(i),drv$,1) then
combo1.ListIndex = i
End If
End For
End Sub
---- 在 这 里 我 们 将 采 用 第 一 种 方 法。
---- 为 了 加 以 说 明， 笔 者 编 了 一 个 小 程 序 ─ ─ 文 件 管 理 器， 将 所 附 程 序 进 行 修 改 加 入 到 你 自 己 的 程 序 中， 你 的“ 驱 动 器 列 表 框” 便 无 懈 可 击 了。
---- 以 下 程 序 在 Ｖ Ｂ ＦOR WINDOWS VER 3.0 下 调 试 通 过。
'在设计阶段设置组合框的 Style属性为 2
'驱动器列表框的 Visible属性为 False
Option Explicit
Dim index% '设置为全局变量
Sub Combo1_Click ()
Dim erh%, label$, tmp$
On Error GoTo errorh
ChDrive Left$(combo1.Text,
InStr(combo1.Text, ":")) '改变当前驱动器
label = Dir("\*.*", 8) '获取当前磁盘卷标
'显示格式处理
If Len(label) = 0 Then
tmp$ = combo1.List(combo1.ListIndex)
combo1.List(combo1.ListIndex) =
Left$(Left$(tmp$, 2) + " [None] ", 12) + "盘"
Else
tmp$ = combo1.List(combo1.ListIndex)
combo1.List(combo1.ListIndex) =
Left$(tmp$, 3) & "[" & Left$(label, 3) & "...] " + " 盘"
End If
Dir1.Path = CurDir$ '获取当前目录
Dir1.Refresh : FILE1.Refresh '更新目录列表框和文件列表框
'此两句非常关键,不可缺省
'否则目录列表框不会变动
Exit Sub
'出错处理
errorh:
'显示惊叹号图标和 RETRY ,CANCLE按钮
erh = MsgBox(" " + Error(Err), 48 Or 5, "错误")
If erh = 2 Then '按下CANCLE按钮
combo1.ListIndex = index
Resume Next
Else
Resume
End If
Exit Sub
End Sub
Sub Combo1_DropDown ()
index = combo1.ListIndex ' 记录当前选项下标
End Sub
Sub Command1_Click ()
Dim tmp$
tmp$ = FILE1.FileName
Caption = fp(tmp$)
End Sub
'设计时让驱动器列表框隐含
Sub dir1_change ()
FILE1.Path = Dir1.Path
ChDir Dir1.Path
End Sub
Sub Drive1_Change ()
combo1.ListIndex = drive1.ListIndex
End Sub
Sub File1_Click ()
Dim tmp$
tmp$ = FILE1.FileName
label3 = Format(FileLen(fp$(tmp$)), "##,###,###")
End Sub
Sub File1_DblClick ()
Command1_Click
End Sub
'将驱动器更表框中的内容加入到组合框中
Sub Form_Load ()
Dim i%, tmp$
For i = 0 To drive1.ListCount - 1
If Len(drive1.List(i)) = 2 Then t
mp$ = Left$(drive1.List(i) + " [None] ", 12) + "盘"
End If
If InStr(drive1.List(i), "]") Then
If InStr(drive1.List(i), "]") > 7 Then
tmp$ = Left$(drive1.List(i), 7) + "...] " + "盘"
Else
tmp$ = Left$(drive1.List(i) + " ", 12) + "盘"
End If
End If
combo1.AddItem tmp
Next
combo1.ListIndex = drive1.ListIndex '设置当前驱动器
End Sub
Sub Form_Unload (Cancel As Integer)
End
End Sub
Function fp$ (file$)
If Right$(filebox.Dir1.Path, 1) = "\" Then
fp$ = filebox.Dir1.Path + file$
Else
fp$ = filebox.Dir1.Path + "\" + file$
End If
End Function
Sub Text1_KeyPress (keyascii As Integer)
If keyascii = 13 Then FILE1.Pattern = text1.Text
End Sub |
|
|
|
|
|
特别声明： 本站除部分特别声明禁止转载的专稿外的其他文章可以自由转载，但请务必注明出处和原始作者。文章版权归文章原始作者所有。对于被本站转载文章的个人和网站，我们表示深深的谢意。如果本站转载的文章有版权问题请联系编辑人员，我们尽快予以更正。 |
|
|
|
|
|
责任编辑： 原点 |
投稿作者： 本站收集 |
|
|
信息来源： 网络 |
录入时间： 2005-8-4 11:23:23 |
|
|
|
| |
|
设为首页
加入收藏
总编信箱
投稿或申请专栏请先 [登 陆]