203、如何在资料库中存入单引号？
当您想要新增一笔资料到 Access 或 Oracle 时，若文字栏位中含有单引号，便会产生错误！
在以下的例子中，我们告诉您如何使用 Chr$(34) 将含有单引号之字串存入 Jet database engine 中！
Private Sub CmdAddNew_Click()
Dim dbCustomer As Database ' 声明资料库
Dim strSql As String ' SQL 字串
Dim strodbc As String ' ODBC 字串
' 以下为资料库中客户档之三个栏位变量声明
Dim strCustID As String ' 客户代码
Dim strFirstName As String ' 客户名称
Dim strAddress As String ' 客户地址
strodbc = "odbc;uid=scott;pwd=tiger;dsn=myconnect"
Set dbCustomer = OpenDatabase("myconnect", dbDriverNoPrompt, False, strodbc)
strCustID = "A003"
strFirstName = "Annie"
strAddress = "Reflection's"
strSql = "insert into CUSTOMER values('" & strCustID & "'"
strSql = strSql & ",'" & strFirstName & "',"
strSql = strSql & Chr(34) & strAddress & Chr(34) & ")"
dbCustomer.Execute (strSql)
dbCustomer.Close
End Sub
'如果您还想要更详细的资料，您可以参考 Microsoft Knowledge Base 中的 Q147687。
204、如何算出 TextBox 中目前光标是在第几行？
在很多文字编辑器中，都可以告诉您，目前您的光标是在文字编辑器的第几行，我们也来实作一下！
在 Form 中放入一个 TextBox 并将 Multiline 属性设为 True，放入一个 Label 用来显示目前光标所在的行数，在表单声明区中加入以下声明及模组：
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const EM_LINEFROMCHAR = &HC9
Function LineNo(txthwnd As Long) As Long
On Local Error Resume Next
LineNo = SendMessageLong(txthwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
LineNo = Format$(lineno, "##,###")
End Function
'呼叫这个模组时要导入的是 TextBox 的 hwnd
'实际使用时，必须在 TextBox 的以下几个事件中呼叫这个模组，才会完全正确：
'1. Change事件：输入资料时可侦测计算
'2. Click 事件：用鼠标移动光标时可侦测计算
'3. KeyUp 事件：用上下左右键移动光标时可侦测计算
Sub Text1_Change()
Label1 = LineNo(Text1.hwnd)
End Sub
Private Sub Text1_Click()
Label1 = LineNo(Text1.hwnd)
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
Label1 = LineNo(Text1.hwnd)
End Sub
205、当前操作系统的语言集
声明：
Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
例子：
Dim LocaleID As Long
LocalID = GetSystemDefaultLCID
= &H404 中文繁体（台湾）
= &H804 中文简体（大陆）
= &H409 英文 ...
206、如何算出 TextBox 的总行数？
在很多文字编辑器中，都可以告诉您，目前在编辑器中的文字总共有几行，我们也来实作一下！
有人问我说，要计算文字框中有多少行，只要将光标移到最后方 (Text1.SelLength=Len(Text1)),再使用前一个主题：问题180：如何算出 TextBox 中目前光标是在第几行？的模组就可以算出来了，没错！不过，二种方法都差不了多少，可以任君选择！
在 Form 中放入一个 TextBox 并将 Multiline 属性设为 True，放入一个 Label 用来显示目前 TextBox 中总共有几行，在表单声明区中加入以下声明及模组：
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Const EM_GETLINECOUNT = &HBA
Function LineCount(txthwnd As Long) As Long
On Local Error Resume Next
LineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)
LineCount = Format$(lineCount, "##,###")
End Function
'呼叫这个模组时要传入的是 TextBox 的 hwnd
'实际使用时，用法如下：
Private Sub Command1_Click()
Label1 = LineCount(Text1.hwnd)
End Sub
207、如何预先算出目前在 TextBox 中的资料存档后的文件大小？
之前在问题156: 如何取得文件大小？ 我们讨论过已存档文件大小的算法，但是在一笔新资料尚未存档前，我们其实也可以先算出它存档后文件会有多大！作法如下：
在 Form 中放入一个 TextBox 并将 Multiline 属性设为 True，放入一个 Label 用来显示目前 TextBox 中总共有几行，在表单声明区中加入以下声明及模组：
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const EM_GETLINECOUNT = &HBA
Const EM_LINEINDEX = &HBB
Const EM_LINELENGTH = &HC1
Function TextSize(txthwnd As Long) As Long
Dim lineCount As Long
Dim ChrsUpToLast As Long
Dim DocumentSize As Long
On Local Error Resume Next
'首先，算出 TextBox 的总行数
lineCount& = SendMessageLong(txthwnd, EM_GETLINECOUNT, 0&, 0&)
'接著 ，算出 TextBox 的位元组数
ChrsUpToLast& = SendMessageLong(txthwnd, EM_LINEINDEX, lineCount& - 1, 0&)
If ChrsUpToLast& = 0 Then
DocumentSize& = 0
ElseIf ChrsUpToLast& < 65000 Then
DocumentSize& = SendMessageLong(txthwnd, _
EM_LINELENGTH, ChrsUpToLast&, 0&) + ChrsUpToLast
End If
TextSize = Format$(DocumentSize&, "##,###")
End Function
'呼叫这个模组时要传入的是 TextBox 的 hwnd
'实际使用时，用法如下：
Private Sub Command1_Click()
Label1 = TextSize(Text1.hwnd)
End Sub
208、如何以桌面上的背景图来设定 Form 的背景？
这个功能是由网友 jimmy 所提供，它的功能就是将 User 桌面的图片直接拿来当作我们表单的背景图。
PaintDesktop API 只 要传入一个数值，就是表单的 hDC 属性值。
请直接将以下之程序码复制到表单中即可：
Private Declare Function PaintDesktop Lib "user32" (ByVal hDC As Long) As Long
Private Sub Form_Paint()
PaintDesktop Me.hDC
End Sub
注:
hDC 属性是 Windows 执行环境的周边设定内容物件代码。在 Windows 执行环境，系统透过给 Printer 物件和应用程序中每个表单和 PictureBox 控制项分配一个周边设定内容，来管理系统显示。可以用 hDC 属性参考物件的周边设定内容代码。这提供了一个传递给 Windows API 呼叫的值。
209、改变 ListIndex而不发生 Click 事件
在修改 Combo 或 Listview 的ListIndex 时， 会发生 Click 事件， 下面的函数可以阻止该事件。
声明：
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const CB_GETCURSEL = &H147
Const CB_SETCURSEL = &H14E
Const LB_SETCURSEL = &H186
Const LB_GETCURSEL = &H188
函数：
Public Function SetListIndex(lst As Control, ByVal NewIndex As Long) As Long
If TypeOf lst Is ListBox Then
Call SendMessage(lst.hWnd, LB_SETCURSEL, NewIndex, 0&)
SetListIndex = SendMessage(lst.hWnd, LB_GETCURSEL, NewIndex, 0&)
ElseIf TypeOf lst Is ComboBox Then
Call SendMessage(lst.hWnd, CB_SETCURSEL, NewIndex, 0&)
SetListIndex = SendMessage(lst.hWnd, CB_GETCURSEL, NewIndex, 0&)
End If
End Function
210、调整 Combo 下拉部分的宽度
声明：
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_ERR = -1
函数：
' 取得 Combo 下拉的宽度
' 可以利用该函数比例放大或缩小宽度
Public Function GetDropdownWidth(cboHwnd As Long) As Long
Dim lRetVal As Long
lRetVal = SendMessage(cboHwnd, CB_GETDROPPEDWIDTH, 0, 0)
If lRetVal <> CB_ERR Then
GetDropdownWidth = lRetVal
'单位为 pixels
Else
GetDropdownWidth = 0
End If
End Function
'设置 Combo 下拉的宽度
'单位为 pixels
Public Function SetDropdownWidth(cboHwnd As Long, NewWidthPixel As Long) As Boolean
Dim lRetVal As Long
lRetVal = SendMessage(cboHwnd, CB_SETDROPPEDWIDTH, NewWidthPixel, 0)
If lRetVal <> CB_ERR Then
SetDropdownWidth = True
Else
SetDropdownWidth = False
End If
End Function
004 把所有的字体名称放到 Combo 98-6-07
For I = 0 To Screen.FontCount - 1
cboFont.AddItem Screen.Fonts(I)
Next I
211、如何将短文件名格式转成长文件名？
虽然在 Windows95/98 中已经都可以使用长文件名/目录 (最长可以到255个字节)，但是在您将长文件名的文件或目录存文件时，系统同时给了它一个可以相容于以前 MS-DOS 时代的 8.3 格式的文件名称！
到目前为止，还是有些软件会使用 8.3 格式的文件名称，在安装这些软件时，它们写到注册文件中的资料，仍然采用 8.3 格式的文件名称，所以有时候，您在维护系统时，必须知道目前这些已经转成 8.3 格式的文件名称，原来的长文件名是什么。
在 问题：如何将长文件名转成短文件名格式 (MS-DOS 8.3) ，我们已经讲过长文件名转成短文件名，当时是使用 API 来做，过程上还蛮麻烦的，但是相反的，要从短文件名转成长文件名，过程却比较简单，也不需要用到 API，只要使用 Dir( ) 就可以了！
'请将以下的模组放到声明区中：
Public Function GetLongFilename(ByVal sShortName As String) As String
Dim sLongName As String
Dim sTemp As String
Dim iSlashPos As Integer
'在短文件名之后加上倒斜线 "\"，避免 Instr 造成错误
sShortName = sShortName & "\"
'略过磁盘代号，从第四码开始
iSlashPos = InStr(4, sShortName, "\")
'从文件名之第四码之后，一段一段处理在二个倒斜线 "\"之间的字串转换
While iSlashPos
sTemp = Dir(Left$(sShortName, iSlashPos - 1), vbNormal + vbHidden + vbSystem + vbDirectory)
If sTemp = "" Then 'Error 52 - Bad File Name or Number
GetLongFilename = ""
Exit Function
End If
sLongName = sLongName & "\" & sTemp
iSlashPos = InStr(iSlashPos + 1, sShortName, "\")
Wend
'将转换后的文件名加上原先略过的磁盘代号，变成完整的全路径文件名
GetLongFilename = Left$(sShortName, 2) & sLongName
End Function
'实际使用范例如下：
Private Sub Command1_Click()
'假设 C:\Program Files\Common Files 是一个正确的全路径文件名或目录
Print GetLongFilename("C:\PROGRA~1\COMMON~1")
End Sub
'结果就是 C:\Program Files\Common Files。
212、如何将桌面上的图标排列整齐？
您的或您的使用者的桌面是否有一大堆乱乱的图标，您可以使用 VB 来将这些图标排列整 ！
程序码如下：
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Const GW_CHILD = 5
Private Const LVA_ALIGNLEFT = &H1
Private Const LVM_ARRANGE = &H1016
Private Sub Command1_Click()
Dim hWnd1 As Long
Dim hWnd2 As Long
Dim Ret As Long
hWnd1 = FindWindow("Progman", vbNullString)
hWnd2 = GetWindow(hWnd1, GW_CHILD)
hWnd1 = GetWindow(hWnd2, GW_CHILD)
Ret = SendMessage(hWnd1, LVM_ARRANGE, 0, 0)
End Sub
执行完以上的程序码后，桌面上的所有图标便会自动的靠左对齐！
213、VB 的 SDI / MDI 开发环境切换
如果您使用过 Windows 应用程序，也许已经注意到并不是每个程序的使用者介面看上去都一样，也不见得同样的介面做的事就一样。使用者介面样式主要有两种：单一文件介面 (SDI) 和多重文件介面 (MDI)。SDI 介面的一个典型就是 Microsoft Windows 中的 WordPad 程序 (图 6.1)。在WordPad 中，使用者一次只能开启一个文件 (文件)，想要开启另一个文件时，就必须先关上已开启的文件。
像 Microsoft Excel 和 Microsoft Word for Windows 这样的应用程序，就是 MDI 介面；它们允许同时显示多个文件，每个文件都显示在自己的视窗中 (图 6.2)。从程序的「视窗」功能表 ，可以看出它是否为一个 MDI 应用程序。如果「视窗」功能表中含有已开启的文件清单，可以让使用者藉此来切换要显示或编辑的文件，这个程序就是一个 MDI 应用程序。
Visual Basic IDE 也有这两种不同的型态：单一文件介面 (SDI) 或多重文件介面 (MDI)。对 SDI 选项来说，只要 Visual Basic 是目前作用中的应用程序，则所有 IDE 视窗都可在屏幕上的任何地方自由移动，并且会保持在其它的应用程序之上；而对 MDI 选项来说，所有 IDE 视窗则都包含在一个可调整大小的父视窗内。
在 VB5 或 VB6 刚安装好时，预设的开发环境是多重文件介面 (MDI)，它最麻烦的地方是，当您的表单大小比较大时，或者您的表单是最大化时，您必须在 MDI 开发环境中使用卷动杆来移动表单，对设计者来说，不能一次看到表单的全貌，是相当不方便的，所以您需要将开发环境改成 SDI，但是要如何改呢？有的人找来找去，就是找不到从那里改，其实很简单，方法如下：
SDI 和 MDI 模式的切换 ：
1、在「工具」功能表中选取「选项」。 此时会显示「选项」对话方块。
2、再选取「进阶」页签。
3、核取或取消核取「SDI 开发环境」核取方块。
-或-
1、在指令行使用 /sdi 或 /mdi 参数来执行 Visual Basic。
设定好之后，不会马上生效！但是当您下次启动 Visual Basic 时，IDE 将以您选取的模式启动。
214、Combo的自动查询技术
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const CB_FINDSTRING = &H14C
Private Sub Combo1_Change()
Dim iStart As Integer
Dim sString As String
Static iLeftOff As Integer
iStart = 1
iStart = Combo1.SelStart
If iLeftOff <> 0 Then
Combo1.SelStart = iLeftOff
iStart = iLeftOff
End If
sString = CStr(Left(Combo1.Text, iStart))
Combo1.ListIndex = SendMessage(Combo1.hwnd, B_FINDSTRING, -1, ByVal CStr(Left(ombo1.Text, iStart)))
If Combo1.ListIndex = -1 Then
iLeftOff = Len(sString)
combo1.Text = sString
End If
Combo1.SelStart = iStart
iLeftOff = 0
End Sub
静态变量 iLeftOff 指定了字符长度。
215、如何改变 TreeView 的背景
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = -16&
Private Const TVM_SETBKCOLOR = 4381&
Private Const TVM_GETBKCOLOR = 4383&
Private Const TVS_HASLINES = 2&
Dim frmlastForm As Form
Private Sub Form_Load()
Dim nodX As Node
Set nodX = TreeView1.Nodes.Add(, , "R", "Root")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4")
nodX.EnsureVisible
TreeView1.style = tvwTreelinesText ' Style 4.
TreeView1.BorderStyle = vbFixedSingle
End Sub
Private Sub Command1_Click()
Dim lngStyle As Long
Call SendMessage(TreeView1.hWnd, TVM_SETBKCOLOR, 0, ByVal RGB(255, 0, 0))
'改变背景到红色
lngStyle = GetWindowLong(TreeView1.hWnd, GWL_STYLE)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle - TVS_HASLINES)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle)
End Sub
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
评论