216、如何读取 INI
文件的资料？
217、如何删除整个
Access 资料库内的资料？
218、如何在鼠标经过
Label 上方时改变 Label 的颜色？
219、如何对ListView中的列排序
220、如何自动出现动画、进度和确认的文件操作
216、如何读取 INI 文件的资料？
在本网站中很少提到有关 INI 文件的存取问题，因为我认为现在 Windows
已经将大部份的资料都写到注册文件中了，虽然 Windows 95/98 还有在使用 INI 文件，但是在 NT 中则已经不使用了！我猜将来
Windows 2000 应该也不会使用才对！不过，尽管如此，目前还是有人在使用，我们就分几次来说说！
读取 INI 文件的 API
有分二套，一套是专门用来读取 Win.ini 文件的，一套是用来读取所有 INI 文件的 ( 当然也包含 Win.ini 文件
)，而这二套的差别只在于读取所有 INI 文件的 API 在使用时必须多传入一个参数，用来指定 INI 文件的名称及路径。
想要存取
INI 文件，要先了解 INI 文件的结构，如下：
[Section1] 'Section Name
Key1=Content1
'=前面是 Key，=后面是 Key
的内容
Key2=Content2
Key3=Content3
:
[Section2]
Key1=Content1
Key2=Content2
Key3=Content3
::
'以下是用来读取所有
INI 文件的 API ( 适用于所有的ini 文件，包含 Win.ini 文件 )
'读取 INI
中的数值资料
Declare Function GetPrivateProfileInt Lib "kernel32" Alias
"GetPrivateProfileIntA" _
(ByVal lpApplicationName As String, _
'Section Name
ByVal lpKeyName As String, _ 'Key
ByVal nDefault As
Long, _ 'Key 的内容，若无法读取则返回 Default 值
ByVal lpFileName As String) As Long
'INI 文件的名称及路径
'读取 INI 中的字串资料
Declare Function
GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA"
_
(ByVal lpApplicationName As String, _ '若是传入 vbNullString，则返回所有的
Section 名称
ByVal lpKeyName As Any, _ '若是传入 vbNullString，则返回所有的 Key
名称
ByVal lpDefault As String, _ 'Key 的内容Default 值
ByVal
lpReturnedString As String, _ '若无法读取则返回第三个参数 Default 值
ByVal nSize As
Long, _ '返回值的长度
ByVal lpFileName As String) As Long
'读取某一个
Section 之所有资料
Declare Function GetPrivateProfileSection Lib "kernel32"
Alias "GetPrivateProfileSectionA" _
(ByVal lpAppName As String, _
ByVal lpReturnedString As String, _ '返回值中各行资料以 chr(0) 分开
ByVal
nSize As Long, _ '返回值的长度
ByVal lpFileName As String) As
Long
'以下是专门用来读取 Win.ini 文件的 API ( 只适用于 Win.ini 文件 )
'读取
Win.ini 中的数值资料
Declare Function GetProfileInt Lib "kernel32" Alias
"GetProfileIntA" _
(ByVal lpAppName As String, _ 'Section Name
ByVal
lpKeyName As String, _ 'Key
ByVal nDefault As Long) As Long 'Key
的内容
'读取 Win.ini 中的字串资料
Declare Function GetProfileString Lib
"kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal
lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As
String, ByVal nSize As Long) As Long
'读取 Win.ini 某一个 Section
之所有资料
Declare Function GetProfileSection Lib "kernel32" Alias
"GetProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As
String, ByVal nSize As Long) As Long
由于读取所有 INI 文件的 API 也适用于
Win.ini 文件，所以我们将以读取所有 INI 文件的 API
来实作范例，在这个例子中，我们提供的功能有：
1、可以选择不同的目录
2、开启某一个目录后，可以选择开启任何一个 INI
文件
3、开启任一个 INI 文件后，可以选择想要浏览的 Section
4、读入某一个 Section 后，可以查阅每一个 Key
的详细内容
而在这个练习中，除了读取 INI 文件的 API 之外，我们也用到了以前提到的一些技巧，如下：
问题:
如何用 VB 呼叫出在【寻找：所有文件】中的【浏览资料夹】问话框？
问题: 如何找出 Windows / System / Temp
目录的正确路径？ (二)
问题: 如何一次读取整个文件的内容？
问题: 按下 CommandButton
之前后，如何让光标停留在同一个物件中？
问题: 您用过【符号字型】吗？
注：网友 琏琏 提到，上面这些处理 INI 文件的
API，只能处理文件前 64 k
的资料！
注：不过我个人认为，如果资料量真的很大时，倒可以考虑一下改用资料库来处理！
217、如何删除整个 Access 资料库内的资料？
当一个资料库用了一阵子之后，您可能必须清除资料库中所有的资料，例如：我在开发一个新系统时，使用一个
Access 资料库， 面可能有二、三十个
Table，中间经过系统的测试，系统完成后，准备系统上线时，必须将所有的测试资料删除！
当然，要完成这件事情有很多种作法，例如：
1、在
Access 中逐一开启所有资料库的每一个 Table → 选取所有资料 → 删除。
2、在 Access 开启一个新资料库 → Import
原资料库的所有 Table (只有 Structure)。
3、写一段 VB 小程序去删除所有资料！
前二种作法是人工的作法，当
Table 越多时就越烦琐，不在我们讨论之列，至于第三种作法，我已经写了一个小小的模组，您只要传入资料库的名称、路径就可以自动帮您完成了！
程序码如下：
Function DeleteAllRecords(ByVal dbpath As String)
Dim db
As Database
Dim X As Integer
Dim TDF As TableDef
Set db =
opendatabase(dbpath)
For X = 0 To db.TableDefs.Count - 1
Set TDF =
db.TableDefs(X)
If (TDF.Attributes And dbSystemObject) = 0 Then '避开系统的
Table
db.Execute "Delete * From [" & db.TableDefs(X).Name &
"]"
End If
Next X
End Function
在 Access 资料库中，除了您自己建立的 Table
之外，还隐藏了一些系统的 Table，判断 dbSystemObject 就是为了要避开这些系统的
Table。
程序中实际使用时，方法如下：
Private Sub
Command1_Click()
DeleteAllRecords "c:\Test.mdb" 'c:\Test.mdb
要转换成您自己的资料库
End Sub
注：Access
资料库有个缺点，当您写资料进去时，文件会变大，但是删除资料库中的资料后，资料库文件并不会变小，所以，如果您使用以上的程序来清空 Access
资料库内的资料后，原来已经 10MB 的资料库，处理完之后文件大小仍然还是 10MB！
注：建议在清空资料库中之资料后，再使用
CompactDataBase 来处理，它会将您的资料库再还原成只有几十k 或几百k 的大小。CompactDataBase
之语法如下：
DBEngine.CompactDataBase "原资料库文件名", "新资料库文件名", , ,
";pwd=密码"
实例例如：
DBEngine.CompactDatabase "C:\Db1.mdb", "C:\Db2.mdb",
, , ";pwd=1"
218、如何在鼠标经过 Label 上方时改变 Label
的颜色？
在我的网站中，当您的鼠标经过每一个连结时，连结的颜色 (ForeColor)
及底色 (BackColor) 都会改变，这是使用 CSS (Cascading Style Sheets)
的语法所营造出来的效果！我感觉很棒，很醒目，不知道各位感觉如何？
您是否想过在您使用 VB
开发的系统中，也可以使用这个技巧？
一般我们都是使用 Menu
选单来让使用者执行程序，当然很好。不过有的系统不是很大，没有几支程序，若是使用 Menu 选单的话，主程序会略显单薄，这时候我都是使用 Label
来当作程序选单，可以将字型稍微放大，例如 28 或 36，但若只是使用标准的 Label 功能的话，使用者 Click 之后会不知道是否已按下
Label 选单，但若是当鼠标经过每一个 Label 选单时，我们将颜色改变，鼠标离开 Label
选单后，我们再将颜色还原回来，效果就很好了！
以下的范例中，我们在表单中放进二个 Label
当作程序选单，您也可以多放几个效果更好！
将以下的程序码全部复制到表单中：
Dim MyFocusColor,
MyNormalColor '声明鼠标经过每一个 Label 选单及离开 Label 选单之颜色变数
Dim Lbl As
Label
Sub ChangeColor(Lbl As Label) '模组：鼠标经过每一个 Label 选单时变更颜色
If
Lbl.ForeColor <> MyFocusColor Then
Lbl.ForeColor =
MyFocusColor
End If
End Sub
Private Sub
Form_Load()
MyNormalColor = QBColor(0) '黑色：每一个 Label 平时的颜色 / 离开 Label
选单之颜色
MyFocusColor = QBColor(15) '白色：声明鼠标经过每一个 Label 选单之颜色
End
Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer,
X As Single, Y As Single)
Dim i As Integer
For Each i In
Me.Controls
If TypeOf i Is Label Then '鼠标离开 Label 选单后将颜色还原
If
i.ForeColor <> MyNormalColor Then
i.ForeColor =
MyNormalColor
End If
End If
Next i
End Sub
Private Sub
Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As
Single)
Call ChangeColor(Label1)
End Sub
Private Sub
Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As
Single)
Call ChangeColor(Label2)
End Sub
: '若您使用二个以上的 Label
时，类推。
:
感觉如何？还不错吧
219、如何对ListView中的列排序
设置 ListView 控件到 report
视图。下面的代码允许你使用
任何的列进行排序，主要在列头上点击。
如果已经排序，顺序将反一下。
Private Sub
ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
With
ListView1
If (ColumnHeader.Index - 1) = .SortKey Then
.SortOrder =
(.SortOrder + 1) Mod 2
Else
.Sorted = False
.SortOrder =
0
.SortKey = ColumnHeader.Index - 1
.Sorted = True
End If
End
With
End Sub
220、如何自动出现动画、进度和确认的文件操作
使用以下的 API ， 得到与资源管理器相同的感觉！
Private Type SHFILEOPSTRUCT
hwnd As
Long
wFunc As Long
pFrom As String
pTo As String
fFlags As
Integer
fAnyOperationsAborted As Long
hNameMappings As
Long
lpszProgressTitle As String '只有在 FOF_SIMPLEPROGRESS 时用
End
Type
Private Declare Function SHFileOperation Lib "shell32.dll"
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As
Long
'wFunc 常数
'FO_COPY 把 pFrom 文件拷贝到 pTo。
Const FO_COPY =
&H2
'FO_DELETE 删除 pFrom 中的文件（pTo 忽略）。
Const FO_DELETE =
&H3
'FO_MOVE 把 pFrom 文件移动到 pTo。
Const FO_MOVE =
&H1
'fFlag 常数
'FOF_ALLOWUNDO 允许 Undo 。
Const
FOF_ALLOWUNDO = &H40
'FOF_NOCONFIRMATION 不显示系统确认对话框。
Const
FOF_NOCONFIRMATION = &H10
'FOF_NOCONFIRMMKDIR 不提示是否新建目录。
Const
FOF_NOCONFIRMMKDIR = &H200
'FOF_SILENT 不显示进度对话框
Const FOF_SILENT
= &H4
例子：
Dim SHFileOp As SHFILEOPSTRUCT
'
删除
SHFileOp.wFunc = FO_DELETE
SHFileOp.pFrom = "c:\config.old" +
Chr(0)
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call
SHFileOperation(SHFileOp)
' 删除多个文件
SHFileOp.wFunc =
FO_DELETE
SHFileOp.pFrom = "c:\config.old" +Chr(0) +
"c:\autoexec.old"+Chr(0)
SHFileOp.fFlags = FOF_ALLOWUNDO
Call
SHFileOperation(SHFileOp)
' 拷贝
SHFileOp.wFunc = FO_COPY
SHFileOp.pFrom = "c:\t\*.*"
SHFileOp.pTo =
"d:\t\*.*"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR
Call
SHFileOperation(SHFileOp)
' 移动
SHFileOp.wFunc = FO_MOVE
SHFileOp.pFrom = "c:\config.old" + Chr(0)
SHFileOp.pTo =
"d:\t"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call
SHFileOperation(SHFileOp) |