298、如何设定 ListView 的标题列是立体或平面？
我想有些人看到今天的这个主题，心理头会想，ListView 的标题列是立体或平面，这有什么差别吗？
当然是有差别的！
我们都知道 ListView 的 View(查看模式) 有 4 种，如下：
0 lvwIcon 图标查看模式
1 lvwSmallIcon 小图标查看模式
2 lvwList 清单查看模式
3 lvwReport 详细资料查看模式 (有标题列)
而我们今天的主题是指 View 设定成 【3-lvwReport】，也就是【详细资料查看模式】。
在详细资料查看模式中，例如资源管理器，它的标题列是立体的，使用者的第一个直觉是，它可以排序！也就是只要在标题列上按一下，使用者就可以依这一个项目来正向排序或反向排序。但是，如果标题列是平面的话，使用者就不会认为它有排序的功能。
由于 ListView 的标题列预设是立体的，所以如果您放到 ListView 中的资料不需要排序，请在表单的声明区中加入以下声明及模组：
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
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 LVM_FIRST = &H1000
Private Const LVM_GETHEADER = (LVM_FIRST + 31)
Private Const HDS_BUTTONS = &H2
Private Sub ToggleHeader(lsvhWnd As Long)
Dim hHeader As Long, lStyle As Long
hHeader = SendMessage(lsvhWnd, LVM_GETHEADER, 0, ByVal 0&)
lStyle = GetWindowLong(hHeader, GWL_STYLE)
SetWindowLong hHeader, GWL_STYLE, lStyle Xor HDS_BUTTONS
End Sub
'使用的方序如下，在表单中加一个 ListView 物件：
Private Sub Form_Load()
Dim colX As ColumnHeader '声明变量。
Dim intX As Integer '计量器变量。
For intX = 1 To 4
Set colX = ListView1.ColumnHeaders.Add()
colX.Text = "Field " & intX
colX.Width = ListView1.Width / 4
Next intX
Call ToggleHeader(ListView1.hwnd) '设定标题列为平面
End Sub
299、如何快速成组更新控件属性？
Sub EnableAll(Enabled As Boolean, ParamArray objs() As Variant)
Dim obj As Variant
For Each obj In objs
obj.Enabled = Enabled
Next obj
End Sub
应用：
EnableAll True, Text1, Text2, Command1, Command2
300、如何检查您的电脑是否开启 ActiveDesktop？
在 IE4 及 IE5 中都有提供使用者选择是否安装 ActiveDeskTop 的功能，这个我们在 VB 中也可以侦测出来的！
首先，在表单声明区中声明以下二个 API Function：
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
接著，继续在表单声明区中加入以下模组：
Public Function ISActiveDesktop() As Boolean
Dim retVal As Long
retVal = FindWindow("Progman", vbNullString)
retVal = FindWindowEx(retVal, 0&, "SHELLDLL_DefView", vbNullString)
retVal = FindWindowEx(retVal, 0&, "Internet Explorer_Server", vbNullString)
If retVal > 0 Then
ISActiveDesktop = True
Else
ISActiveDesktop = False
End If
End Function
接著，在表单的 Form_Load 事件中加入以下程序码：
Private Sub Form_Load()
If ISActiveDesktop = True Then
MsgBox "您已启动 ActiveDesktop", 64, "检查 ActiveDesktop"
Else
MsgBox "您并没有使用 ActiveDesktop", 64, "检查 ActiveDesktop"
End If
End Sub
好了，现在您只要一启动程序，您就可以看到结果了！
301、如何使用 VB 撰写自动解除安装的程序？
一般软件在安装后，都会在【开始】菜单的【程序】中建立一个群组(Group)，并且在群组中建立一些执行程序的快捷方式，而在这些快捷方式中通常都会含有一个自动解除安装的快捷方式。
所以，如果您安装了某一个软件之后，想要解除安装，您有二个方法：
1、开启【控制面板】中的【添加/删除程序】，选择该项软件来解除安装。
2、选择【开始】【程序】中该系统所产生的群组中的解除安装的快捷方式来解除安装。
上面的第一种方法，您不需要作任何处理，一般软件在安装完后，都会在【控制面板】中的【添加/删除程序】多一个该软件的选项。而第二种方法，就必须要我们写程序来解决了！
假设，今天我们写了一支程序叫 Test，当您完成 Test.exe 之后，您必须再多写一支自动解除安装的程序，我们将文件名称设为 unTest.exe(先不要管如何写，后面会说明)。二支程序都完成后，您使用 VB 提供的应用程序安装精灵 (Application Setup Wizard) 来制作安装程序时，必须额外再加入 unTest.exe！
加入 unTest.exe 之后，使用者安装后，安装程序并不会在【开始】【程序集】中该系统所产生的群组【Test】中加入这个自动解除安装程序 unTest.exe 的快捷方式，安装程序只会将 unTest.exe 连同 Test.exe 一起复制到应用程序的目录中而已！所以如果您想产生 unTest.exe 的快捷方式，您可能需要稍微修改一下 VB 提供的应用程序安装精灵程序！
以下我们就实际来看看 unTest.exe 程序如何写：
在 VB 中建立一个新工程，取名为 unTest.vbp，表单为 unTest.frm，不需要任何控制项，在表单中加入以下程序码：
Private Declare Function GetWindowsDirectory Lib "kernel32" _
Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
On Error Goto BaddUn
Dim X&
Dim buffer As String * 128
Dim UnStr As String
Dim size As Integer
Dim retval As Integer
buffer = Space$(128)
size = 128
retval = GetWindowsDirectory(ByVal buffer, ByVal size)
Me.Caption = buffer
'以下的程序码必须写在同一行中 (如果在浏览器中有换行的话)
''''''''''''''''''''''''''''''''''''''''
UnStr = Me.Caption & "\ST5UNST.EXE -n " & Chr(34) & App.Path & "\ST5UNST.LOG" & Chr(34)
''''''''''''''''''''''''''''''''''''''''
'MsgBox UnStr '可显示可不显示, 只是测试用
'X& = Shell("C:\WINDOWS\ST5UNST.EXE -n "
' "C:\Program Files\App Name\ST5UNST.LOG""
' ", vbNormalFocus)
X& = Shell(UnStr, vbNormalFocus)
Unload Me
Exit Sub
BaddUn:
MsgBox "for some reason UnInstall can not run."
Exit Sub
End Sub
由以上的程序码中，您是否发现， unTest.exe 必须和 St5unst.log 放在同一个目录中，不过这只要和上面的程序一样使用 App.Path 就可以解决了！
注：这个范例是使用 VB5 来做测试的，如果是其他版本的 VB，ST5UNST.LOG 文件名可能必须改变！
302、如何叫用系统的【查找】、【替换】的问话框？
在一般的文书编辑软件中，例如 Windows 本身提供的记事本及小作家中，我们都可以在【编辑】下拉选单中，找到【查找】、【替换】二项功能，我想很多人自己在撰写编辑程序时，也都会自己写程序去模拟这二个相当基本的功能。其实根本不用您自己花时间去写这样的程序码！
还记得 Microsoft Common Dialog Control (16 位元文件是 Comdlg16.ocx，32 位元文件是 Comdlg32.ocx) 吗？我们都知道，这个控制项可以帮助我们做到以下几件事情：
1、ShowOpen：打开文件
2、ShowSave：存文件
3、ShowPrinter：设定打印机
4、ShowFont：设定字型
5、ShowColor：设定颜色
6、ShowHelp：开启说明文件
当然，您若还想要 Microsoft Common Dialog Control 多做一些别的事也没办法的！但是，Microsoft 在提供 .ocx 文件的同时，还提供了另外一个文件，也就是 comdlg32.dll，它的功能就多了，除了上面提到的几种问话框之外，还有好几个不同功能的问话框，其中就包含【查找】、【替换】二项功能！这二个 API 分别是 FindText 及 ReplaceText 二个。
在程序中，要声明这二个 API 之前，由於它们都会引用到一个名为 FINDREPLACE 的 Type，所以我们在声明 Function 之前，必须先声明 Type FINDREPLACE，程序码如下：
在表单的声明区中加入以下声明：
'Find/Replace Type Structure
Private Type FINDREPLACE
lStructSize As Long ' size of this struct 0x20
hwndOwner As Long ' handle to owner's window
hInstance As Long ' instance handle of.EXE that contains cust. dlg. template
flags As Long ' one or more of the FR_??
lpstrFindWhat As String ' ptr. to search string
lpstrReplaceWith As String ' ptr. to replace string
wFindWhatLen As Integer ' size of find buffer
wReplaceWithLen As Integer ' size of replace buffer
lCustData As Long ' data passed to hook fn.
lpfnHook As Long ' ptr. to hook fn. or NULL
lpTemplateName As String ' custom template name
End Type
'Common Dialog DLL Calls
Private Declare Function FindText Lib "comdlg32.dll" Alias "FindTextA" (pFindreplace As FINDREPLACE) As Long
Private Declare Function ReplaceText Lib "comdlg32.dll" Alias "ReplaceTextA" (pFindreplace As FINDREPLACE) As Long
'Delcaration of the type structure
Dim frText As FINDREPLACE
在表单中加入二个 Command Button，并命名为 cmdFind, cmdReplace，加入以下程序码：
Private Sub cmdFind_Click()
'Call the find text function
FindText frText
End Sub
Private Sub cmdReplace_Click()
'Call the replace text function
ReplaceText frText
End Sub
Private Sub Form_Load()
'Set the Find/Replace Type properties
With frText
.lpstrReplaceWith = "Replace Text"
.lpstrFindWhat = "Find Text"
.wFindWhatLen = 9
.wReplaceWithLen = 12
.hInstance = App.hInstance
.hwndOwner = Me.hWnd
.lStructSize = LenB(frText)
End With
End Sub
好了，您现在可以按 F5 试试了！
注：在 Type FINDREPLACE 中有一个 flag，您可以代入的 flag 是 FR_??，您可以在 API 检视员中找找！
303、如何隐藏及显示桌面上的图标？
当桌面上的图标太多时，看起来就会有一点点乱，而且，当您的桌面底图很漂亮时，这些图标还会遮住您漂亮的底图，有些软件有提供隐藏及显示桌面上的图标的功能，这个我们也可以做到！
在模组中加入以下声明：
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd As Long, ByVal hWndChild As Long, ByVal lpszClassName As String, ByVal lpszWindow As String) As Long
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
'-- Constants for ShowWindow()
Public Const SW_HIDE = 0
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
'-- Names of the shell window we'll be looking for
Public Const g_cstrShellViewWnd As String = "Progman"
在表单中加入二个 Command Button，并命名为 cmdHideDesktop, cmdShowDesktop，加入以下程式码：
Private Function FindShellWindow() As Long
Dim hWnd As Long
On Error Resume Next
hWnd = FindWindowEx(0&, 0&, g_cstrShellViewWnd, vbNullString)
If hWnd <> 0 Then
FindShellWindow = hWnd
End If
End Function
Private Sub HideShowWindow(ByVal hWnd As Long, Optional ByVal Hide As Boolean = False)
Dim lngShowCmd As Long
On Error Resume Next
If Hide = True Then
lngShowCmd = SW_HIDE
Else
lngShowCmd = SW_SHOW
End If
Call ShowWindow(hWnd, lngShowCmd)
End Sub
Private Sub cmdShowDesktop_Click()
Dim hWnd As Long
On Error Resume Next
'-- Find the window we're looking for and then hide it
hWnd = FindShellWindow()
If hWnd <> 0 Then
Call HideShowWindow(hWnd)
End If
End Sub
Private Sub cmdHideDesktop_Click()
Dim hWnd As Long
On Error Resume Next
hWnd = FindShellWindow()
If hWnd <> 0 Then
Call HideShowWindow(hWnd, True)
End If
End Sub
好了，您现在可以按 F5 试试了！
304、如何让数字正确的在 ListBox 及 ComboBox 中排序？
不知道各位有没有发现，ListBox 及 ComboBox 的 Sorted 属性在遇到数字后有点怪怪的，是有排序没错，但是它似乎将数字当作文字排序了！所以排出来的效果和我们真正想要的并不完全相同。其实这情形不只发生在 ListBox 及 ComboBox 而已，文件总管的文件排也有同样的情形，让我们来看看：
[FrontPage 保存结果 组件]
ListBox 及 ComboBox 的 Sorted 属性设为 True 我们真正想要的结果
1 11 123 2 32 1 2 11 32 123
'以下这个模组就是用来排序数字用的，得到的结果，就如同上方右边的结果！
Sub ReSort(L As Control)
Dim P%, PP%, C%, Pre$, S$, V&, NewPos%, CheckIt%
Dim TempL$, TempItemData&, S1$
For P = 0 To L.ListCount - 1
S = L.List(P)
For C = 1 To Len(S)
V = Val(Mid$(S, C))
If V > 0 Then Exit For
Next
If V > 0 Then
If C > 1 Then Pre = Left$(S, C - 1)
NewPos = -1
For PP = P + 1 To L.ListCount - 1
CheckIt = False
S1 = L.List(PP)
If Pre <> "" Then
If InStr(S1, Pre) = 1 Then CheckIt = True
Else
If Val(S1) > 0 Then CheckIt = True
End If
If CheckIt Then
If Val(Mid$(S1, C)) < V Then NewPos = PP
Else
Exit For
End If
Next
If NewPos > -1 Then
TempL = L.List(P)
TempItemData = L.ItemData(P)
L.RemoveItem (P)
L.AddItem TempL, NewPos
L.ItemData(L.NewIndex) = TempItemData
P = P - 1
End If
End If
Next
End Sub
'实际使用时，需导入控制项的名称，例如：
Private Sub Command1_Click()
Call ReSort(List1)
End Sub
305、如何从 Internet 上抓回某一个网页的内容？
常在讨论区中发现有人问这个问题，我搞不懂，这有什么特别的目的或意义？直接使用浏览器不就好了吗？
不过，要用 VB 来做也不难，只要使用 Internet Transfer Control 就可以了！
开启一个新工程，加入一个 Internet Transfer Control、一个 CommandButton 及二个 TextBox！
Text1 用来输入要抓取的网页位址，例如：http://www.microsoft.com/taiwan/support/products/vb.htm
Text2 用来输入要存文件的完整文件名，例如：c:\temp\temp.htm
Private Sub Command1_Click()
Dim b() As Byte
'取消所有动作
Inet1.Cancel
'设定通讯协定为 HTTP
Inet1.Protocol = icHTTP
'设定 URL 属性
Inet1.URL = Text1.Text
'将读取的 HTML 资料放进一个 byte array.
b() = Inet1.OpenURL(, icByteArray)
'建立一个暂存文件来存放抓回来的 html 文件
Open Text2.text For Binary Access Write As #1
Put #1, , b()
Close #1
End Sub
好了，就是这么简单，试看看吧！
306、如何得知某一台网络打印机尚有几份等待打印的报表？
当我们要打印报表时，如果打印机是本机的打印机的话，当然马上就会将报表打印出来，反正打印机就只有您一个人在使用而已！但是如果是在一个人数很多的公司或企业时，往往就必须很多人来分享某一部打印机了，而且打印机也不一定就放在举目可及之处！
当您将报表丢到网络打印机之后，由于不一定看得到打印机，您必须特别到摆放打印机的地方去拿报表，这时候您最关心的，就是报表印了没有，如果还没有的话，那还有几份还没打印的报表排在您的报表之前呢？
下面这一段程序，可以让您知道某一台网络打印机尚有几份等待打印的报表？在您的程序丢出报表的同时，您可以告诉您的 User，他的报表排在第几份！
'在 .bas 文件中加入以下声明及模组：
'Constants Definition
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
'Types Definition
Public Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As DEVMODE
DesiredAccess As Long
End Type
'API Declarations
Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
Public Declare Function EnumJobs Lib "winspool.drv" Alias "EnumJobsA" (ByVal HPrinter As Long, ByVal FirstJob As Long, ByVal NoJobs As Long, ByVal Level As Long, pJob As Byte, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'取得指定的打印机，目前有多少 Jobs (最大值为 128)
'打印机的名称可以是 mapping 的网络路径名称，例如： "\\myserver\myprinter"
Function GetPrinterQueue(PrinterName As String) As Long
Dim PrinterStruct As PRINTER_DEFAULTS
Dim HPrinter As Long
Dim ret As Boolean
Dim JobStruct(0 To 127) As Byte
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim TempByte As Byte
'设定 Printer structure 初值
PrinterStruct.pDatatype = vbNullString
PrinterStruct.pDevMode.dmSize = Len(PrinterStruct.pDevMode)
PrinterStruct.DesiredAccess = PRINTER_ACCESS_USE
'取得打印机的 Handle
ret = OpenPrinter(PrinterName, HPrinter, PrinterStruct)
'取得打印机的 active jobs
ret = EnumJobs(HPrinter, 0, 127, 1, TempByte, 0, pcbNeeded, pcReturned)
If pcbNeeded = 0 Then
GetPrinterQueue = 0
Else
ret = EnumJobs(HPrinter, 0, 127, 1, JobStruct(0), pcbNeeded, pcbNeeded, pcReturned)
GetPrinterQueue = pcReturned
End If
'关闭打印机
ret = CloseHandle(HPrinter)
End Function
'在表单中放一个 CommandButton，程序码如下：
Private Sub Command1_Click()
'测试预设打印机的 Queue (Printer.DeviceName)
Msgbox "打印机中尚有 " & GetPrinterQueue(Printer.DeviceName) & " 份报表", 64, "讯息"
End Sub
'好了，试试看吧！
307、如何每天下载 Internet 上某一个网页中的图片来更换桌面的图案？
有些处理图片的软件，尤其是可以处理桌面图片的软件，会提供您每天自动到 Internet 上的某一个网址，去下载它的网站所提供，每天更换的图片，来更改桌面的底图，这是一个很炫的功能，而我们用 VB 也可以很容易的做到这样的功能，您相信吗？
这个主题会运用到之前我们提过的几个功能：
问题: 如何让程序在 Windows 启动时自动执行？
问题: 如何从 Internet 上下载某一个网页的内容？
问题: 如何移除或更改桌面背景的底色图案 (Wallpaper)？
让我们直接来练习吧！
'请在 .BAS 中加入以下声明：
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
Const SPIF_SENDWININICHANGE = &H2
'请在表单中放入一个 TextBox 及一个 Internet Transfer Control
Private Sub Form_Load()
Dim Pos As Integer
Dim Pos2 As Integer
Dim Bilden() As Byte
Dim NrString As String
Text1.Text = Inet1.OpenURL("http://www.vbeden.com/") 'Download the page.
Pos = InStr(1, Text1.Text, "/preblem/61-80")
Pos2 = InStr(Pos, Text1.Text, ".gif")
NrString = Mid(Text1.Text, Pos, Pos2 - Pos)
Text1.Text = "http://www.vbeden.com" + NrString + ".gif" ' Debug filename
Bilden() = Inet1.OpenURL("http://www.vbeden.com" + NrString + ".gif", icByteArray) ' Download picture.
Open "C:\dilbert.gif" For Binary Access Write As #1 ' Save the file.
Put #1, , Bilden()
Close #1
Picture1.Picture = LoadPicture("c:\dilbert.gif") 'Reload it To PictureBox
SavePicture Picture1.Picture, "c:\dilbert.bmp" 'Converted To bmp..
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:\dilbert.bmp", SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) 'Change the wallpaper.
Unload Me ' Exit program
End Sub
至于其中的网址及图片的文件名，请自行更改。若是您直接使用以上的程序码的话，也可以，您每天都可以看到一篇漫画 !!
308、如何呼叫系统的控制面板？
在 Windows 的系统中，从很多地方，您有很多方式去叫出系统的控制面板，例如从【我的电脑】、【资源管理器】或是【开始】功能表中的【设置】选项中都可以看到控制面板。
使用 VB 您也可以在程序中叫出控制面板来使用！而且程序码很简单，只要一行就可以了，如下：
Private Sub Command1_Click()
Shell "rundll32.exe shell32.dll,Control_RunDLL", vbNormalFocus
End Sub
上面的程序码，不管您是使用 Windows 95/98/NT 都可以适用的！
309、如何完全模拟系统的控制面板？
在上一个主题：如何呼叫系统的控制面板？中，我们告诉您如何直接叫用系统的控制面板，但是，如果您只是想要叫用控制面板中的某一个单一功能设定画面的话，您也可以做到的！
其实，控制面板的那么多的功能，是分别叫用您电脑中的一些扩展文件名为 .CPL 的文件，这些文件在 Windows 95/98/NT 中存放的位置有一些不同，分别说明如下：
Windows 95/98：文件位置在 c:\windows\system
Windows NT：文件位置在 c:\winnt\system32
下面的程序码以 Windows98 为例来说明，如果您是在 Windows NT 中，请自行稍微修改。在表单上放一个 CommandButton 及一个 FileListBox，程序码如下：
Private Sub Form_Load()
File1.Pattern = "*.CPL"
File1.FileName = "C:\WINdows\SYSTEM" '若是 NT 的话请改这里
End Sub
Private Sub Command1_Click()
Shell "rundll32.exe shell32.dll,Control_RunDLL " & File1.FileName, vbNormalFocus
End Sub
好了，别惊讶，程序码就是这么短而已！请先在 FileListBox 中选择一个文件，每一个文件分别代表控制面板中的某一个功能设定程序，然后按下 Command1 就可以执行了！
310、如何设定 MsgBox 在若干时间之后若无回应则自动关闭？
在我们的印象中，VB 所提供的 MsgBox 是一个强制回应的视窗，您一定要按了其中的某一个 CommandButton 之后，它才会关闭！但是在某些软体中，我们会看到，明明是使用系统的 MsgBox，可是您如果不理它，几秒钟之后，它就自行关闭了！别人是如何做到的呢？这个问题偶而会出现在讨论区中，有的人会回答：
只要自己做一个类似 MsgBox 的视窗，就可以自己用 Timer 来控制这个视窗何时要关闭了！
但是，其实不用这么麻烦的，只要使用系统的 MsgBox 再加一个 Timer 就可以控制了！
我们都知道 MsgBox 可以设定成很多不同的样子，可以有很多不同的图示，不同的按钮，其中控制按钮的部份，可以设定的常数如下：
常数 值 说明
vbOKOnly 0 只显示 OK 按钮。
VbOKCancel 1 显示 OK 及 Cancel 按钮。
VbAbortRetryIgnore 2 显示 Abort、 Retry 及 Ignore 按钮。
VbYesNoCancel 3 显示 Yes、No 及 Cancel 按钮。
VbYesNo 4 显示 Yes 及 No 按钮。
VbRetryCancel 5 显示 Retry 及 Cancel 按钮。
为什么要特别提到 MsgBox 的常数呢？因为下面我们要告诉您的方法，还是有一点点限制的！当您设定的常数是 VbAbortRetryIgnore 或 VbYesNo 时，下面的方法也是没用的！
'在表单的声明区中加入以下的声明
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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
Private Const WM_CLOSE = &H10
Private Const MsgTitle As String = "Test Message"
'在表单中加入一个 CommandButton 及一个 Timer 控制项，加入以下程序码：
Private Sub Command1_Click()
Dim nRet As Long
Timer1.Interval = 3000
Timer1.Enabled = True
nRet = MsgBox("若您不回应的话，3 秒后此 MsgBox 会自动关闭", 64, MsgTitle)
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
Dim hWnd As Long
hWnd = FindWindow(vbNullString, MsgTitle)
Call SendMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
End Sub
好了，很简单吧！您执行程序时，当 MsgBox 出现 3 秒之后，就会自动关闭了！
注意：此方法的限制说明：
1、当常数设定为 VbAbortRetryIgnore 或 VbYesNo 时，无效！
2、在 Design Time 时，无效，必须 Make EXE 之后才有效！
评论