社区楼梯文化墙图片:如何去优化你的VB程

1、如何去优化你的VB程序Visual Basic 作为一种高级编程语言，它也有着不可避免的缺点---开发出的应用程序运行速度慢。如果我们能够程序做一些优化，那么情况将会大大改善。要优化程序运行的实际速度，常用的方法有三种：1.尽量避免使用 Variant 变量。由于VB不能确定 Variant 变量的具体类型，所以它会给该类型变量分配16个字节的空间，而且在用变量进行运算时还要考虑到数据类型的转换。这既占用内存，又影响了速度，会使涉及到复杂运算的程序慢。注意，一个变量的缺省类型就是 Variant，其它类型的变量要用Dim语句单独声明。2.在遇到整型数据时尽量使用Long变量。因为Long变量是32位CPU的本机数据类型，所以处理速度会很快，尤其是在循环体中。3.将控件的常用属性保存在变量中。一般控件存在于DLL或OCX这类的外部程序中。众所周知，调用DLL远比访问内存慢。所以对于那些放在循环体中的常用属性，如果将它们保存在变量中，那么速度将会有成百上千倍提升。我们在编写程序时应注意到，在进行长时间等待操作时，可以做一些动画之类的效果，好让用户知道程序运行正常。下面是几个常用优化方法：（1）使用 Splash 屏幕。也就是我们常见的欢迎窗口。大的应用程序在启动时，往往会主动或被动地载入一大堆DLL，这要花费很长时间。所以我们在启动时可以先显示一个简单的窗口，上面只放一些作者、版权之类的信息，在这个窗口的Form_Load事件中用Load方法读入那些最常用的窗体模块。这样，虽然实际等待的时间延长了，但用户所看到的屏幕总是变化的，所以感觉下程序启动加快了。而且由于常用窗体模块事先已载入内存，以后只需用Show方法来显示它，跳过了载入过程，在程序运行过程中也会很快的。（2）使用Timer控件。由于Timer控件的出现，使得后台作业有了可能。我们可以在每次Timer事件中完成一小部分任务。这样，由于Timer中的事件能够在很短的时间内完成，用户一般查觉不到速度的变化。如果一定要在一个循环内完成某个任务，那么不要忘了用DoEvents来释放用户。（3）使用进度条。要使用进度条，需要事先知道数据量，所以它很适合用于对已知数据的操作，如数据库的排序。总之，优化程序要从自己、从用户等多方面考虑，使程序开发周期短，且高效易用。2、在VB中如何创建闪烁(标语)屏大型应用系统启动运行的时间需要很长时间,其时间会根据需要初始化的数量和用户系统的速度变化,因此在主窗口显示前,应显示一个初始化窗口,使应用程序看起来更具吸引力,因为当装载程序时不断可以向用户显示一些信息，而且可产生美观的视觉效果。例如vb、delphi在启动时均在主界面前显示一splash窗口.---- 1. 下面是显示闪烁(标语)屏splash的一种简单方法:option explicitprivate sub form_load()‘显示主窗口me.show‘显示splash窗口frmsplash.showdoevents‘执行应用程序初始化initialize‘关闭splash窗口unload spalshend sub---- 该过程代码应放在应用程序的启动窗体中。第一个show方法可使windows在屏幕上显示主窗体，下一个show方法显示闪烁屏，它是你设计的名为frmsplash的窗体.在利用show方法之后，再利用Doevents函数，以确保闪烁屏窗体的所有元数立即绘制完。Initialize函数执行应用程序在启动时需要执行的费时任务，例如，从文件中装载数据，将窗体装入内存等等。这时一切都准备就绪.---- 2.闪烁窗体模板---- Visual Basic 中含有许多摸板窗体，其中之一是闪烁屏。要为项目添加Splash screen 窗体，需要从project菜单中选择Add Form.在Add Form 对话框的New标签上选择Splash Screen图标，并单击Open.这样Splash Screen窗体就被添加到项目中.---- 下列代码显示了如何定制Splash Screen 窗体摸板的实例:option explicitprivate sub form_load()frmsplash.lbllicenseto=app.legaltrademarksfrmsplash.lblcompanyproduct=app.productnamefrmsplash.lblplatform="window 98"frmsplash.lblcopyright=app.legalcopyrightfrmsplash.lblcompany=app.companynamefrmsplash.lblwarning="Warning:this program is protected" & _"by copyright law,so don‘t copy "frmsplash.showdoeventsinitializeunload frmsplashend sub---- 注意这里使用了app对象，该对象可以访问有关你的应用程序的信息;---- splash screen 窗体摸板代码模块的代码如下所示:Private Sub Form_keypress(keyascii as integer)unload meEnd subPrivate sub form_load()lblversion.caption="version"&app.major&"."app.minor"."app.revisionlblproductname.caption=app.titleend subprivate sub frame1_click()unload meEnd Sub3、如何用VB建立快捷方式Private Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As LongSub Command1_Click()Dim lReturn As Long‘添加到桌面lReturn = fCreateShellLink("..\..\Desktop", "Shortcut to Calculator", "c:\windows\calc.exe", "")‘添加到程序组lReturn = fCreateShellLink("", "Shortcut to Calculator", "c:\windows\calc.exe", "")‘添加到启动组lReturn = fCreateShellLink("\Startup", "Shortcut to Calculator", "c:\windows\calc.exe", "")End Sub4、如何在VB中判断Windows9x的运行模式在Windows下编程，经常发现有不少功能Windows系统已经做了，如果能够直接调用，就可省去不少程序的编写，并能提高程序的运行效率。在很多情况下，我们都可以用“Ctrl ＋ X”、“Ctrl ＋ C”、 “Ctrl ＋ V”和“Ctrl ＋ Z”分别进行“剪切”、“复制”、“粘贴”和“撤消”操作，由此想到，如果我们能够在程序中调用系统的这些功能，就无需为如何实现这些操作而操心了。经过不断的探索，终于发现SendMessage和PostMessage能够担此重任，真是如获至宝，于是迫不及待地把它们介绍给各位朋友。　　用VB5的“API浏览器”可以很容易地找到这两个API 函数：Declare Function SendMessage Lib “user32” Alias “SendMessageA” _(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _lParam As Any) As LongDeclare Function PostMessage Lib “user32” Alias “PostMessageA” _(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ByVal lParam As Long) As Long　　这两个函数的功能几乎是一样的，只是SendMessage是直接调用Windows函数来发送消息，只有这个消息完全被处理后此函数才返回，而PostMessage则给窗体的消息队列增加一个消息，这个消息将在未来某个时候进行正常事件处理时得到处理。以下仅以SendMessage为例。　　函数中虽然有四个参数，但关键的是前两个：hwnd 和wMsg。Hwnd是句柄，Microsoft Windows应用程序中的每个窗体和控件都拥有一个句柄，通过句柄可以指明函数的操作对象；wMsg是一个十六进制数，代表了函数要发送的具体消息。　　下面以具体例子说明如何用SendMessage实现“剪切”、“复制”、“粘贴”、“撤消” 和“删除”功能:　　在窗体中放置一个文本框Text1和五个按钮，分别执行以上五种功能，编写以下程序。Option ExplicitPrivate 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 WM_CUT = ＆H300　　Const WM_COPY = ＆H301　　Const WM_PAST = ＆H302　　Const WM_CLEAR = ＆H303　　Const WM_UNDO = ＆H304　　Dim fb As Long　　　　Private Sub cmdClear_Click()　　 fb = PostMessage(Text1.hwnd, WM_CLEAR, 0, 0)　　End Sub　　Private Sub cmdCopy_Click()　　 fb = SendMessage(Text1.hwnd, WM_COPY, 0, 0)　　End Sub　　Private Sub cmdCut_Click()　　 fb = SendMessage(Text1.hwnd, WM_CUT, 0, 0)　　End Sub　　Private Sub cmdPast_Click()　　 fb=SendMessage(Text1.hwnd, WM_PAST, 0, 0)　　End Sub　　Private Sub cmdUndo_Click()　　 fb=SendMessage(Text1.hwnd, WM_UNDO, 0, 0)　　End Sub　　除了TextBox外SendMessage 还可以对RitchTextBox和ComboBox等进行操作,只要相应改变hwnd参数即可。5、如何在Windows操作系统中改变文件打开方式在Windows 95／NT／98操作系统中改变文件打开方式的问题，又可称为改变文件类型关联的问题，即把某类型（扩展名）的文件与某应用程序关联，例如通常当双击＊.txt文件时系统自动调用Notepad.exe。本文介绍利用Windows注册表编辑器Regedit.exe手工或编程改变文件打开方式的方法，并提供程序实例。　　一、基本思路：　　1、注册表编辑器Regedit.exe是用于更改系统注册表设置的高级工具，包含了关于系统配置及运行的重要信息，默认访问路径为C:\Windows\Regedit.exe。双击Regedit.exe图标，运行注册表编辑器。在左侧显示栏内看到HKEY_CLASSES_ROOT、KEY_CURRENT_USER、HKEY_LOCAL_MACHINE等主键。与文件类型有关的所有主键、键名、键值都存放在HKEY_CLASSES_ROOT下。　　◆双击HKEY_CLASSES_ROOT，向下拖动滚动条，找到.txt主键，右侧显示栏内“txtfile”说明：在HKEY_CLASSES_ROOT下有一txtfile主键，其下存放了打开＊.txt文件应用程序的有关信息。　　◆向下拖动滚动条，找到txtfile主键，右侧显示栏内“文本文档”为文件类型描述。双击txtfile，DefaultIcon右侧显示栏内“shell32.dll,－152”为＊.txt文件的图标；shell\open\command，右侧显示栏内“C:\WINDOWS\NOTEPAD.EXE ％1”为打开＊.txt文件的应用程序名称及参数。　　改变打开文件方式的方法（例如用VISIO打开＊.exc文件）：　　◆手工：打开系统注册表，在HKEY_CLASSES_ROOT下找到.exc及另一主键名，找到此主键，将shell\open\command右侧显示栏内“C:\WINDOWS\NOTEPAD.EXE ％1”改为“C:\VISIO.EXE ％1”（假设VISIO.EXE的访问路径是C:\，具体视情况而定），按F5刷新系统注册表。　　◆编程：利用VB、Delphi、C＋＋Builder等读写系统注册表，可自动改变文件打开方式。本文提供VB、Delphi编程实例。　　二、编程实例：　　㈠利用VB编程　　1、在VB5.0 IDE中，新建工程Project1，在Form1上添加命令按钮Command1。　　2、选择菜单“工程”—“添加模块”—“模块”—“打开”，在Project1中添加模块Moudle1。　　3、在Moudle1“通用—声明”部分声明API函数和常量。　　Const REG_SZ = 1　　Global Const HKEY_CLASSES_ROOT = ＆H80000000Declare Function OSRegQueryValueEx Lib “advapi32”Alias “RegQueryValueExA”(ByVal hKey As Long, ByVal lpszValueName As String,ByVal dwReserved As Long, lpdwType As Long, lpbData As Any, cbData As Long) As LongDeclare Function OSRegOpenKey Lib “advapi32”Alias “RegOpenKeyA”(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As LongDeclare Function OSRegSetValueEx Lib“advapi32”Alias “RegSetValueExA”（ByVal hKey As Long, ByVal lpszValueName As String,ByVal dwReserved As Long, ByVal fdwType As Long, lpbData As Any, ByVal cbData As Long) As LongDeclare Function OSRegCloseKey Lib“advapi32”Alias “RegCloseKey”(ByVal hKey As Long) As Long　　4、在Moudle 1中编写函数。　　Function RegOpenKey(ByVal hKey As Long, ByVal lpszSubKey As String,phkResult As Long) As Boolean　　 Dim lResult As Long　　 On Error GoTo 0 ` 关闭错误陷阱　　 lResult = OSRegOpenKey(hKey, lpszSubKey, phkResult)　　 If lResult = 0 Then　　 RegOpenKey = True　　 Else　　 RegOpenKey = False　　 End If　　End Function　　Function RegSetStringValue(ByVal hKey As Long, ByVal strValueName As String,ByVal strData As String, Optional ByVal fLog) As Boolean　　 Dim lResult As Long　　 On Error GoTo 0　　 lResult = OSRegSetValueEx(hKey, strValueName, 0＆, REG_SZ, ByVal strData,LenB(StrConv(strData, vbFromUnicode)) ＋ 1)　　 If lResult = 0 Then　　 RegSetStringValue = True　　 Else　　 RegSetStringValue = False　　 End If　　End Function　　Function StripTerminator(ByVal strString As String) As String　　 Dim intZeroPos As Integer　　 intZeroPos = InStr(strString, Chr＄(0))　　 If intZeroPos > 0 Then　　StripTerminator=Left＄(strString, intZeroPos － 1)　　 Else　　 StripTerminator = strString　　 End If　　End Function　　Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String,strData As String) As Boolean　　 Dim lResult As Long　　 Dim lValueType As Long　　 Dim strBuf As String　　 Dim lDataBufSize As Long　　 RegQueryStringValue = False　　 On Error GoTo 0　　 lResult = OSRegQueryValueEx(hKey, strValueName, 0＆, lValueType, ByVal 0＆,lDataBufSize)　　 If lResult = ERROR_SUCCESS Then　　 If lValueType = REG_SZ Then　　 strBuf = String(lDataBufSize, “”)　　 lResult = OSRegQueryValueEx(hKey, strValueName, 0＆, 0＆, ByVal strBuf,lDataBufSize)　　 If lResult = ERROR_SUCCESS Then　　 RegQueryStringValue = True　　 strData = StripTerminator(strBuf)　　 End If　　 End If　　 End If　　End Function　　5、双击Command1，编写Click事件代码。　　Private Sub Command1_Click()　　 Dim hKey As Long　　 Dim MyReturn As Long　　 Dim MyData As String　　 MyReturn = OSRegOpenKey(HKEY_CLASSES_ROOT, “.exc”, hKey)　　MyReturn=RegQueryStringValue(hKey,“”,MyData)　　MyReturn=OSRegOpenKey(HKEY_CLASSES_ROOT, MyData＋“\shell\open\command”,hKey)　　 MyReturn = RegSetStringValue(hKey,“”,“c:\visio.exe 1％”, False)　　 If MyReturn Then　　 MsgBox “改变文件打开方式成功！”,vbInformation,“请注意”　　 Else　　 MsgBox “改变文件打开方式失败！”,vbExclamation,“请注意”　　 End If　　 OSRegCloseKey (hKey)　　End Sub　　6、按F5运行程序，在简体中文Windows95／NT／98、VB5.0／6.0环境中调试通过。　　㈡利用Delphi编程　　1、在Delphi3.0 IDE中，新建工程Project1，在Form1上添加按钮Button1。　　2、在uses子句中添加Registry。　　3、双击Button1，编写Click事件代码。　　procedure TForm1.Button1Click(Sender: Tobject);　　var　　 MyRegistry : TRegINIFile;　　 Return:string;　　begin　　 try　　 MyRegistry := TRegINIFile.Create(``);　　MyRegistry.RootKey := HKEY_CLASSES_ROOT;　　 Return:=MyRegistry.ReadString (`.gid`,``,`No! Not Found the Key!`);　　 MyRegistry.WriteString(Return,``,`这只是一个演示！`);　　 MyRegistry.WriteString(Return＋`\DefaultIcon`,``,`c:\visio.exe,1`);　　 MyRegistry.WriteString(Return＋`\shell\open\command`,``,`c:\visio.exe ％1`);　　 finally　　 MyRegistry.Free;　　 end;　　 ShowMessage(`改变文件打开方式成功！`);　　end;　　4、按F9运行程序，在简体中文Windows95／NT／98、Delphi3.0／4.0环境中调试通过。6、用VB开发应用程序如何使用INI文件为了方便用户使用和使系统具有灵活性，大多数Win-dows应用程序将用户所做的选择以及各种变化的系统信息记录在初始化(INI)文件中。因此，当系统的环境发生变化时，可以直接修改INI文件，而无需修改程序。由此可见，INI文件对系统功能是至关重要的。本文将介绍采用VisualBasicforWindows(下称VB)开发Windows应用程序时如何读写INI文件。INI文件是文本文件，由若干部分(section)组成，在每个带括号的标题下面，是若干个以单个单词开头的关键词(keyword)和一个等号，每个关键词会控制应用程序某个功能的工作方式，等号右边的值(value)指定关键词的操作方式。其一般形式如下:[section1]keyword1=valuelkeyword2=value2……[section2]keyword1=value1keyword2=value2……其中，如果等号右边无任何内容(即value为空)，那就表示Windows应用程序已为该关键词指定了缺省值，如果在整个文件中找不到某个关键词(或整个一部分)，那同样表示为它们指定了缺省值。各个部分所出现的顺序是无关紧要的，在每一个部分里，各个关键词的顺序同样也无关紧要。读写INI文件通常有两种方式:一是在Windows中用"记事本"(Notepad)对其进行编辑，比较简单，无需赘述;二是由Windows应用程序读写INI文件，通常是应用程序运行时读取INI文件中的信息，退出应用程序时保存用户对运行环境的某些修改。关键词的值的类型多为字符串或整数型，应分两种情况读写。为了使程序具有可维护性和可移植性，最好把对INI文件的读写封装在一个模块(RWINI.BAS)中，在RWI-NI.BAS中构造GetIniS和GetIniN函数以及SetIniS和Se-tIniN过程，在这些函数和过程中需要使用WindowsAPI的"GetPrivateprofileString"、"GetPrivateProfileInt"和"WritePrivateProfileString"函数。RWINI.BAS模块的程序代码如下:在General-Declearation部分中声明使用到的WindowsAPI函数:Declare Function GetprivateprofileString Lib"Ker-nel"(ByVallpAppName As String，ByVallpKeyName As String，ByVallpDefault As String，ByVal lpRetrm-String As String，ByVal cbReturnString As Integer，ByVal Filename As String)As IntegerDeclare FunctionGetPrivatePfileInt Lib "Kernel"(ByVal lpAppName As String，ByVal lpKeyName As String，ByVal lpDefault As Integer，ByVal Filename As String)As IntegerDeclare FuncitonWritePrivateprofileString Lib "Kernel"(ByVal lpApplicationName As String，ByVal lpKeyName As String，ByVal lpString As String，ByVal lplFileName As String)As IntegerFunction GetIniS(ByVal SectionName As String，ByVal KeyWord As String，ByVal DefString As String)As StringDim ResultString As String * 144，Temp As IntegerDims As String，i As IntegerTemp%=GetPrivateProfileString(SectionName，KeyWord，""，ResultString，144，AppProfileName())‘检索关键词的值IfTemp%＞0Then‘关键词的值不为空s=""Fori=1To144IfAsc(Mid$(ResultString，I，1))=0ThenExitForElses=s&Mid$(ResultString，I，1)EndIfNextElseTemp%=WritePrivateProfilesString(sectionname，KeyWord，DefString，ppProfileName())‘将缺省值写入INI文件s=DefStringEndIfGetIniS=sEndFunctionFunctionGetIniN(ByValSectionNameAsString，ByValKeyWordAsString，ByValDefValueAsIneger)AsIntegerDimdAsLong，sAsStringd=DefValueGetIniN=GetPrivateProfileInt(SectionName，KeyWord，DefValue，ppProfileName())Ifd＜＞DefValueThens=""&dd=WritePrivateProfileString(SectionName，KeyWord，s，AppProfileName())EndIfEndFunctionSubSetIniS(ByValSectionNameAsString，BtVaKeyWordAsString，ByValValStrAsString)Dimres%res%=WritePrivateprofileString(SectionName，KeyWord，ValStr，AppProfileName())EndSubSubSetIniN(ByValSectionNameAsString，ByValKeyWordAsString，ByValValIntAsInteger)Dimres%，s$s$=Str$(ValInt)res%=WriteprivateProfileString(SectionName，KeyWord，s$，AppProfileName())EndSubSectionName为每一部分的标题，KeyWord为关键词，GetIniS和GetIniN中的DefValue为关键词的缺省值，SetIniS和SetIniN的ValStr和ValInt为要写入INI文件的关键词的值。为了能更好地说明如何使用以上函数和过程，下面举两个实例。实例1:开发应用程序通常要使用数据库和其它一些文件，这些文件的目录(包括路径和文件名)不应在程序中固定，而是保存在INI文件中，程序运行时由INI文件中读入。读入数据库文件的代码如下:DimDatabasenameAsStringDatabasename=GetIniS("数据库"，"职工"，"")IfDatabaseName=""ThenDatabaseName=InputBox("请输入数据库《职工》的目录")，App.Title)’也可通过"文件对话框"进行选择OnErrorResumeNextSetdb=OpenDatabas(DatabaseName)IfErr＜＞0ThenMsgBox"打开数据库失败!"，MB-ICONSTOP，App.Title:GotoErrorProcessingElseSetIniS"数据库"，"职工"，DatabaseNameEndIfOnErrorGoTo0……实例2:为了方便用户操作，有时需要保存用户界面的某些信息，例如窗口的高度和宽度等。装载窗体时，从INI文件中读入窗体高度和宽度，卸载窗体时将窗体当前高度和宽度存入INI文件，代码如下:Sub Form1_Load()……Forml.Height=GetIniN("窗体1"，"高度"，6000)Form1.Width=GetIniN("窗体1"，"高度"，4500)EndSub……Sub Form1_Unload()……SetIniN"窗体1"，"高度"，Me.HeightSetIniN"窗体1，"宽度"，Me.Width……End Sub7、程序中如何启动默认的拨号连接随着因特网的迅猛发展，现在编程常需要在程序中直接联网来处理一些事项，如在线注册和在线帮助，这就要求我们要在程序中建立某些连接。很多软件在不知用户是否联网的情况下不管三七二十一就启动浏览器查找网址，费了九牛二虎之力只能查出一错误页来（当然不可能有什么好的结果）。如果我们在程序编写时能自动判断用户是否已经联网，如已经联网则打开联接，如没有则启动默认的拨号连接，这样是不是让人觉得你的软件更胜人一处呢？判断是否已联网很多地方都有介绍，这里我们只介绍如何启动默认的拨号连接。---- 在介绍之前让我们首先看看如何打开拨号网络。由于拨号网络不是一个可执行文件，所以不能用 “Shell 可执行文件”的方式来打开。要启动拨号网络，需借助 Explorer ，方法如下：Shell "Explorer ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\" & "::{992CFFA0-F557-101A-88EC-00DD010CCC48}", vbNormalFocus---- 但若是要启动拨号网络中的某一个连接，则需借助rundll.exe 及 rnaui.dll来启动，方法如下（假定连接名称为163）：Shell "rundll rnaui.dll,RnaDial 163", vbNormalFocus---- 说明：在以上叙述中，“,RnaDial 163”这部分不要插入额外的空格，大小写也不要任意更改。---- 上面仅仅假定了连接名称，但实际编程中我们是不知道其名称的，如何取得默认的连接名称并启动它呢？这里我们可利用注册表来达到目的。完整程序如下：---- 在窗体上放置一个命令按钮（名称为 cmdCallConnect)，下面为代码部份：Option Explicit‘有关注册的API声明Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As LongPrivate Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As LongPrivate Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long‘常数Const HKEY_CURRENT_USER = &H80000001Const ERROR_SUCCESS = 0&Private Sub cmdCallConnect_Click()‘启动默认拨号连接Shell "rundll rnaui.dll,RnaDial " + GetConnect, vbNormalFocusEnd SubPublic Function GetConnect() As StringDim hKey As LongDim SubKey As StringhKey = HKEY_CURRENT_USER  ‘主键SubKey = "RemoteAccess"   ‘子键‘取得默认连接名GetConnect = GetRegValue(hKey, SubKey, "Default")End FunctionPublic Function GetRegValue(hKey As Long, lpszSubKey As String, szKey As String) As VariantOn Error GoTo ErrorRoutineErr:Dim phkResult As LongDim lResult As LongDim szBuffer As StringDim lBuffSize As Long‘创建缓冲区szBuffer = Space(255)lBuffSize = Len(szBuffer)‘打开注册键RegOpenKeyEx hKey, lpszSubKey, 0, 1, phkResult‘查询结果lResult = RegQueryValueEx(phkResult,szKey, 0, 0, szBuffer,lBuffSize)‘关闭注册键RegCloseKey phkResult‘返回结果If lResult = ERROR_SUCCESS ThenGetRegValue = Left(szBuffer, lBuffSize - 1)ElseGetRegValue = ""End IfExit FunctionErrorRoutineErr:GetRegValue = ""End Function以上程序在 WIN98,VB6.0 下调试通过。8、如何通过VB获取网卡地址[功能描述] IPX和NETBIOS接口需要网络地址。该文通过详细的步骤演示了如何通过VB获取网卡地址。步骤：1)在Visual Basic生成标准的EXE文件。缺省创建 Form1。2)在Form1中添加一命令按钮，缺省名为Command1。3)把下列代码放到Form1中说明部分。Option ExplicitPrivate Const NCBASTAT = &H33Private Const NCBNAMSZ = 16Private Const HEAP_ZERO_MEMORY = &H8Private Const HEAP_GENERATE_EXCEPTIONS = &H4Private Const NCBRESET = &H32Private Type NCB　　ncb_command As Byte ‘Integer　　ncb_retcode As Byte ‘Integer　　ncb_lsn As Byte ‘Integer　　ncb_num As Byte ‘ Integer　　ncb_buffer As Long ‘String　　ncb_length As Integer　　ncb_callname As String * NCBNAMSZ　　ncb_name As String * NCBNAMSZ　　ncb_rto As Byte ‘Integer　　ncb_sto As Byte ‘ Integer　　ncb_post As Long　　ncb_lana_num As Byte ‘Integer　　ncb_cmd_cplt As Byte ‘Integer　　ncb_reserve(9) As Byte ‘ Reserved, must be 0　　ncb_event As LongEnd TypePrivate Type ADAPTER_STATUS　　adapter_address(5) As Byte ‘As String * 6　　rev_major As Byte ‘Integer　　reserved0 As Byte ‘Integer　　adapter_type As Byte ‘Integer　　rev_minor As Byte ‘Integer　　duration As Integer　　frmr_recv As Integer　　frmr_xmit As Integer　　iframe_recv_err As Integer　　xmit_aborts As Integer　　xmit_success As Long　　recv_success As Long　　iframe_xmit_err As Integer　　recv_buff_unavail As Integer　　t1_timeouts As Integer　　ti_timeouts As Integer　　Reserved1 As Long　　free_ncbs As Integer　　max_cfg_ncbs As Integer　　max_ncbs As Integer　　xmit_buf_unavail As Integer　　max_dgram_size As Integer　　pending_sess As Integer　　max_cfg_sess As Integer　　max_sess As Integer　　max_sess_pkt_size As Integer　　name_count As IntegerEnd TypePrivate Type NAME_BUFFER　　name As String * NCBNAMSZ　　name_num As Integer　　name_flags As IntegerEnd TypePrivate Type ASTAT　　adapt As ADAPTER_STATUS　　NameBuff(30) As NAME_BUFFEREnd TypePrivate Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) As BytePrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)Private Declare Function GetProcessHeap Lib "kernel32" () As LongPrivate Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As LongPrivate Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long,ByVal dwFlags As Long, lpMem As Any) As Long把下面的代码放入Command1_Click的事件中：Private Sub Command1_Click()　　Dim myNcb As NCB　　Dim bRet As Byte　　myNcb.ncb_command = NCBRESET　　bRet = Netbios(myNcb)　　myNcb.ncb_command = NCBASTAT　　myNcb.ncb_lana_num = 0　　myNcb.ncb_callname = "*　　　　　　 "　　Dim myASTAT As ASTAT, tempASTAT As ASTAT　　Dim pASTAT As Long　　myNcb.ncb_length = Len(myASTAT)　　Debug.Print Err.LastDllError　　pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, myNcb.ncb_length)　　If pASTAT = 0 Then　　　　Debug.Print "memory allcoation failed!"　　　　Exit Sub　　End If　　myNcb.ncb_buffer = pASTAT　　bRet = Netbios(myNcb)　　Debug.Print Err.LastDllError　　CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)　　MsgBox Hex(myASTAT.adapt.adapter_address(0)) & " " & Hex(myASTAT.adapt.adapter_address(1)) _　　　　& " " & Hex(myASTAT.adapt.adapter_address(2)) & " " _　　　　& Hex(myASTAT.adapt.adapter_address(3)) _　　　　& " " & Hex(myASTAT.adapt.adapter_address(4)) & " " _　　　　& Hex(myASTAT.adapt.adapter_address(5))　　HeapFree GetProcessHeap(), 0, pASTATEnd Sub4)按F5，运行该程序。5)点击Command1。注意，网卡地址将在一信息框中显示出来。9、如何使用 ADO 來压缩或修复 Microsoft Access 文件以前使用 DAO 時，Microsoft 有提供 CompactDatabase Method 來压缩 Microsoft Access 文件，RepairDatabase Method 來修复损坏的 Microsoft Access 文件，。可是自从 ADO 出來之后，好像忘了提供相对的压缩及修复 Microsoft Access 文件的功能。現在 Microsoft 发现了这个问题了，也提供了解決方法，不过有版本上的限制！限制說明如下：ActiveX Data Objects (ADO), version 2.1Microsoft OLE DB Provider for Jet, version 4.0這是 Microsoft 提出的 ADO 的延伸功能：Microsoft Jet OLE DB Provider and Replication Objects (JRO)这个功能在 JET OLE DB Provider version 4.0 (Msjetoledb40.dll) 及 JRO version 2.1 (Msjro.dll) 中第一次被提出！這些必要的 DLL 文件在您安裝了 MDAC 2.1 之后就有了，您可以在以下的网页中下载 MDAC 的最新版本！Universal Data Access Web Site在下载之前先到 VB6 中檢查一下，【控件】【設定引用項目】中的 Microsoft Jet and Replication Objects X.X library 如果已经是 2.1 以上的版本，您就可以不用下载了！在您安裝了 MDAC 2.1 或以上的版本之后，您就可以使用 ADO 來压缩或修复 Microsoft Access 文件，下面的步骤告訴您如何使用 CompactDatabase Method 來压缩 Microsoft Access 文件：1、新建一個新表单，选择功能表中的【控件】【設定引用項目】。2、加入 Microsoft Jet and Replication Objects X.X library，其中 ( X.X 大于或等于 2.1 )。3、在适当的地方加入以下的程序代码，記得要修改 data source 的內容及目地文件的路径：Dim jro As jro.JetEngineSet jro = New jro.JetEnginejro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\\nwind2.mdb", _ ‘來源文件"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\\abbc2.mdb;Jet OLEDB:Engine Type=4" ‘目的文件在 DAO 3.60 之后，RepairDatabase Method 已经无法使用了，以上的程序代码显示了 ADO CompactDatabase Method 的用法，而它也取代了 DAO 3.5 時的 RepairDatabase method！10、如何设置对VB数据库连接的动态路径我个人因为经常作一些数据库方面的程序，对于程序间如何与数据库进行接口的问题之烦是深有体会，因为VB在数据库链接的时候，一般是静态，即数据库存放的路径是固定的，如用VB的DATA，adodc,DataEnvironment 等到作数据库链接时，如果存放数据库的路径被改变的话，就会找不到路经，真是一个特别烦的事。笔者的解决方法是利用app.path 来解决这个问题。一、用data控件进行数据库链接，可以这样：在form_load()过程中放入：private form_load()Dim str As String ‘定义str = App.PathIf Right(str, 1) <> "\" Thenstr = str + "\"End Ifdata1.databasename=str & "\数据库名"data1.recordsource="数据表名"data1.refreshsub end这几句话的意为，打开当前程序运行的目录下的数据库。你只要保证你的数据库在你程序所在的目录之下就行了。二、利用adodc（ADO Data Control)进行数据库链接：private form_load ()Dim str As String ‘定义str = App.PathIf Right(str, 1) <> "\" Thenstr = str + "\"End Ifstr = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & str & "\tsl.mdb"Adodc1.ConnectionString = strAdodc1.CommandType = adCmdTextAdodc1.RecordSource = "select * from table3"Adodc1.Refreshend sub三、利用DataEnvironment进行数据库链接可在过程中放入：On Error Resume NextIf DataEnvironment1.rsCommand1.State <> adStateClosed ThenDataEnvironment1.rsCommand1.Close ‘如果打开，则关闭End If‘i = InputBox("请输入友人编号:", "输入")‘If i = "" Then Exit SubDataEnvironment1.Connection1.Open App.Path & "\userdatabase\tsl.mdb"DataEnvironment1.rsCommand1.Open "select * from table3 where 编号=‘" & i & "‘"‘Set DataReport2.DataSource = DataEnvironment1‘DataReport2.DataMember = "command1"‘DataReport2.showend sub四、利用ADO(ActiveX Data Objects)进行编程：建立连接：dim conn as new adodb.connectiondim rs as new adodb.recordsetdim strstr = App.PathIf Right(str, 1) <> "\" Thenstr = str + "\"End Ifstr = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & str & "\tsl.mdb"conn.open strrs.cursorlocation=aduseclientrs.open "数据表名",conn,adopenkeyset.adlockpessimistic用完之后关闭数据库：conn.closeset conn=nothing11、如何让用户自行输入方程式，并计算其结果？假设我们要让使用者在“方程式”栏位中自由输入方程式，然后利用方程式进行计算，则引用ScriptControl控件可以很方便地做到。( ScriptControl 控件附属于VB 6.0，如果安装后没有看到此一控件，可在光盘的 \Common\Tools\VB\Script 目录底下找此一控件， 其.文件名为Msscript.ocx。) 假设放在窗体上的ScriptControl控件名称为ScriptControl1，则在“计算”按钮的Click事件中编写如下代码： Dim Statement As String Statement = "X=" + Text1.Text + vbCrLf + _ "Y=" + Text2.Text + vbCrLf + _ "MsgBox ""计算结果="" & Y " ScriptControl1.ExecuteStatement( Statement )12、如何解决VB中的Grid控件的打印问题---- Grid 控件是Visual Basic最常见控件之一， 从VB3.0 到VB5.0 都有该控件。 也是VB爱好者最喜爱的工具之一。用它可以以表格的形式 显示、浏览数据，特别是数据库应用，直接绑定即可显示浏览数据库信息。然而，美中不足的是Grid 没有编辑和打印功能，列与列的位置不能相互交换。笔者曾尝试着给Grid 增添了这些功能，使之锦上添花，功能更强大。下面给出改进方法及源程序，读者只需按步骤写下源程序即可使你的Grid 具有打印功能。该程序笔者在HP5/100Window95环境下用VB5.0 调试通过。---- 给Grid 控件增加打印方法有三种：1 是直接打印控件的方法，2 是通过 printer 来实现打印功能，3 是通过调用MS-WORD 及MS-EXCEl 来 实 现 打 印。---- 首先，打开一个应用，在FORM1中增加DATA 控件DATA1,把DATA1的CONNECT 属性设为dBASE III，再把DATABASENAME属性设为D:\PJXM.DBF。然后再在FORM1中增加MSFLEXGRID空间GRID1，并把GRID1的DATASOURCE 属性设为DATA1。这样数据库PJXM.DBF 的信息就会在GRID1中显示出来。---- 方法一：直接打印窗体法，在FORM1中增加命令按钮(command)，CAPTION属性设为直接打印，再写入下列编码：Sub command_clickForm1.printformEnd sub---- 这样即可通过打印窗体FORM1的方法把GRID1的数据打印出来，遗憾的是只能打印GRID1中显示的数据部分，显示不出来的则无法打印， 而且这种打印方法很象屏幕硬拷贝把其他控件也打印出来。也不能灵活的控制字体等。---- 方法二：通过PRINTER实现打印。这种方法---- 1、加入打印命令按钮(command1)、函数(print1)即可实现打印功能，写入下面代码，读者稍加改动可写成标准的函数或过程。Function prnt1 (x As Integer, y As Integer,font As Single, txt As String)printer.CurrentX = xprinter.CurrentY = yprinter.FontBold = Falseprinter.FontSize = fontprinter.Print txtEnd FunctionSub command1_clickDim fnt As SingleDim pp as integerPp=0‘设置开始页码0Dim stry,strx,strx1,stry1,linw,page1,p As IntegerStatic a(8) As Integer‘定义打印的列数ss$ = "内部结算存入款对帐单"‘定义表头kan = 0For i = 0 To 8a(i) = 1500‘定义每列宽kan = kan + a(i)‘计算表格总宽度Nextpage1 = 50‘定义每页行数strx = 200strx1 = 200‘定义X方向起始位置stry = 1400stry1 = 1400‘定义Y方向起始位置linw = 240‘定义行宽fnt = 8‘定义字体大小printer.fontname = "宋体"‘定义字体dd = prnt1(4000, 700, 18, ss$)‘打印标题printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)For j = 0 To gridrow - 1‘gridrow为所要打印的行数grid1.row = jstrx = strx1printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)p = p + 1For i = 0 To 8grid1.col = idd = prnt1(strx, stry, fnt, grid1.text)strx = strx + a(i)NextIf p > page1 Then‘next pagep = 0strx = strx1‘line last lineprinter.Line (strx - 50, stry + linw)-(strx + kan - 10, stry + linw)stry = stry1‘line colFor n = 0 To 8printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)strx = strx + a(n)Nextprinter.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)pp=pp+1foot$="第 "+cstr(pp)+"页"dd = prnt1(strx - 30-1000, stry + (page1 + 2)* linw+100, 10, foot$)‘打印页角码printer.NewPage‘next pagedd = prnt1(4000, 700, 18, ss$) ‘打印标题strx = strx1stry = stry1printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)‘ print first rowElsestry = stry + linwEnd IfNextst = stryIf p < page1 Then ‘在最后页剩余划空行For o = p To page1 + 1strx = strx1printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)stry = stry + linwNextEnd Ifstry = stry1strx = strx1stry = stry1 ‘line colFor n = 0 To 8printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)strx = strx + a(n)Nextprinter.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)pp=pp+1foot$="第 "+cstr(pp)+"页"dd = prnt1(strx - 30-1000, stry + (page1 + 2)* linw+100, 10, foot$)‘打印页角码printer.EndDoc‘打印结束Endsub---- 这种方法通过灵活的编程可以方便地调整字体、字型、线形、页面、纸张大小等。可打印出比较满意的效果。如果你的计算机上装有MICROSOFT WORD 和MICRO EXCEL，最精彩的用法还是把GRID 的表格通过VB发送到MICROSOFT WORD 及MICRO EXCEL。生成MICROSOFT WORD 和MICRO EXCEL 表格。这样就可以充分利用MICROSOFT WORD 和MICRO EXCEL的打印、编辑功能打印出更理想的效果。下面逐一介绍。---- 方法三：通过生成MICROSOFT WORD表格打印---- 1、在declaration 中写入: Dim msword As Object---- 2、 加入打印命令按钮(command2)，CAPTION 设为"生成WORD 表格"，写入下面代码，Private Sub command2_Click()screen.MousePointer = 11Set msword = CreateObject("word.basic")Dim AppID, ReturnValueappID = Shell("d:\office97\office\WINWORD.EXE", 1)‘ Run Microsoft Word.msword.AppActivate "Microsoft Word"‘msword.AppActivate "Microsoft Word", 1fullScreen.MousePointer = 0End Sub---- 2、写入以下过程full()Sub full()Dim i As Integer, j As Integer,col As Integer, row As IntegerDim cellcontent As StringMe.Hidecols = 4‘表格的列数row = gridrow‘打印表的行数msword.filenewdefaultmsword.MsgBox "正在建立MS_WORD报表，请稍候.......", "", -1msword.leftparamsword.screenupdating 0msword.tableinserttable , col, row, , , 16, 167msword.startofdocumentfor j=0 to gridrow‘ 表格的行数grid1.row=jFor i = 1 To colsGri1d.col=iIf IsNull(grid1.text) Thencellcontent$ = ""Elsecellcontent$ = grid1.textEnd Ifmsword.Insert cellcontent$msword.nextcellNext iNext jmsword.tabledeleterowmsword.startofdocumentmsword.tableselectrowmsword.tableheadings 1msword.centerpara‘msword.startdocumentmsword.screenrefreshmsword.screenupdating 1msword.MsgBox " 结束", "", -1Me.ShowEnd Sub---- 方法四：通过发送到MICROSOFT EXCEL实现表格打印---- 1、加入打印命令按钮(command3)，CAPTION 设为"生成EXCEL 表格"，写入下面代码Private Sub command3_Click()Dim i As IntegerDim j As IntegerDim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Excel.WorksheetSet xlApp = CreateObject("Excel.Application")xlApp.Visible = True‘Set xlBook = xlApp.Workbooks.Add‘On Error Resume NextSet xlBook = xlApp.Workbooks.Add ‘Open("d:\text2.xls")Set xlSheet = xlBook.Worksheets(1)xlSheet.Cells(6, 1) = "i"For i = 0 To gridrowgrid1.Row = iFor j = 0 To 6Grid1.Col = jIf IsNull(Grid1.Text) = False ThenxlSheet.Cells(i + 5, j + 1) = Grid1.TextEnd IfNext jNext iExit Sub13、如何在VB中实现绘图区的大十字光标有时，我们需要用VB快速开发一个试验数据绘图处理程序，将绘图控件内的鼠标光标改变成与AutoCAD软件中使用的大十字光标的形式，将可以比普通的箭头光标达到更好的效果。那么我们如何实现这样的大十字光标呢？---- 首先，我们明确一下要达到的效果，假若我们在一个Picture控件中绘图，那么，鼠标移动到这个控件上时，鼠标光标立即改变为大十字形状，光标中的横线从控件的左边界到右边界，竖线从控件的上边界到下边界，即大十字光标将绘图控件分割为四个象限。当鼠标移动到控件外时，光标则又恢复成原来的形式。---- 要实现这样的光标，得我们自己通过画线的方式实现。如鼠标在绘图控件内，先在鼠标的当前位置画上光标的横线和竖线；当鼠标位置移动，先擦除原先的光标横线和竖线，然后再在新的位置画光标的横线和竖线，那么我们就要响应绘图控件的MouseMove事件。当然，绘图控件内无论有什么内容，我们擦除光标线和重画光标线时都不能破坏原先的内容，因此我们要将绘图控件的DrawMode设置为vbXorPen（异或方式），绘制光标的横线和竖线时，用异或的方式将横线和竖线的象素点颜色设为光标的颜色和原先的象素点色彩的异或值，再用异或的方式在同样的位置绘制一遍竖线和横线，横线和竖线上的象素点再一次和光标颜色进行异或操作，就擦除了光标的横线和竖线，且又恢复了绘图控件内原先的内容。---- 我们还得保证鼠标移动到绘图控件内时，普通的鼠标光标消失，只有绘制的大十字光标出现，因此还应该设置绘图控件的MousePointer属性为vbCuntom，即用户自定义。绘图控件的MousePointer属性设置为vbCustom后，其MouseIcon属性中应装入相应的用户自定义图形，因为我们希望绘图控件内只有我们绘制的光标，而没有其它的光标，故应该装入一个空的（透明的）光标图形。可以任找一个光标文件，通过任意一个资源编辑器对其进行编辑，用透明的方式填充整个光标图形，保存成我们所需的NoIcon.cur即可。---- 通过以上的关键设置和操作，我们就可以实现大十字光标了。利用异或方式进行绘图，我们还可以实现一般绘图软件中常有的“橡皮筋”效果，即用鼠标定义一个点后，动态拖动鼠标来定义另外一个点，动态拖动鼠标过程中，所要绘的图形也动态相应变化。---- 以下我们通过一个示例来完整实现绘图控件中的大十字光标，还演示如何实现用“橡皮筋”效果来画矩形：---- 在VB中新建一个标准EXE工程，在Form1中加入一个Picture控件，其Name设为PicDraw，可以装入一个图象文件，PicDraw的大小和其中的图象大小基本上覆盖大部分的Form1即可。实现代码如下所示。此程序在VB5.0中运行通过。Option ExplicitPrivate Old_X As SinglePrivate Old_Y As SinglePrivate isMouseDown As BooleanPrivate Box_X0 As SinglePrivate Box_Y0 As SinglePrivate Box_X1 As SinglePrivate Box_Y1 As SinglePrivate PenColor As LongPrivate CrossColor As LongPrivate Sub Form_Load()CrossColor = QBColor(8)PenColor = QBColor(15)picDraw.DrawMode = vbXorPenpicDraw.MouseIcon = LoadPicture(App.Path & "\no.cur")picDraw.MousePointer = vbCustomisMouseDown = FalseBox_X0 = Box_X1 = Box_Y0 = Box_Y1 = 0End SubPrivate Sub picDraw_MouseDown(Button As Integer,Shift As Integer, X As Single, Y As Single)If isMouseDown = True Then‘先前已经用鼠标定义了一个点Box_X1 = XBox_Y1 = YisMouseDown = FalsepicDraw.DrawMode = vbCopyPenpicDraw.Line (Box_X0, Box_Y0)-(Box_X1, Box_Y1),PenColor, BpicDraw.DrawMode = vbXorPen‘画一个光标picDraw.Line (0, Y)-(picDraw.ScaleWidth, Y),CrossColorpicDraw.Line (X, 0)-(X, picDraw.ScaleHeight),CrossColorOld_X = XOld_Y = YElse‘定义了一个矩形的第一个顶点，则擦除光标picDraw.Line (0, Y)-(picDraw.ScaleWidth, Y),CrossColorpicDraw.Line (X, 0)-(X, picDraw.ScaleHeight),CrossColorBox_X0 = XBox_Y0 = YisMouseDown = TrueEnd IfEnd SubPrivate Sub picDraw_MouseMove(Button As Integer,Shift As Integer, X As Single, Y As Single)If isMouseDown = True Then‘拖动鼠标来定义矩形的另外一个顶点，此时擦除前一个矩形，绘制新的矩形picDraw.Line (Box_X0, Box_Y0)-(Old_X, Old_Y),PenColor, BpicDraw.Line (Box_X0, Box_Y0)-(X, Y), PenColor, BElse‘消除旧光标线picDraw.Line (0, Old_Y)-(picDraw.ScaleWidth, Old_Y),CrossColorpicDraw.Line (Old_X, 0)-(Old_X, picDraw.ScaleHeight),CrossColor‘画新的光标线picDraw.Line (0, Y)-(picDraw.ScaleWidth, Y),CrossColorpicDraw.Line (X, 0)-(X, picDraw.ScaleHeight),CrossColorEnd IfOld_X = XOld_Y = YEnd Sub14、如何充分扩充VB功能Visual Basic for Windowss3.0（简称VB）是目前开发WINDOWS应用软件的最有效工具之一，它综合运用了BAIC语言和新的可视化设计工具，不仅功能强大，而且简单易学。其次，VB具有事件驱动的编程机制，它充分利用WINDOWS图形环境的特点，能让开发人员快速地构造强大的应用程序。那么在开发VB应用软件时，如何充分地扩充VB的功能呢？这就要求在不同的层次上要很好地利用VB最具威力和特色的部分：●在函数层调用动态链接库。●在控件层使用VBX。●在应用层执行其他应用程序。一、在函数层调用功能态链接库（DLL）WINDOWS操作系统实际上是由许多功能强大的动态链接库（DLL）组合而成。VB考虑到有些工作超过自身语言所及的能力范围，所以提供了直接调用操作系统中这些DLL子程序的能力。例如：在正常情况下，窗口的控制菜单提供了七种功能：还原、移动、大小、最小化、最大化、关闭和切换。而在实际应用中，我们希望窗口按设计时的大小显示，不允许用户随意改变窗口大小，也不允许切换到其他窗口，这就要求在设计时必须删除控制菜单中除“移动”和“关闭”选项以外的所有控制菜单项。要完成这一任务，我们首先可把窗体的MaxButton属性和MinButton属性设置为False，不允许窗体最小化和最大化，窗体也就不能还原。然后再把窗体的BorderSstyle属性设置为1－Fixed Single或3－Fixed Double，不允许窗体改变大小。但VB本身却无法删除“切换”选项和两条分隔线。幸运的是，通过调用WINDOWS DLL就很容易做到。通常，要使用WINDOWS DLL，首先必须说明要使用的DLL子程序，我们可在两个地方说明所使用的DLL子程序，即在全局模块中说明，或者在窗体层的说明部分中说明。其格式是：Declare Sub子程序名Lib“库名”［Alias“别名”］［（［参数］）］Declare Function子程序名Lib“库名”［Aliass“别名”］［（［参数］）］［AS数据类型］第一种格式表示过程没有返回值，第二种格式表示过程返回一个值，该值可用于表达式中，库名如果用的是WINDOWS操作环境（在System目录下）中的库，如“USER.EXE”，“KERNEL.EXE”或者“GDI.EXE”等，就用此名作为库名。如果用的是其他来源的DLL，则用包括路径的文件名称（如：“C：＼WINDOWS＼BRUSH.DLL”）。别名（Alias）是允许另外使用别的名称来称呼子程序，尤其是当外来子程序名与VB保留字相同时，它就显得特别有用，参数指要被传递到子程序的参数值，数据类型指的是函数返回值的数据类型，它可能是Integer，Long，Single，Double，Currency或String。下面就是所要使用的DLL子程序的说明：Declare Function GetSystemMenu％ Lib＂User＂（ByValhWnd％，ByValbRevert％）Declare ＼function ＼RemoveMenu％ Lib＂User＂（ByValhMenu％，ByValnPosition％，ByValwFlags％）当说明完DLL子程序后，执行DLL子程序的方法，就象在VB中执行通用过程（函数）一样。下面我们编写一个名为Remove－Items－From－System的过程来完成上面例子中提到的功能，过程中调用了上述说明过的两个DLL子程序：Sub remove－Items－From－Sysmenu（A－Form As Form）‘获取窗体系统菜单句炳HSysMenu＝GetSystemMenu（A－Form.hWnd，0）‘删除除“移动”和“关闭”外的所有菜单项， 删除时必须从最后一个菜单项开始R＝RemoveMenu（HSysMenu，8，MF－BYPOSITION） ‘删除切换R＝RemoveMenu（HSysMenu，7，MF－BYPOSITION） ‘删除第一条分隔线R＝RemoveMenu（HSysMenu，5，MF－BYPOSITION） ‘删除第二条分隔线End Sub有了这个过程，在任一窗体的Form－Load事件中加入下面一行代码就可以删除该窗体除“移动”和“关闭”选项以外的所有控制菜单项：Remove－Items－From－Sysmenu Me二、在控件层使用VBXVB功能强大的第二个部分是VBX的使用，即其开放及无限扩增的特性。虽然VB工具箱（ToolBox）已经尽量将设计应用软件所需的工具包括在内，但是，为了不断扩充VB的功能，VB提供了一套开发工具（Custom Control Development Kit）供第三方开发者来设计所需要的控件。当设计完控件文件后（其文件扩展名为“.VBX”）可以从菜单“file”项下选“Add File...”命令，结果画面上出现一个＂Add File＂对话框，双击所需的VBX文件名即可将该VBX加入到VB中，这些控件装入VB后，VB会将这些外来控件加到原有工具箱中，与其他控件一起合并使用。正是因为有了这一技术，VB才能够不断发展，使用VB编程也更为方便、迅速和有效，这是VB区别于其他程序开发环境的主要特色之一。自从VB推出以来，第三方软件公司设计了大量的新控件，下面是开发WINDOWS应用程序时几个非常有用的VBX：●三维控件Threed.vbx它提供了包括命令按钮、复选框、单选钮 、框架、下推按钮和面板在内的六种三维控件，使用这些控件可使窗体更具有立体感。●图形控件Graph.vbx向图形控件发送数据后，图形控件可绘制二维或三维饼图，、直方图、趋势图，并且可以打印或拷贝到剪贴板上。●通讯控件Mscomm.vbx它提供了串行通讯的能力，可用于串行端口之间传送和接收数据。●数据网格控件Truegrid.vbx它既可以作为一般的数据显示表格，也可把一个数据库和一个网格联系起来，它是制作数据库浏览器或数据显示的理想工具。二、在应用层执行其他应用程序在编制复杂的大型软件时，我们经常会需要有一些功能相对独立和完善的专用程序，如编辑程序，而这些程序通常是通用和流行并经实践检验的。如果由开发者重新编制这些程序，不仅大大增加了程序工作量以及调试过程，而且功能上很难比得上这些通用程序。显然，如果我们能直接调用这些程序是最为理想的。令人欣喜的是，VB提供了一个可用来调用其他应用程序的Shell函数，使VB的某些功能可直接由其他应用程序来完成，从而大大地减少了编程任务。格式是Shell（命令字符串［，窗口类型］）其中的命令字符串是欲执行的应用程序名，可执行文件的扩展名只限于“.COM”，“.EXE”，“.BAT”，“.PIF”，缺省扩展名为.EXE文件，窗口类型是一整数值，它对应于程序执行时的显示窗口风格，是可选 的，共有下列5种选择：窗口类型值窗口类型 1，5，9正常窗口，具有指针 2最小窗口，具有指针（缺省） 3最大窗口，具有指针 4，8正常窗口，不具指针 6，7最小窗口，不具指针当Shell函数成功地调用某一个应用程序时，返回一个任务标识（Task ID），该ID表示正在执行的程序的唯一标识。［例］X＝Shell（"C：\WINDOWS\NOTEPAD.EXE",1）该语句调用WINDOWS附件中的记事本NOTEPAD.EXE作为编辑程序来使用，并返回1个ID值到X。15、成组更新控件属性Sub EnableAll(Enabled As Boolean, ParamArray objs() As Variant)Dim obj As VariantFor Each obj In objsobj.Enabled = EnabledNext objEnd Sub应用：EnableAll True, Text1, Text2, Command1, Command2VB问题全功略（4） [查找本页请按Ctrl+F]［上一页］（4）［下一页］16、如何避免程式重复执行？（侦测是否存在前一副本，若有，则结束目前新启动的程式）17、如何让一个 App 永远保持在最上层 ( Always on Top )18、表单配置视窗和解析度19、连续变量的声明 Dim a, b, c as string * 420、正确的除错 (Debug) 方式16、如何避免程式重复执行？（侦测是否存在前一副本，若有，则结束目前新启动的程式）使用者在启动程式后，有时会将程式缩小在工作列上，之后要用时，又会重新启动一次程式，资料库程式有时会因此造成资料错乱！若您不希望使用者重复启动程式，您可以使用 APP 物件来判断，方法如下：Private Sub Form_Load()If App.PrevInstance Then ‘检视前一版本MsgBox "此程式已经在执行中！", 48EndEnd IfEnd Sub17、如何让一个 App 永远保持在最上层 ( Always on Top )请在声明区中加入以下声明Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongConst SWP_NOMOVE = &H2 ‘不更动目前视窗位置Const SWP_NOSIZE = &H1 ‘不更动目前视窗大小Const HWND_TOPMOST = -1 ‘设定为最上层Const HWND_NOTOPMOST = -2 ‘取消最上层设定Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE‘将 APP 视窗设定成永远保持在最上层SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS‘取消最上层设定SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS18、表单配置视窗和解析度这个地方不是要告诉您如何写出一支程式，会自动根据使用者荧幕的解析度调整 Form 及各控制项的大小，也就是适用于各种解析度的程式。那是另一个主题！由于我在集团式的公司资讯中心上班，在我的开发过程中，我的使用者依不同公司别，分成几个族群，有的公司都是使用 640x480 的解析度，有的都用 800x600，设计公司则是 1024x768，为了替这些公司开发软件，在 VB5.0 以前，写各家公司的程式以前就必须先调整荧幕的解析度 (否则在解析度 800x600 的电脑上开发的程式，在 640x480 解析度的电脑中执行时，右方和下方的画面会跑出荧幕外面)，有的电脑一改变解析度就必须重新开机，更是麻烦！VB5.0 以后，VB 多提供了一个功能，就是【表单配置视窗】，从此以后，您可以在高解析度的荧幕中，开发低解析度的程式，要怎么做呢？ 《假设您的电脑解析度是 1024x768》很简单！在【表单配置视窗】上的荧幕上按滑数右键，选择【解析度】。看到了吗！在【表单配置视窗】上的荧幕上，出现了二个虚线框，上面各标明了 640x480 及 800x600。好了！现在您可以开始开发各种不同解析度的系统了！例如您要开发的系统，解析度是 640x480，您只要注意不要让您的表单超出 640x480 的虚线框就可以了！19、连续变量的声明 Dim a, b, c as string * 4我想声明 a,b,c 三个字串变量Dim a, b, c as string * 4 (错的)这样的声明在 VB 中，结果可能和您要的不同！有些程式语言，例如 C，类似以上的声明表示三个字串变量。但是在 VB 中却不是如此！以上的声明在 VB 中表示声明了 a,b 2 个 variant (不定形态变量)，以及 c 这个字串变量。要声明 a,b,c 三个字串变量，正确的写法如下：Dim a as string * 4Dim b as string * 4Dim c as string * 4若想写在同一行，也可以，写法如下：Dim a as string * 4, b as string * 4, c as string * 420、正确的除错 (Debug) 方式当程式执行起来怪怪的，很多人在除错 (Debug) 时，都喜欢在程式中使用中断点 (Break) 加上 MsgBox 来看执行结果，但有些时候，这样子的作法会造成某些事件 (Event) 无法触发，甚至改变事件原来触发的顺序！比较正确的作法是在程式中使用 Debug.Print "事件名称/要显示的讯息" ，而不要用中断点 (Break)。21、Move Method 速度较快当我们要移动控制项 (Control) 或表单 (Form) 时，很多人习惯这样写：frmCustomer.Left = frmCustomer.Left + 100frmCustomer.Top = frmCustomer.Top + 50但是若使用 Move Method ，可以加快 40%：frmCustomer.Move frmCustomer.Left + 100, frmCustomer.Top + 5022、哇！我的变量名称变成了保留字！当我们升级 VB 的版本时，有时候会因为以前程序中使用的变量名称或函数名称变成了保留字，而使程序跑起来完全不正常，例如：print：VB3 时不是保留字，但到了 VB4 却变成了保留字。array：VB4 时不是保留字，但到了 VB5 却变成了保留字。遇到这种情形，其实也很简单！只要在 VB 中叫出该工程，打开任何一个表单的程序码，选择【编辑功能表】中的【取代】，搜寻范围设定成【整个工程】，并将【全字拼写须符合】选项打勾，然后将该工程中该字串改成另一个新字串，再重新 Make 成执行档即可。下一次您升级 VB 的版本时，若原来正常的程序跑起来变得怪怪的，别忘了检查一下您自己定义的变数名称或函数名称是否也变成了保留字！23、快捷键 -- 找寻 Function/Subroutine当您的 APP 愈来愈大时，或是您要维护别人开发的大系统时，是否曾经有过一种情形，程序中 call 了某一个 Function/Subroutine，您要找寻这个 Function/Subroutine，除了一个一个 Module 找之外，大部份的人都是使用【编辑功能表】的【搜寻】功能。其实您可以使用 【Shift + F2】快捷键！很简单，方法如下：只要将鼠标停留在程序中该 Function/Subroutine Name 上，再使用【Shift + F2】快捷键即可！24、我上一次程序写到那里呢？有时候您会同时写几个不同的程序，或因为某种原因，程序停了一段时间，当您下一次要再继续写时，已经忘了上次写到那里了，其实有一个很简单的方法，可以马上唤起您的记忆！在您在写程序中要停下时，先随便写一行注解，但是拿掉注解符号〈‘〉后存档，下一次您载入工程后，马上使用【执行功能表】中的【全部编译后开始】，此时第一个错误的地方使是上次程序中断的地方！25、不方便的 Msdn -- VB6.0 的 Help很多 VB 程序设计师抱怨为了存取 VB6.0 的 Help，必须一直将 Msdn 光碟放在光碟机中，否则就必须安装 680MB 的 Help 到硬盘中！其实还有一个比较人性化的方法，就是在安装 Msdn 时，选择【自订安装】，然后只要选择 Visual Basic 文件 (13792K) 即可。如此您便可以直接由硬盘存取 VB 的相关主题，若您想看其他非 VB 主题，再由光碟存取。VB问题全功略（6） [查找本页请按Ctrl+F]［上一页］（6）［下一页］26、如何快速设定 Form 上所有控制项的 TabIndex 顺序27、Boolean 值的转换28、呼叫子程序（Subroutine）29、输入时，自动转换成大写？30、输入时，自动转换成小写？26、如何快速设定 Form 上所有控制项的 TabIndex 顺序由于在设计 Form 上的控制项时，不一定会依照输入的顺序，在完成设计之后，我们通常会重设各控制项的 TabIndex 顺序，当 Form 上的控制项比较多时，设定起来相当麻烦，常常还会设错。有一个很简单又不容易出错的方法，是从画面上的右下角往左上角 (方向是先向左再往上)，逐一的将控制项的 TabIndex 属性设成 0。1：右手用滑鼠点一下右下角的控制项，左手按 F4，将 TabIndex 设成 0。2：右手往左用滑鼠点一下倒数第二个控制项，左手按 F4，左手按 0。3：右手往左用滑鼠点一下倒数第三个控制项，左手按 F4，左手按 0。4：重复以上动作直到左上角第一个控制项为止。好了，您已经设定好整个 Form 上所有控制项的 TabIndex 顺序了！其原理就是当您设定一个控制项的 TabIndex 为 0 时，原来 TabIndex 为 0 的控制项，TabIndex 就变成了 1、而 1 的变成 2...依序 +1 改变。27、Boolean 值的转换我们都知道 Boolean 这个资料形态只有 True/False 二种值，但是当我们要存到资料库时，我们常常会将它转成数值，您可以直接设定 True=-1 / False =0，若您必须使用函数转换，很可能会用 Val()，但是小心，其结果是错的！您必须使用 Abs() 或 CInt()，为什么呢？看结果就知道了！Val(True) 结果是 0CInt(True) 结果是 -1Abs(True) 结果是 128、呼叫子程序（Subroutine）当我们呼叫子程序 (Subroutine) 时，有二种方法：1、Call MyRoutine(参数)2、MyRoutine 参数注意第二个方法不可以使用括号 ()，否则 VB 会误认为是运算子，本来应该是传址 (Reference)，就会变成了传值 (Value)！看看以下的例子就知道了：Call MyRoutine(Text1) 正确意思是要将 Text1 这个控制项传入 MyRoutine 中，但是如果拿掉 Call 这个字，VB 传给 MyRoutine 的却变成了 Text1 的内含值了！也就是 Text1.text。MyRoutine(Text1) 错误MyRoutine 要的本来是一个控制项，结果却传入了一个字串，您会得到一个《type-mismatch / 资料型态不符》29、输入时，自动转换成大写？要自动转换大小写，很多人首先想到的一定是 UCase$ 及 LCase$，但是要使用这二个函数，一定不可以在 Key_Press 事件中使用，否则您若输入《abc》，结果却变成《CBA》，为什么呢？因为当您输入 a 之后，UCase$ 会替您转换成 A，但是转换完后，滑鼠的游标会停在 A 的前面，您继续输入 b，变成了 bA，UCase$ 又替您转换成 BA，转换完后，滑鼠的游标又停在 BA 的前面，您继续输入 c，变成了 cBA，UCase$ 又替您转换成 CBA！　若您不相信，可以自己试试　在 Key_Press 中正确的作法，是判断它的参数 KeyAscii ！a 的 Asc 值是 97，A 的 Asc 值是 65，所以要自动将小写转成大写，写法如下：Private Sub Text2_KeyPress(KeyAscii As Integer)If KeyAscii >= 97 And KeyAscii <= 122 ThenKeyAscii = KeyAscii - 32End If30、输入时，自动转换成小写？要自动转换大小写，很多人首先想到的一定是 UCase$ 及 LCase$，但是要使用这二个函数，一定不可以在 Key_Press 事件中使用，否则您若输入《ABC》，结果却变成《cba》，为什么呢？因为当您输入 A 之后，LCase$ 会替您转换成 a，但是转换完后，滑鼠的游标会停在 a 的前面，您继续输入 B，变成了 Ba，LCase$ 又替您转换成 ba，转换完后，滑鼠的游标又停在 ba 的前面，您继续输入 C，变成了 Cba，LCase$ 又替您转换成 cba！　若您不相信，可以自己试试　在 Key_Press 中正确的作法，是判断它的参数 KeyAscii ！a 的 Asc 值是 97，A 的 Asc 值是 65，所以要自动将大写转成小写，写法如下：Private Sub Text2_KeyPress(KeyAscii As Integer)If KeyAscii >= 65 And KeyAscii <= 90 ThenKeyAscii = KeyAscii + 32End IfVB问题全功略（7） [查找本页请按Ctrl+F]［上一页］（7）［下一页］31、某一天的下 (上) 一个星期几是那一天？32、移除字串中不要的字元33、通往 Internet 的捷径---捷径档的结构34、Bug：维护 Internet Transfer Control 之 Username 及 Password35、我要如何在程序中开启网页？31、某一天的下 (上) 一个星期几是那一天？参数 : 您相信吗？这个模组的写法比用任何其他的方法快几十倍！参数如下：1：以那一天为基准日？2：(Optional) 要找的是星期几？若不指定，预设值为星期六3：(Optional) 要往前 (过去) 找或往后 (未来) 找？若不指定，预设值为往后 (未来) 找程序码Public Function SpecificWeekday(ByVal D As Date, Optional ByVal WhatDay As VbDayOfWeek = vbSaturday, Optional GetNext As Boolean = True) As DateSpecificWeekday = (((D - WhatDay + GetNext) \ 7) - GetNext) * 7 + WhatDayEnd Function或许您想知道程序为什么这样写？您知道吗？在 VB 中，其所有日期函数的基准日 (第0天) 是 1899年12月30日 (星期六)，第一天就是 1899年12月31日 (星期日)，所以 VB 的 WeekDay 函数算法其实就是 (Date - 1) Mod 7 + 1。返回值日期实例 :我想知道以下日子各是那一天？上个星期一：SpecificWeekday(Now, vbMonday, False)下个星期六：SpecificWeekday(Now)2000年9月9日的下一个星期五：SpecificWeekday("09/09/2000", vbFriday)32、移除字串中不要的字符参数 : 1：要检查的字串 [准备移除其中某些字符]2：要移除的字符 (数字/中英文)程序码Function StringCleaner(s As String, Search As String) As StringDim i As Integer, res As Stringres = sDo While InStr(res, Search)i = InStr(res, Search)res = Left(res, i - 1) & Mid(res, i + 1)LoopStringCleaner = resEnd Function返回值 移除某些字符后的字串实例 :我想移除 Text1 中的字符 "A"Text1 = StringCleaner(Text1, "A")33、通往 Internet 的捷径---捷径档的结构有些软件 Setup 完后, 会在程序集或桌面上产生一个 "捷径" (ShortCut), 直接一点就可以进到特定的网页, 用 VB 要如何做才可以做到? 难吗?不难!! 其实只要稍为观查一下该捷径的档案内容, 就可以做到了.捷径档的副档名是 .url, 当然, 如果您直接用记事本去开启 .url 档, 一定会很失望, 因为很多软件的捷径档, 都是存成 Binary 的档案 (不知是否故意的), 不过别担心, 那只是障眼法而已.捷径档和 VB 的 .Frm 档一样, 不管是 AscII / Binary 都可以.我们自己要产生的, 只要做成一般文字档就可以了, 而捷径档的格式如下 :[InternetShortcut]URL=http://网址 (Internet/ Intranet 通用)然后随便存一个档名, 例如 "润泰网站.url", 只要副档名是 .url 即可.而且 Win95/Win98 很聪明, 会自动将副档名拿掉. 只 Show 出 "润泰网站"很简单吧!!! 就算您的机器不能连上 Internet, 您也可以马上感受一下 Intranet 的功能.[InternetShortcut]URL=http://Intranet主机/目录如果您连用 VB 写文字档都懒的话, 直接用记事本编辑也可以体验一下的 !!!34、Bug：维护 Internet Transfer Control 之 Username 及 Password由于 Bug，在使用 Internet Transfer Control 时，Username 及 Password 必须设定在 URL 之后，否则无效！以下的程序码是错的：Inet1.Password = "Chicken_Feet"Inet1.UserName = "JohnnyW"Inet1.URL = FTP://ftp.32X.comInet1.Text = Inet1.OpenURL但是如果改成以下之程序，将 URL 放到最前面，就可以正常执行：Inet1.URL = FTP://ftp.32X.comInet1.Password = "Chicken_Feet"Inet1.UserName = "JohnnyW"Inet1.Text = Inet1.OpenURL35、我要如何在程序中开启网页？在声明区中声明如下 (在 .bas 档中用 Public, 在 Form 中用 Private)Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long在程序中Intranet：ShellExecute Me.hWnd, "open", "http://Intranet主机/目录", "", "", 5Internet：ShellExecute Me.hWnd, "open", "http://www.ruentex.com.tw", "", "", 5很简单吧!!! 就算您的机器不能连上 Internet, 您也可以马上感受一下 Intranet 的功能.36、如何让表单一开始就显示在荧幕中央？ （含工作列）共有二种方法方法1: VB3/VB4之版本，可于 Form_Load() 程序中加入下列程式码：Me.Move (Screen.Width-Width)\2, (Screen.Height-Height)\2方法2:VB5以上之版本，则直接将 Form 之 StartUpPosition 设成 (2-荧幕中央) 即可37、如何让表单一开始就显示在荧幕中央？ （不含工作列）以下之程序在计算时会扣除工作列所占的高度 (或宽度)，如果有启动 Microsoft Office 的快捷列的话，也会扣除快捷列所占的高度 (或宽度)。Public Const SM_CXFULLSCREEN = 16Public Const SM_CYFULLSCREEN = 17#If Win32 ThenDeclare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long#ElseDeclare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer#End IfPublic Sub CenterForm(frm As Form)frm.Left = Screen.TwipsPerPixelX * GetSystemMetrics(SM_CXFULLSCREEN) / 2 - frm.Width / 2frm.Top = Screen.TwipsPerPixelY * GetSystemMetrics(SM_CYFULLSCREEN) / 2 - frm.Height / 2End Sub只要在 Form_Load 中使用 CenterForm Me 即可38、MDI Form可否跟一般的表单一样设定背景颜色 (BackColor)？VB3 以前的版本：不行。MDI Form没有此一功能。VB4 / VB5 / VB6 ：可以直接在属性表中设定！39、VB可以产生四角形以外其他形状的 Form 吗？这个问题，您一定无法想像有多容易，您可以产生任何形状的 Form，但必须借助 CreateEllipticRgn 及 SetWindowRgn 二个 API ，例如：Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPrivate Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As LongPrivate Sub Form_Load()Dim lReturn As LongMe.ShowlReturn = SetWindowRgn(hWnd, CreateEllipticRgn(10, 10, 340, 150), True)End Sub执行结果图片CreateEllipticRgn 之四个参数说明如下：X1：椭圆中心点之X轴位置，但以 Form 的实№边界为限。Y1：椭圆中心点之Y轴位置，但以 Form 的实№边界为限。X2：椭圆长边的长度Y2：椭圆短边的长度的40、如何让一个 Form 出现在另一个非 MDIForm 的 Form 中？假设要将 Form2 放在 Form1 中，请在宣告区中宣告：Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long在 Form2 中的 Form_Load 中加入 SetParent(Me.hWnd, Form1.hWnd) 即可。但有一点要注意的是，在 Unload Form1 之前一定要先 Unload Form2。VB问题全功略（9） [查找本页请按Ctrl+F]［上一页］（9）［下一页］41、如何产生渐层的 Form 背景？42、Set FormName = Nothing43、如何移除 Form 右上方之『X』按钮？44、如何制作透明的表单 (Form)？45、在抓取资料库之资料前先计算资料总笔数41、如何产生渐层的 Form 背景？在 Form_Load 中加入以下程序码Sub Form_Load()Form1.AutoRedraw = True‘使 Form 物件的自动重绘有效Form1.DrawStyle = 6‘直线的样式为内实线 (6-vbInsideSolid)Form1.DrawMode = 13‘copy Pen-由 ForeColor 属性指定的颜色。(13-vbCopyPen)Form1.DrawWidth = 2‘输出的线宽为 2 像素 (Pixel)‘为绘图或列印建立一自订的座标比例尺‘图形像素为显示器或印表机解析度的最小单位Form1.ScaleMode = 3‘设定物件座标的量测单位为像素 (3-VbPixels)Form1.ScaleHeight = (256 * 2)‘设定垂直量测单位值为 512For i = 0 To 255Form1.Line (0, Y)-(Form1.Width, Y + 2), RGB(0, 0, i), BFY = Y + 2Next i‘RGB(red, green, blue)‘B : 使一方块用一指定方块对角的座标画出‘F : 指定此方块系以用来画方块的色彩来加以填满 (有B才可用F)End Sub42、Set FormName = Nothing语法：Set objectvar = {[New] objectexpression | Nothing}Nothing 为选择性引数。停止 objectvar 和任何特定物件的关连。指定 objectvar 为 Nothing，会在没有其它变数引用时，释放所有与先前物件有关的系统和内存资源。当 objectvar 设定成 FormName 时，会将该 Form 中所有占用内存的物件所占用的内存通通释放。虽然有人说 VB 在 Form Unload 时会自动释放内存，但是并不是全部!!就像有人说, VB 程序要 Make EXE 之前最好先结束 VB, 重新载入该 Project 再 Make EXE, 结果执行档会比较小, 为什么 ? 就是少了一些在内存中的垃圾 !!43、如何移除 Form 右上方之『X』按钮？其实 Form 右上方之三个按钮分别对应到 Form 左上方控制盒 (ControlBox) 中的几个选项 (缩到最小 / 放到最大 / 关闭)，而其中的最大化 (MaxButton) 及最小化 (Minbutton) 都可以直接在 Form 的属性中设定，但是 VB 并没有提供设定『X』按钮的功能！要达到这个功能，必须借助 API：由于『X』按钮对应到 ControlBox 的关闭选项，所以我们只要移除系统 Menu (就是ControlBox) 的关闭选项即可！您自己可以先看看您现在使用的 Browser 左上方的系统 Menu，【关闭】选项是在第几个，不是第 6 个！是第 7 个，分隔线也算一个！分隔线才是第 6 个！当我们移除了关闭选项之後，会留下一条很奇怪的分隔线，所以最好连分隔线也一并移除。而 Menu 的 Index 是从 0 开始，分隔线是第 6 个，所以 Index = 5。修正：为了让程序码在 Windows NT 也能运作正常，将各 Integer 型态改成 Long。 89.05.04‘抓取系统 Menu 的 hwndPrivate Declare Function GetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hwnd As Long, ByVal bRevert As Long) As Long‘移除系统 Menu 的 APIPrivate Declare Function RemoveMenu Lib "user32" Alias "RemoveMenu" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long‘第一个参数是系统 Menu 的 hwnd‘第二个参数是要移除选项的 Index44、如何制作透明的表单 (Form)？请在声明区中放入以下声明Const GWL_EXSTYLE = (-20)Const WS_EX_TRANSPARENT = &H20&Const SWP_FRAMECHANGED = &H20Const SWP_NOMOVE = &H2Const SWP_NOSIZE = &H1Const SWP_SHOWME = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZEConst HWND_NOTOPMOST = -2Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long在 Form_Load 使用的范例如下：Private Sub Form_Load()SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENTSetWindowPos Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWMEMe.RefreshEnd Sub45、在抓取资料库之资料前先计算资料总笔数Sub Form1_Load()Dim db As DatabaseDim ds As SnapshotDim iNum As Integer ‘总笔数Dim wsql As String ‘SQL字串wsql = "Select Count (*) from Authors Where AU_ID > 10"Set db = OpenDatabase("c:\vb\biblio.mdb")Set ds = db.CreateSnapshot(wsql)iNum = ds(0)MsgBox "总笔数为 " + Str$(iNum)End Sub怎么样，是不是一样呢，只差在一个是 ADO，一个是 DAO 而已！46、程序启动时，如何自动判断 Access 资料库是否损毁并自动修复？若程序使用 Access 资料库开发，当 Access 资料库损毁时，一进入程序，便会出现以下讯息：Can‘t open database ‘name‘. It may not be a database that your application recognizes, or the file may be corrupt. (Error 3049)若是程序中未加入错误判断，程序便会中断跳出，这会给予使用者极不好的印象，要避免这种情形，甚至不让使用者发现资料库损毁，便要加入以下之程序码加以判断：Private Sub Form_Load()Dim db As DatabaseOn Error GoTo error1Set db = OpenDatabase("c:\test.mdb")On Error GoTo 0: ‘正常程序开始:Exit Suberror1:If Err = 3049 Then ‘资料库损毁DBEngine.RepairDatabase "C:\test.mdb"ResumeElseMsgBox Err & Error(Err)End If47、如何让程序在 Windows 启动时自动执行？有以下二个方法：方法1: 直接将快捷方式放到启动群组中。方法2:在注册档 HKEY_LOCAL_MACHINE 中找到以下机码\Software\Microsoft\Windows\CurrentVersion\Run新增一个字串值，包括二个部份1. 名称部份：自己取名，可设定为 AP 名称。2. 资料部份：则是包含 ‘全路径档案名称‘ 及 ‘执行参数‘例如：Value Name = NotepadValue Data = c:\windows\notepad.exe48、如何让程序在新 User Login 时自动执行？在注册表中 HKEY_CURRENT_USER 找到以下代码\Software\Microsoft\Windows\CurrentVersion\Run新增一个字串值，包括二个部份1. 名称部份：自己取名，可设定为 AP 名称。2. 资料部份：则是包含 ‘全路径档案名称‘ 及 ‘执行参数‘例如：Value Name = NotepadValue Data = c:\windows\notepad.exe49、已将 TextBox 的 Alignment 属性设为「1-靠右对」(1-RightJustify)，但文字却未向右靠？欲将 TextBox 内的文字向右靠，除了将 Alignment 属性设为「1-靠右对　」之外，亦　将 MultiLine 属性设为 True。但是若您希望只有单行，不要多行，则必须判断 User 是否按了 Enter Key，那只好在 TextBox 的 KeyPress 中加入以下程序码，以去除 Enter 的作用：Private Sub Text1_KeyPress(KeyAscii As Integer)If KeyAscii = vbKeyReturn ThenKeyAscii = 0End If50、在 TextBox 中如何限制只能输入数字？参考下列程序：Sub Text1_KeyPress(KeyAscii As Integer)If KeyAscii < 48 Or KeyAscii > 57 ThenKeyAscii = 0End IfEnd Sub51、我希望 TextBox 中能不接受某些特定字符，例如 ‘@#$%"，有没有简单一点的写法？方法有好几种, 以下列举二种：方法1: 可以使用 IF 或 Select Case 一个个判断, 但如果不接受的字符多时, 较麻烦!方法2: 将要剔除的字符统统放在一个字串中，只要一个 IF 判断即可 !! 如下：Private Sub Text1_KeyPress(KeyAscii As Integer)Dim sTemplate As StringsTemplate = "!@#$%^&*()_+-="   ‘用来存放不接受的字符If InStr(1, sTemplate, Chr(KeyAscii)) > 0 ThenKeyAscii = 0End IfEnd Sub52、如何让鼠标进入 TextBox 时自动选定 TextBox 中之整串文字？这个自动选定反白整串文字的动作，会使得输入的资料完全取代之前在 TextBox 中的所有字符。Private Sub Text1_GotFocus()Text1.SelStart = 0Text1.SelLength = Len(Text1)End Sub53、如何让 TextBox 由 Insert 模式变成 Overwrite 模式？Windows 的 TextBox 一直都只支援 Insert Mode，而不支援 OverStrike(OverWrite) Mode，其实，只要在 Key_Press 事件中加上几行指令，就可以做到 OverStrike 功能 !!以下的程式码中，只设定 SelLength=1，而 SelStart 若未指定则会一直跟著滑鼠的游标所在处，设定 SelLength=1 会反白游标所在处的下一个字，但是由于您输入的字元会直接取代该反白的字元(都同时在 Key_Press 发生)，所以您并不会看到字符被选定反白 (Marked)，若是游标已在字串的最后面，则会直接忽略这个动作。以下的程式码中同时也作了以下的错误判断及预防：1. 当输入的是退格符，也就是 Backspace (character 8)。2. 当输入的是 return 键 (character 13)。3. 事先已作了选定动作 (Marked)。Sub Text1_KeyPress(KeyAscii As Integer)If KeyAscii <> 8 And KeyAscii <> 13 And Text1.SelLength = 0 ThenText1.SelLength = 1End IfEnd Sub54、如何使 TextBox 变成只读，卷动杆可卷动，但是不出现游标，也不可被选定反白？在 Form 中放一个 TextBox，设定 Locked = True，MultiLine = True，ScrollBar = 2 - Vertical。另外再放一个 CommandButton (或其他任何可接受 Focus 的物件)，此物件可由您自行作其他用途，否则设定 Command1.left = -1000 将其移到 Form 的外面。程式码如下：Private Sub Text1_GotFocus()‘马上将 Text1 的 focus 转移到 Command1 或其他物件上Command1.SetFocusEnd Sub55、文字框可以设定快捷键吗？不行，要设定快捷键的先决条件，是该物件必须有 Caption 属性，但是 TextBox (文字框) 只有 Text 属性，并无 Caption 属性，所以文字框本身是不能设定快捷键的！完全没办法吗？但是还是有办法的！人家说山不转路转，文字框本身不能设定快捷键，一般我们在文字框的左方都会放置说明用的 Label，那我们就借用 Label 来做到这个功能，作法如下：1、将文字框的 TabIndex 设成说明用的 Label 物件的下一个。2、设定 Label 物件的快捷键，奇怪吗？Label 物件没有 Focus 好像不要快捷键！没错，我们就是要利用 Label 物件不要快捷键的特性来达到我们的要求！当您输入了 Label 物件的快捷键，由于 Label 物件没有 Focus 不接受快捷键，于是它立刻将 Focus 送到下一个 TabIndex 的物件，也就是 TextBox 文字框了！56、如何检查软盘驱动器里是否有软盘？使用：Dim Flag As BooleanFlag = Fun_FloppyDrive("A:")If Flag = False Then MsgBox "A:驱没有准备好，请将磁盘插入驱动器！", vbCritical‘-------------------------------‘函数:检查软驱中是否有盘的存在‘-------------------------------Private Function Fun_FloppyDrive(sDrive As String) As BooleanOn Error Resume NextFun_FloppyDrive = Dir(sDrive) <> ""End Function57、如何弹出和关闭光驱托盘？Option ExplicitPrivate Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As LongPrivate Sub Command1_Click()mciExecute "set cdaudio door open" ‘弹出光驱Label2.Caption = "弹 出"End SubPrivate Sub Command2_Click()Label2.Caption = "关 闭"mciExecute "set cdaudio door closed" ‘合上光驱Unload MeEndEnd Sub58、如何计算出本月的最后一天首先为下个月的第一天生成一个顺序数值，然后再减去一天Private Sub Command1_Click()Dim dtl As Datedtl = DateSerial(Year(Now), Month(Now) + 1, 1) - 1MsgBox dtlEnd Sub59、如何让你的程序在任务列表隐藏Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As LongPrivate Declare Function GetCurrentProcessId Lib "kernel32" () As Long‘请你试试 Ctrl+Alt+Del 是不是你的程序隐藏了Private Sub Command1_Click()i = RegisterServiceProcess(GetCurrentProcessId, 1)End Sub60、如何利用API实现代码延时执行声明:Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)调用:Sleep 3000 ‘延时3秒执行VB问题全功略（13） [查找本页请按Ctrl+F]［上一页］（13）［下一页］61、若画面上 ListBox 中可显示的项目数量为 5 条，而 ListBox 中的资料总数已超过 5 条，如何让新加入 ListBox 的项目能够马上显示在 ListBox 的最后一条〈画面上显示最后 5 条，含新加入之资料〉？62、如何事先选定 ListBox 或 ComboBox 的某一个 Item？63、模拟 IE 的 地址栏：智慧型下拉式 Combo64、如何让 ListBox 同一列显示二栏以上的栏位？65、如何控制二栏以上 ListBox 之各栏位宽度？61、若画面上 ListBox 中可显示的项目数量为 5 条，而 ListBox 中的资料总数已超过 5 条，如何让新加入 ListBox 的项目能够马上显示在 ListBox 的最后一条〈画面上显示最后 5 条，含新加入之资料〉？使用 TopIndex 配合 ListCount 属性即可，而且不会更改原来的选取状态。List1.AddItem "xxx" ‘xxx 指新加入之资料List1.TopIndex = List1.ListCount - n ‘n=5 就是画面上 ListBox 可看到的条数62、如何事先选定 ListBox 或 ComboBox 的某一个 Item？有二个方法：方法1: 使用 For Loop 一一比对，再设定 ListIndex 即可，只是项目多时比方法2慢。例如：Dim i As IntegerFor i = 0 To List1.ListCount - 1If List1.List(i) = "搜寻的字串" ThenList1.ListIndex = iExit ForEnd IfNext方法2: ‘16位版本：Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As LongConst WM_USER = &H400Const LB_SELECTSTRING = (WM_USER + 13)Const CB_SELECTSTRING = (WM_USER + 13)‘32 位版本： ( Integer 改成 Long )Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongConst WM_USER = &H400Const LB_SELECTSTRING = &H18CConst CB_SELECTSTRING = &H14DSub SelectListItem(lst As Control, Idx As String)Dim i As LongIf TypeOf lst Is ComboBox Theni = SendMessage(lst.hwnd, CB_SELECTSTRING, -1, ByVal Idx)Elsei = SendMessage(lst.hwnd, LB_SELECTSTRING, -1, ByVal Idx)End IfEnd Sub在必要的时候，例如 Form_Load，只要 call SelectListItem(ControlName, StringToFind) 即可，不管是 ListBox 或 Combobox，本范例都适用。63、模拟 IE 的 地址栏：智慧型下拉式 Combo不知您是否有注意到？您在 IE 的地址栏直接输入地址的时候，如果您输入的地址前面几位和下拉式 Combo 中现存的地址相同时，IE 便会自动带出该地址资料放在 Combo 的 Text 框中，而且这串字有一个特性，在滑鼠游标之前的字是未选定反白的，而在滑鼠游标之后的字则是已经选定反白的，它的目的有二个：1. 如果您要输入的整串字和它带出的字完全一样，就可以不用再输入，可以节省时间。2. 如果您要输入的整串字和它带出的字不一样，您还是可以继续输入，继续输入的字串会自动取代后面那串已经选定反白的字串。以下的范例，只处理英文字，若要处理其他情形如数字，请自行略加更改，请先在 Form1 中放一个 Combo，然后将以下程式直接 Copy 进去即可：Dim strCombo As StringConst WM_SETREDRAW = &HBConst KEY_A = 65Const KEY_Z = 90Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Sub combo1_KeyUp(KeyCode As Integer, Shift As Integer)Dim x%Dim strTemp$Dim nRet&If KeyCode >= KEY_A And KeyCode <= KEY_Z Then‘only look at letters A-ZstrTemp = Combo1.TextIf Len(strTemp) = 1 Then strCombo = strTempnRet& = SendMessage(Combo1.hwnd, WM_SETREDRAW, False, 0&)For x = 0 To (Combo1.ListCount - 1)If UCase((strTemp & Mid$(Combo1.List(x), Len(strTemp) + 1))) = UCase(Combo1.List(x)) ThenCombo1.ListIndex = xCombo1.Text = Combo1.List(x)Combo1.SelStart = Len(strTemp)Combo1.SelLength = Len(Combo1.Text) - (Len(strTemp))strCombo = strCombo & Mid$(strTemp, Len(strCombo) + 1)Exit ForElseIf InStr(UCase(strTemp), UCase(strCombo)) ThenstrCombo = strCombo & Mid$(strTemp, Len(strCombo) + 1)Combo1.Text = strComboCombo1.SelStart = Len(Combo1.Text)ElsestrCombo = strTempEnd IfEnd IfNextnRet& = SendMessage(Combo1.hwnd, WM_SETREDRAW, True, 0&)End IfEnd SubPrivate Sub Form_Load()Combo1.AddItem "AAAAAAAA"Combo1.AddItem "ABBBBBBB"Combo1.AddItem "ABCCCCCC"Combo1.AddItem "ABCDDDDD"Combo1.AddItem "ABCDEEEE"Combo1.AddItem "ABCDEFFF"Combo1.AddItem "ABCDEFGG"Combo1.AddItem "ABCDEFGH"End Sub64、如何让 ListBox 同一列显示二栏以上的栏位？要让 ListBox 显示二栏以上，有很多方法：有人用二个字串中间加上空白来 AddItem，但是这样有一个很大的缺点，就是第二栏常常无法对齐！有人说可以加上 Format 来强迫留白，以便对齐，但是这些方法都比较麻烦，没有效率！有一个很简单，又保证不用伤脑筋就可以对　的方法，就是使用 vbTab！作法如下：lstMyListBox.AddItem "0001" & vbTab & "王一" & vbTab & "广州市"lstMyListBox.AddItem "0002" & vbTab & "丁二" & vbTab & "上海市"lstMyListBox.AddItem "0003" & vbTab & "张三" & vbTab & "北京市"lstMyListBox.AddItem "0004" & vbTab & "李四" & vbTab & "重庆市"65、如何控制二栏以上 ListBox 之各栏位宽度？使用 vbTab 来设定 ListBox 的多栏显示，效果不错，但是若以 vbTab 来做，每栏长度是固定的，只有 8，我的资料有些字串很长，有些很短，如果可以逐栏设定宽度，那就太完美了！但是单用 VB 的基本函数，是做不到的！不过我们可以 Call API：假设要放到 ListBox 的资料有四个栏位，如下：1、员工编号 (长度为6)2、员工姓名 (长度为6)3、员工住址 (长度为38)4、员工性别 [长为4]Const LB_SETTABSTOPS = &H192Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongSub SetListTabStops(iListHandle As Long)‘ 设定四个栏位, 长度各为 6,6,38,4‘ iListHandle = the window handle of the list boxDim iNumColumns As LongDim iListTabs(3) As LongDim Ret As LongiNumColumns = 4iListTabs(0) = 24 ‘ 24/4 = 6 (第1-第6字节)iListTabs(1) = 48 ‘ 48/4 = 12 (第7-第12字节)iListTabs(2) = 200 ‘ 200/4 = 50 (第13-第50字节)iListTabs(3) = 216 ‘ 216/4 = 54 (第51-第54字节)Ret = SendMessage(iListHandle, LB_SETTABSTOPS, _iNumColumns, iListTabs(0))End SubPrivate Sub Form_Load()Call SetListTabStops(List1.hwnd)List1.AddItem "0001" & vbTab & "王一" & vbTab & "广州市市体育东路二段120巷176号" & vbTab & "男"List1.AddItem "0002" & vbTab & "丁二" & vbTab & "北京市中关村路100号" & vbTab & "男"List1.AddItem "0003" & vbTab & "张三" & vbTab & "上海市中山路150巷26号" & vbTab & "女"List1.AddItem "0004" & vbTab & "李四" & vbTab & "重庆市福州路99号" & vbTab & "男"66、ListBox 选项资料太长，如何设定 ListBox 的水平卷动轴？VB 的 ListBox 并没有水平卷动轴的功能，如果遇到某一个资料项很长时， 使用者就无法看到这一个资料项的所有内容，要如何设定水平卷动轴给 ListBox?可利用 SendMessage 传送 LB_SETHORIZONTALEXTENT 讯息给 ListBox，此一讯息的作用就是要求ListBox 设定水平卷动轴， 细节如下：1. API 的声明：‘16位Const WM_USER = &H400Const LB_SETHORIZONTALEXTENT = (WM_USER + 21)Private Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long‘32位Const LB_SETHORIZONTALEXTENT = &H194Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long2. 程序范例：‘ List1 为 ListBox 的名称Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, 水平卷动轴的宽度, ByVal 0&)特别注意：以上的水平卷动轴宽度的单位是 pixel(像素)，或许您会认为这个宽度就是 ListBox 的宽度，但是结果却不是这样的，它真正指的是这个卷动轴要卷动的文字的宽度，所以您要预留可能放到 ListBox 内的资料最长的长度，若留得太短，可能出现以下二种情形：1、 水平卷动轴的宽度设的比 ListBox 本身的宽度还短，VB会认为不需要卷动轴，而不产生卷动轴！2、 水平卷动轴的宽度设的比 ListBox 内的资料宽度还短，则只能卷动一半，还是看不到完整内容！67、ListBox 选项资料太长，如何使用 ToolTip 来显示内容？ListBox 选项资料太长，虽然可以加上水平卷动轴，但卷来卷去还是有点麻烦，如果可以出现 Popup ToolTip 就更正点了！当然，您若想要二种功能一起使用，也是可以的。关于这个主题，我看过很多范例都是使用 API 来做，但是以下这个方法既简单，又不必使用任何 API，帅吧！Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim YPos As Integer, iOldFontSize As IntegeriOldFontSize = Me.Font.SizeMe.Font.Size = List1.Font.SizeYPos = Y \ Me.TextHeight("Xyz") + List1.TopIndexMe.Font.Size = iOldFontSizeIf YPos < List1.ListCount ThenList1.ToolTipText = List1.List(YPos)ElseList1.ToolTipText = ""End IfEnd Sub68、如何加长 ComboBox 的下拉选单？Combo 预设的下拉长度只有 5,6 个选项，当选项很多时，要卷老半天才能找到资料，很不方便！要加长 ComboBox 的下拉选单，方法如下：在声明区中放入以下声明及 SubroutinePrivate Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As LongPublic Sub SetComboHeight(oComboBox As ComboBox, lNewHeight As Long)Dim oldscalemode As Integer‘ This procedure does not work with frames: you‘ cannot set the ScaleMode to vbPixels, because‘ the frame does not have a ScaleMode Property.‘ To get round this, you could set the parent control‘ to be the form while you run this procedure.If TypeOf oComboBox.Parent Is Frame Then Exit Sub‘ Change the ScaleMode on the parent to Pixels.oldscalemode = oComboBox.Parent.ScaleModeoComboBox.Parent.ScaleMode = vbPixels‘ Resize the combo box window.MoveWindow oComboBox.hwnd, oComboBox.Left, oComboBox.Top, oComboBox.Width, lNewHeight, 1‘ Replace the old ScaleModeoComboBox.Parent.ScaleMode = oldscalemodeEnd Sub在任何时候 (不一定是 Form_Load 或 Combo_DropDown)，想要加长 ComboBox 的下拉选单时，只要加入以下程序即可：Call SetComboHeight(Combo1, 270) ‘设定的单位是 Pixels69、如何加宽 ComboBox 的下拉选单？和 ListBox 一样， ComboBox 也会有宽度不够的情形， Combo 下拉之后资料看不完整，当 Form 上的物件不多时，还可以拉长一点，但有时候也没办法！这时候，还是得靠 API 了！在声明区中放入以下声明及 SubroutinePrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As LongConst CB_SETDROPPEDWIDTH = &H160Public Sub SetComboWidth(oComboBox As ComboBox, lWidth As Long)‘ lWidth 是宽度，单位是 pixelsSendMessage oComboBox.hwnd, CB_SETDROPPEDWIDTH, lWidth, 0End Sub在任何时候 (不一定是 Form_Load 或 Combo_DropDown)，想要加宽 ComboBox 的下拉选单时，只要加入以下程序即可 (若设定的宽度小于 Combo 原来的宽度则无效)：Call SetComboWidth(Combo1, 270) ‘设定的单位是 Pixels70、如何用程序控制滑鼠游标 (Mouse Cursor) 到指定位置？以下这个例子，当 User 在 Text1 中按下 ‘Enter‘ 键后，滑鼠游标会自动移到 Command2 按钮上方请在声明区中加入以下声明：‘16 位版本： ( Sub 无传回值 )Declare Sub SetCursorPos Lib "User" (ByVal X As Integer, ByVal Y As Integer)‘32 位版本： ( Function 有传回值，Integer 改成 Long )Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long‘在 Form1 中加入以下程序码：Private Sub Text1_KeyPress(KeyAscii As Integer)If KeyAscii = 13 Thenx% = (Form1.Left + Command2.Left + Command2.Width / 2 + 60) / Screen.TwipsPerPixelXy% = (Form1.Top + Command2.Top + Command2.Height / 2 + 360) / Screen.TwipsPerPixelYSetCursorPos x%, y%End IfEnd Sub71、如何用鼠标移动没有标题的 Form，或移动 Form 中的控制项？在声明区中放入以下声明：‘16 位版本： ( Sub 无返回值 )Private Declare Sub ReleaseCapture Lib "User" ()Private Declare Sub SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Long)‘32 位版本： ( Function 有返回值，Integer 改成 Long )Private Declare Function ReleaseCapture Lib "user32" () As LongPrivate 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 WM_SYSCOMMAND = &H112Const SC_MOVE = &HF012‘若要移动 Form，程序码如下：Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim i As Longi = ReleaseCapturei = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0)End Sub‘以上功能也适用于用鼠标在 Form 中移动控制项，程序码如下：Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim i As Longi = ReleaseCapturei = SendMessage(Command1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0)End Sub72、如何判断目前电脑中所有磁盘之型态？在 Form 中放置一个 ListBox 名称为 List1Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongPrivate Sub Form_Load()Dim i As IntegerDim ret As Long ‘返回值Dim wtype As String ‘磁盘型态For i = 65 To 90 ‘ASC(A) ~ ASC(Z)wtype = ""ret = GetDriveType(Chr$(i) & ":\") ‘传入磁盘代号Select Case retCase 2wtype = "软盘"Case 3wtype = "硬盘"Case 4wtype = "网路磁盘"Case 5wtype = "光盘"End SelectIf wtype <> "" Then List1.AddItem Chr$(i) & ":\" & vbTab & wtypeNextEnd Sub若是 16 位程序，声明略有不同，如下：Private Declare Function GetDriveType Lib "Kernel" (ByVal nDrive As Integer) As Integer传入的参数型态是 Integer，0 代表 A 磁盘，依次加 1，2 代表 C 磁盘。73、检查文件是否存在？Function FileExists(filename As String) As IntegerDim i As IntegerOn Error Resume Nexti = Len(Dir$(filename))If Err Or i = 0 Then FileExists = False Else FileExists = TrueEnd Function传入之参数是含完整路径之文件名称，若文件存在，则传回 -1，否则返回 0。74、如何用 Image 来做成带有图片的按钮，按下鼠标时如同按钮般会变换图片？在 Form 中放三个 Image Control，名称分别为 Image1、LockOpen、LockClosed，并设定好 LockOpen 及 LockClosed 的 Picture 属性为开启及关闭的 Icon，然后Sub Form_Load()Image1.Picture = LockOpen.PictureEnd SubSub Image1_Click()Static LockedFlag As IntegerIf LockedFlag ThenImage1.Picture = LockOpen.PictureElseImage1.Picture = LockClosed.PictureEnd IfLockedFlag = Not LockedFlagEnd Sub以上之程序代码虽然在 VB 的各个版本都适用，但 VB 6.0 的 CommandButton 已经可以放置图片了，所以 VB 6.0 可以直接使用 CommandButton 达到以上功能！75、听说 VB 6.0 的 CommandButton 己经可放图片，要如何使用？先将 Style 属性设成 「1 - 图片外观」，再设定 Picture 属性即可。若希望 Mouse_Down 时可改变图片，则需要再设定 DownPicture 属性。若希望按钮 Disable 时可改变图片，则需要再设定 DisabledPicture 属性。76、同一个 Form 中若要将 OptionButton 分组，该如何做？在同一个 Container 中，只能放置一组 OptionButton，所以若要在一个 Form 中放置一组以上之 OptionButton 时，必须以不同之 Container 区隔。而在 VB 中可当作 Container 的物件有 Form / PictureBox / Frame ...等。77、VB 32-bits 之后的版本，无论用 Len 或是 LenB 都无法正确的计算中英文混合字串的长度，有没有解决的办法？这是由于 VB 32-bits 都是采 Unicode，Unicode 的储存方式无论中英文字，均是以 2bytes 来储存，有两个方式可以解决：解法1: ‘假设欲计算字串 str1 的长度Dim str1 As StringDim i As LongDim c As LongDim n As LongFor i = 1 To Len(str1)c = Asc(Mid(Str, i, 1))If c >= 0 And c < 128 Thenn = n + 1 ‘计算英文Elsen = n + 2 ‘计算中文End IfNext i解法2: Lenb(Strconv("abcd中英文混合字efg", vbFromUnicode))78、Visual Basic 程式开发完成后，可否把执行时相关的文档一并销售？在下列条件下可以不须支付权利金便可以重制并散布 Run-time Modules (限于可执行文档、安装文档、ISAM 和Rebuild文档)：1.将 Run-time Modules 配合作为您的软件的一部份一同散布。2.不使用微软的名称，标章或商标来行销您的软体。3.附加一个您软件的有效著作权通知。4.同意对微软或其供应商因为您软体的散布和使用所导致的请求、诉讼，包括律师费、赔偿、为微软或其供应商辩护使其不受损害。79、我想知道某一部电脑出现在 "网路上的芳邻" 时的名称，也就是"电脑名称"，该如何做？其实出现在 "网路上的芳邻" 中的名称, 就是我们在 "控制面板" --> "网路" --> "个人资料" --> "电脑名称" , 要抓这个名称, 有好几个方法, 但有的比较复杂, 例如, 直接从注册表抓, 以下的方法则比较简单. (　 VB4-32 以上)请在声明区中放入以下声明 :Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As LongPublic Function ComputerName() As StringDim cn As StringDim ls As LongDim res As Longcn = String(1024, 0)ls = 1024res = GetComputerName(cn, ls)If res <> 0 ThenComputerName = Mid(cn, 1, InStr(cn, Chr(0)) - 1)ElseComputerName = ""End IfEnd Function程序中要使用时只要直接 call 即可.例 : Msgbox "ComputerName=" & ComputerName80、我想知道某一部电脑目前的 Login User 是谁，该如何做？请在声明区中放入以下声明 :Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As LongPublic Function UserName() As StringDim cn As StringDim ls As LongDim res As Longcn = String(1024, 0)ls = 1024res = GetUserName(cn, ls)If res <> 0 ThenUserName = Mid(cn, 1, InStr(cn, Chr(0)) - 1)ElseUserName = ""End IfEnd Function程序中要使用时只要直接 call 即可.例 : Msgbox "UserName=" & UserName81、我已经知道 "电脑名称" 及 "LoginUser" 的抓法了, 我可以将电脑名称改成 LoginUser 吗？可以的, 请在声明区中放入以下声明:Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long程序中要使用时只要直接 call 即可. 例如: 要将电脑名称改成员工编号 "RT000588"Private Sub Command1_Click()Dim res As Longres = SetComputerName("RT000588")If res <> 0 ThenMsgBox "成功!!!"ElseMsgBox "有问题!!!"End IfEnd Sub虽然已经更改成功，但并不会马上有作用，所以在网路上的芳邻中，还会是旧的电脑名称，一直要等到重新开机之后才有作用。82、反向思考---怎样让程序跑慢一点？大部份时间，我们都希望我们自己开发的程序跑得越快越好，但是有些状况，我们却希望它能够稍微停一下，等待某一个返回值或某一个动作做完了，才继续执行下一个指令，可是偏偏 VB 没有提供这样的指令，我要怎样延迟一个VB程序呢 　在声明区中加入以下声明:Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)在事件中只要 call 它即可Call Sleep(1000) ‘1000代表延迟1秒不过很抱歉，它只在 32位元中才有提供, 所以要在 VB4-32 位元以上才可使用 !!!83、《打砖块》一颗在画面上跳动碰撞的小球这个范例加以引申，就可以做出像一样的游戏！‘在 Form 中放一个 Shape，Shape 属性设成 3-圆形，长宽设成 60‘在 Form 中放一个 Timer，Interval 属性设成 48‘声明二个 Form Level 或 Global 变数 (此范例声明在 Form 中)Dim horizan As IntegerDim vertical As Integer‘在 Form_Load 设定每次水平或垂直移动的距离Private Sub Form_Load()horizan = 50 ‘水平移动的距离vertical = 50 ‘垂直移动的距离End Sub‘移动小球并检查是否超出四个边界 ? 若超过则改变方向.‘注意: Me.Width 包含 Form 左右二边 Border 的宽度‘ Me.Height 包含 Form 上方 TitleBar 的高度及下方 Border 的高度Private Sub Timer1_Timer()ball.Move ball.Left + horizan, ball.Top + verticalIf ball.Top <= 0 Then vertical = -verticalIf ball.Top + ball.Height >= Me.Height - 420 Then vertical = -vertical‘扣除 420 是指 Form 上方 TitleBar 的高度 + 下方 Border 的高度If ball.Left <= 0 Then horizan = -horizanIf ball.Left + ball.Width >= Me.Width - 100 Then horizan = -horizan‘扣除 120 是指 Form 左右二边 Border 的宽度End Sub如果是固定的 Form，以上的程序代码就已经完成了，但是如果 Form 的大小是可以调整的话，当您调整 Form 的大小后，小球的位置可能有一段时间会跑到荧幕外，要预防这种情形，必须再加上以下的程序代码：Private Sub Form_Resize()If ball.Top <= 0 Thenball.Top = -25vertical = -verticalEnd IfIf ball.Top >= (Me.Height - 420) Thenball.Top = (Me.Height - 445) - ball.Heightvertical = -verticalEnd IfIf ball.Left <= 0 Thenball.Left = -25horizan = -horizanEnd IfIf ball.Left >= (Me.Width - 100) Thenball.Left = (Me.Width - 125) - ball.Widthhorizan = -horizanEnd IfEnd Sub运用时要做调整，主要就是调整以下二个因素：1、每次水平或垂直移动的距离，就是 horizan / vertical2、Timer 的间距，就是 Timer 的 Interval注：其实要完整一点的话，还需要用 API 去抓出 Form 上方 TitleBar 的高度四方 Border 的宽度。84、为什么有的程序的画面或控制项总是闪个不停，如何避免？原因很多，但最主要的原因是 ‘不停地改变一些可能不需要改变的控制项属性‘，这些属性通常是一些会造成控制项 Repaint 的属性，例如：Enabled, Visible, Contents 及 Text。如果某一个物件的属性已经是您要设定的值，那就不要再设定一次，如此便会大大降低控制项闪动的频率。例如：If Not Command1.EnabledThen Command1.Enabled=TrueEnd If以下是一个完成的 Module：Sub SetEnabled (ctrlIn as Control, bSetting as Integer)If ctrlIn.Enabled <> bSetting ThenctrlIn.Enabled=bSettingEnd IfEnd Sub85、计算二个时间的时间差VB 有提供一些好用的日期时间计算函数，但是没有一个计算时间差的功能，有些人会说有的，是 DateDiff，但是，DateDiff 功能却不够，您可以算出二个时间所差的总日数、总时数或总秒数，但您算不出是相差几天几小时几分钟又几秒钟！以下这个模组的功能就是计算二个时间之时间差：Function Convtime(date1 As Date, date2 As Date) As String‘‘功能 : 计算二个时间的时间差‘‘参数 : date1 是较早的时间, Variant (Date)。‘ date2 是较晚的时间, Variant (Date)。‘‘若要计算两个日期之时间差，计算顺序是从 date1 到 date2‘‘返回值 : 时间差的组合字串, 例如 2年21天13小时5分钟3秒‘Dim wsecond As Long ‘总秒数 / 剩余秒数Dim wminute As Long ‘总分钟数 / 剩余分钟数Dim whour As Long ‘总时数 / 剩余时数Dim wday As Long ‘总天数 / 剩余天数Dim wyear As Long ‘总年数wsecond = DateDiff("s", date1, date2) ‘总秒数If wsecond > 60 Thenwminute = wsecond \ 60 ‘总分钟数wsecond = wsecond Mod 60 ‘计算剩余秒数End IfIf wminute > 60 Thenwhour = wminute \ 60 ‘总时数wminute = wminute Mod 60 ‘计算剩余分钟数End IfIf whour > 24 Thenwday = whour \ 24 ‘总天数whour = whour Mod 24 ‘计算剩余时数End IfIf wday > 365 Thenwyear = wday \ 365 ‘总年数wday = wday Mod 365 ‘计算剩余天数End If‘拼凑计算结果字串If wyear > 0 Then Convtime = Convtime & wyear & "年"If wday > 0 Then Convtime = Convtime & wday & "天"If whour > 0 Then Convtime = Convtime & whour & "小时"If wminute > 0 Then Convtime = Convtime & wminute & "分钟"If wsecond > 0 Then Convtime = Convtime & wsecond & "秒"End Function当然，或许您要的结果不是我算出的字串，可能要算几周！但是只要将以上的程序稍作修改，就可以得到您要的结果！86、处理加了密码的 Access 资料库当 Access 资料库加了密码，直接由 Access 开启资料库时，会出现密码问话框，询问密码。但是若要由 VB 程序中开启，必须更改 VB 程序中开启资料库的指令，否则会出现错误讯息！以下针对各种状况，分别加以说明：1、 使用 DAO 语法开启资料库：OpenDatabase若要由程序中开启，语法如下：Set DB = OpenDatabase(DatabaseName, False, False, ";Pwd=密码")实例例如：Dim db As DatabaseSet db = OpenDatabase("C:\db1.mdb", False, False, ";Pwd=1")若要使用 Data 控制项，设定方法如下：1、设定 DatabaseName 属性 (资料库名称 / 含路径)2、设定 Connect 属性，将预设的字串 "Access" 改成 ";Pwd=密码" (不含双引号)3、设定 RecordSource 属性 (资料集)　2、　使用 ADO 语法开启资料库：在使用 ADODC 或 DataEnvironment 设定好连线之后，直接利用属性视窗修改 ConnectionString 属性(附属于 ADODC) 或 ConnectionSource 属性(附属于 DataEnvironment 的 Connection 物件)，修改的方法是在属性之后增加以下参数：;Jet OLEDB:Database Password=密码除了 ADODC 及 DataEnvironment 之外， 直接使用 ADO 物件来开启含有密码的 mdb 资料库，设定参数的方法也是相同的。　3、　压缩加了密码的资料库：CompactDatabaseDBEngine.CompactDataBase "原资料库档名", "新资料库档名", , , ";pwd=密码"实例例如：DBEngine.CompactDatabase "C:\Db1.mdb", "C:\Db2.mdb", , , ";pwd=1"　4、　修复加了密码的资料库： RepairDatabase不必理会资料库设定的密码！DBEngine.RepairDataBase "资料库档名"实例例如：DBEngine.RepairDataBase "C:\Db1.mdb"87、如何取消 TextBox 鼠标右键的 PopupMenu 功能自从 Microsoft Windows 进入 Windows95 之后，有一个很方便的功能，很多软件都有提供，就是鼠标右键的 PopupMenu 功能，它确实很方便，但是有时却是梦魇，那就是您不需要它的时候，它还是会自动出现！本例中的 TextBox 就是明显的例子。但是这个梦魇从 VB5.0 以后就可以解决了，因为 VB5.0 提供了 AdressOf 这个运算子，可以做回呼(callback)处理！请将以下的程序码放在 .bas 模组中，呼叫 Hook 这个 Sub 并传入 TextBox 的 hWnd 当作参数，但是切记您在 Unload Form 之前一定要呼叫 UnHook 这个 Sub，否则会产生一个 General Protection Fault！Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Const GWL_WNDPROC = -4Public Const WM_RBUTTONUP = &H205Public lpPrevWndProc As LongPrivate lngHWnd As LongPublic Sub Hook(hWnd As Long)lngHWnd = hWndlpPrevWndProc = SetWindowLong(lngHWnd, GWL_WNDPROC, AddressOf WindowProc)End SubPublic Sub UnHook()Dim lngReturnValue As LonglngReturnValue = SetWindowLong(lngHWnd, GWL_WNDPROC, lpPrevWndProc)End SubFunction WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongSelect Case uMsgCase WM_RBUTTONUP‘Do nothing‘Or popup you own menuCase ElseWindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)End SelectEnd Function在 Form_Load 事件中加入以下程序码：Call Hook(Text1.hWnd)在 Form_Unload 中加入以下程序码：Call UnHook88、如何在 Menu 中加入美美的图案？在模组中加入以下程序码：Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As LongDeclare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As LongPublic Const MF_BITMAP = &H4&Type MENUITEMINFOcbSize As LongfMask As LongfType As LongfState As LongwID As LonghSubMenu As LonghbmpChecked As LonghbmpUnchecked As LongdwItemData As LongdwTypeData As Stringcch As LongEnd TypeDeclare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As LongDeclare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As BooleanPublic Const MIIM_ID = &H2Public Const MIIM_TYPE = &H10Public Const MFT_STRING = &H0&在 Form 中加入一个 PictureBox，属性设定为：AutoSize = TruePicture = .bmp (尺寸大小为 13x13，不可设定为 .ico)在 Form_Load 中的程序码如下：Private Sub Form_Load()‘取得程序中 Mennu 的 handlehMenu& = GetMenu(Form1.hWnd)‘取得第一个 submenu 的 handlehSubMenu& = GetSubMenu(hMenu&, 0)‘取得 Submenu 第一个选项的 menuIdhID& = GetMenuItemID(hSubMenu&, 0)‘加入图片SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture‘在一个 Menu 选项中您一共可以加入二张图片‘一张是 checked 状态用，一张是 unchecked 状态用End Sub89、如何把小图片填满 Form 成为背景图？对于这个问题，我看过很多方法，有的方法很麻烦，要声明一大堆 Type，用一大堆的 API，但是有一个最笨但我认为最好的方法如下： (就好像拼磁砖一样，不用任何 API, 不必声明任何 Type)在 Form 中放一个 PictureBox，Picture 属性设定为某一张小图，AutoSize 属性性设定 True，完成的模组如下：Sub PictureTile(Frm As Form, Pic As PictureBox)Dim i As IntegerDim t As IntegerFrm.AutoRedraw = TruePic.BorderStyle = 0For t = 0 To Frm.Height Step Pic.ScaleHeightFor i = 0 To Frm.Width Step Pic.ScaleWidthFrm.PaintPicture Pic.Picture, i, tNext iNext tEnd SubPictureTile 这个模组共有二个参数，第一个是表单名称，第二个则是 PictureBox 的名称。以下为一应用实例：Private Sub Form_Load()PictureTile Me, Picture1End Sub90、如何把小图片填满 MDIForm 成为背景图？以下这个范例，　要：1、一个 MDIForm：不必设定任何属性。2、一个 Form1：不一定是 MDIChild，最好 MDIChild 为 False，但是 AutoRedraw 设成 True。3、Form1 上面放一个隐藏的 PictureBox：名称为 Picture1，不必设定 Picture 属性。4、一张图片的完整路径。‘将以下模组放入 MDIForm 的声明区中：Sub TileMDIBkgd(MDIForm As Form, bkgdtiler As Form, bkgdfile As String)If bkgdfile = "" Then Exit SubDim ScWidth%, ScHeight%ScWidth% = Screen.Width / Screen.TwipsPerPixelXScHeight% = Screen.Height / Screen.TwipsPerPixelYLoad bkgdtilerbkgdtiler.Height = Screen.Heightbkgdtiler.Width = Screen.Widthbkgdtiler.ScaleMode = 3bkgdtiler!Picture1.Top = 0bkgdtiler!Picture1.Left = 0bkgdtiler!Picture1.Picture = LoadPicture(bkgdfile)bkgdtiler!Picture1.ScaleMode = 3For n% = 0 To ScHeight% Step bkgdtiler!Picture1.ScaleHeightFor o% = 0 To ScWidth% Step bkgdtiler!Picture1.ScaleWidthbkgdtiler.PaintPicture bkgdtiler!Picture1.Picture, o%, n%Next o%Next n%MDIForm.Picture = bkgdtiler.ImageUnload bkgdtilerEnd Sub以下为一应用实例：Private Sub MDIForm_Load()TileMDIBkgd Me, Form1, "c:\windows\Tiles.bmp"End Sub91、如何让一个 app 永远保持在最上层 ( Normal on Top )请在 Form 中放一个 Timer，Interval = 1000 (或更小)，在 Timer 事件中加入以下程序码：Private Sub Timer1_Timer()Me.ZOrderEnd Sub不过这样子的 Form，只不过是一个 Normal Window。要产生真正 Topmost Window，就要使用 API 了！92、关闭指定的程序要做到像 Task Manager 一样，可以关闭指定的程序，方法如下：在声明区中放入以下声明：(16位　改成 win31 API)Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongDeclare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Const WM_CLOSE = &H10以下之范例示范如何关闭一个视窗标题 (Caption) 为 【小算盘】的程序：Dim winHwnd As LongDim RetVal As LongwinHwnd = FindWindow(vbNullString, "小算盘")Debug.Print winHwndIf winHwnd <> 0 ThenRetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)If RetVal = 0 ThenMsgBox "Error posting message."End IfElseMsgBox "并未开启小算盘程序."End If93、开启及关闭CD－Rom的门在声明区中加入以下声明：Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long开启的程序代码如下：retvalue = mciSendString("set CDAudio door open", returnstring, 127, 0)关闭的程序代码如下：retvalue = mciSendString("set CDAudio door closed", returnstring, 127, 0)94、如何知道您的机器中预设印表机的机型、驱动程序及连接埠想要抓取您机器中软硬件的资料，其实最方便的，就是直接从注册表中抓取，但是有些人对注册表有畏惧感！觉得注册表好像高深的样子。其实虽然从 Windows95 以后 Microsoft 已经将 Win.ini 及 System.ini 的资料写到注册表中，但是由于 INI 档之使用已根深蒂固，所以 Microsoft 也不敢冒然废除 INI 档的使用，直到 Windows98 为止，一直都是二者并用，也就是有些资料，在写到注册的同时，也写了一份到 INI 档中！目前讨论的主题就是一个例子，这三种资料都可从 Win.ini 中直接读取，结构如下：[windows]device=HP LASERJET 6P (TRADITIONAL),HPCXLAB,\\SUN\LJIIP2device=印表机的机型, 驱动程序, 连接埠 (三种资料中间以逗点分开)在声明区中加入以下声明： (16位　改成 win31 API)Private 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程序代码如下：AppName$ = "windows" ‘Section 名称KeyName$ = "device" ‘Key 值名称nSize% = 81 ‘预设返回值长度RetStr$ = Space$(nSize%) ‘设定空白给预设返回值NumChars% = GetProfileString(AppName$, KeyName$, NullStr$, RetStr$, nSize%)‘ NumChars% 是实际返回值长度koRetStr$ = Left$(RetStr$, NumChars%) ‘实际返回值‘ Parse the string for specifics‘找寻第一个逗点的位置CommaPos1% = InStr(1, RetStr$, ",")‘找寻第二个逗点的位置CommaPos2% = InStr(CommaPos1% + 1, RetStr$, ",")‘印表机的机型lblPrinter.Caption = Left$(RetStr$, CommaPos1% - 1)‘印表机的驱动程序lblPrinterDriver.Caption = Mid$(RetStr$, CommaPos1% + 1, CommaPos2% - CommaPos1% - 1) & ".DRV"‘印表机的连接埠lblPrinterPort.Caption = Mid$(RetStr$, CommaPos2% + 1)95、如何判断二个日期是否为同一月份？碰到这个问题，很多人第一个念头想到的就是『简单！只要使用 Month() 来判断就可以了』，但是这个方法却潜藏危机！为什么呢？例如：Month(Date1) = 2Month(Date2) = 2以上的二个日期并不一定是同月份，就像 1999/02/01 和 2000/02/01 一样！要怎样做才会正确呢？要使用 DateDiff ("m", Date1, Date2) = 0 表示同一月份(年度当然也相同)程序如下：If DateDiff ("m", Date1, Date2) thenMsgBox "不同月份"ElseMsgBox "同月份"End If96、如何让二个文字框同步联动？要作到这个动作，有的人会想要用 KeyDown 或 KeyPress 事件来处理，但是这都是错的，虽然第二个文字框终究会动，但是总是比第一个文字框慢了一拍，永远会漏掉最后一个字！为什么呢？因为由键盘输入时，程序接收的顺序为 KeyDown --> KeyPress --> KeyUp，而在 KeyPress 时，才会传入 Keyascii〈此点可由各事件中传入的参数得知〉转换成文字，所以在 KeyDown 时，还抓不到输入的字，在 KeyPress 时，只有 Keyascii 则需要转换才抓得到，但是中文比较麻烦！在 KeyUp 时虽然已经可以抓到键入的值，但是我认为倒不如在 Change 事件中来得简单！不管 User 输入什么，只有第一个文字框资料异动时，才需要处理。Private Sub Text1_Change()Text2 = Text1End Sub如果不管第一个文字框输入什么，第二个文字框只要显示最后一个字，则程序要改成：Private Sub Text1_Change()Text2 = Right(Text1, 1)End Sub97、如何避免核取方块式的 ListBox 已选定的项目被更改？当 ListBox 的 Style 设定成〈1-项目包含核取方块〉，ListBox 控制项以每一个文字项目跟随一个核取方块的方式显示。您可透过选取各项目边的核取方块以选择 ListBox 中的多个项目。但有时候，您这样子设定的目的是为了显示一些事先选定的项目，例如从资料库中抓出的资料或是一些安装软件的设定选项确认画面。您不希望因为使用者再去点选 ListBox 的项目而更动原来设定的项目，这时候，您不能将 Enabled 属性设成 False，因为这样子卷动杆就无法卷动，使用者就无法看到 ListBox 的其他项目；您也无法像 TextBox 一样设定成 Lock 状态，因为 ListBox 没有 Lock 属性。以下的程序代码可以解决这个问题，在 Form 中放一个 CommandButton 及一个 ListBox，将 ListBox 的 Style 设定成〈1-项目包含核取方块〉：Dim isDisabled As Boolean ‘是否取消可选定状态Private Sub Command1_Click()isDisabled = Not isDisabledEnd SubPrivate Sub List1_ItemCheck(Item As Integer)If isDisabled ThenList1.Selected(Item) = Not List1.Selected(Item)End IfEnd Sub当 isDisabled 设定成 True 时，使用者一旦选定 ListBox 的某一个项目，程序会立即反转它的状态，看起来就像没改变过选定状态一样！而同时 ListBox 还是可以卷动！98、如何隐藏及再显示鼠标很简单，只用到了一个 ShowCursor API，参数也很简单，只有一个 bShow，设定值如下：True：显示鼠标 / False：隐藏鼠标Declare Function ShowCursor Lib "user32" Alias "ShowCursor" (ByVal bShow As Long) As Long99、您是左撇子吗？交换鼠标的左右键！很简单，只用到了一个 SwapMouseButton API，参数也很简单，只有一个 bSwap，设定值如下：True：左右键互换 / False：恢复正常Declare Function SwapMouseButton Lib "user32" Alias "SwapMouseButton" (ByVal bSwap As Long) As Long假设我是左撇子，则程序为：Dim RetVal As LongRetVal = SwapMouseButton(True)100、资料的加密 / 解密以下二个模组，一个处理加密，一个处理解密，加密处理必须传入参数 (就是要加密的字串)，加密后将资料存到加密文件，要解密时，则从文件案中读出并解密：(假设文件案名称为 C:\加密文件.qwe, 您可以自行更改文件名或路径)‘处理加密Private Function Encrypt(varPass As String)If Dir("C:\加密文件.qwe") <> "" Then: Kill "C:\加密文件.qwe"Dim varEncrypt As String * 50Dim varTmp As DoubleOpen "C:\加密文件.qwe" For Random As #1 Len = 50For I = 1 To Len(varPass)varTmp = Asc(Mid$(varPass, I, 1))varEncrypt = Str$(((((varTmp * 1.5) / 2.1113) * 1.111119) * I))Put #1, I, varEncryptNext IClose #1End Function‘处理解密Private Function Decrypt() As StringOpen "C:\加密文件.qwe" For Random As #1 Len = 50Dim varReturn As String * 50Dim varConvert As DoubleVB问题全功略（21） [查找本页请按Ctrl+F]［上一页］（21）［下一页］101、如何让 ComboBox 可以自动下拉？102、如何从您的应程序中结束 Windows 重开机？103、我要如何用 VB 来拨电话？ (不用 MSCOMM32.OCX )104、如何用 VB 启动其他程序或开启各类文件？105、由程序中启动屏幕保护程序！(一)101、如何让 ComboBox 可以自动下拉？以下状况假设我在 Form_Load 中自动下拉 Combo1.‘以下声明用于16位Const WM_USER = &H400Const CB_SHOWDROPDOWN = (WM_USER + 15)Private Declare Function SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long‘以下声明用于32位Const CB_SHOWDROPDOWN = &H14FPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Sub Form_Load()Combo1.AddItem "11111"Combo1.AddItem "22222"Combo1.AddItem "33333"Combo1.AddItem "44444"Combo1.AddItem "55555"Combo1.AddItem "66666"‘Form_Load 即自动下拉 Combo1Dim nret As Longnret = SendMessage(Combo1.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&)End Sub102、如何从您的应程序中结束 Windows 重开机？很多软件在 Setup 完之后都会自动关机重开机，以便让某些设定值可以生效，其实这个功能很简单，只要几行指令就可以做到了！关键就是要使用 ExitWindowsEx 这个 API，这个 API 只有二个参数，第一个参数是一个 Flag，目的是要告诉 Windows 要以什么方式关机，在下面的声明中会列出可用的 Flag 常数值，至于第二个参数则是一个保留值，只要设定成 0 就可以了。很重要的一点是：如果您想要让关机动作更顺利，记得要 Unload 您的程序！‘在声明区中 (Bas Module / Form Module) 加入以下声明：Public Const EWX_LOGOFF = 0 ‘这四个常数值可以并用Public Const EWX_SHUTDOWN = 1Public Const EWX_REBOOT = 2Public Const EWX_FORCE = 4Declare Function ExitWindowsEx Lib "user32" Alias "ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long‘实例：如果您想强迫关机重开机，程序码如下：ret = ExitWindowsEx(EWX_FORCE OR EWX_REBOOT, 0)103、我要如何用 VB 来拨电话？ (不用 MSCOMM32.OCX )这个问题很多人问，也很多人回答，答案千篇一律，都说是使用 MSCOMM32.OCX，但是，您知道吗？如果您只是想拨号而已，根本就不用使用 MSCOMM32.OCX 这个控制项！我忘了是从 Windows95 开始，或是 Windows3.1 就有了，Microsoft Windows 就提供了【电话拨号员】这个工具程序，在 Windows98 中的位置是 【开始】【程序集】【附属应用程序】【通讯】【电话拨号员】，如果找不到的话，表示您在安装 Windows95/98 时并未选择安装【电话拨号员】，您只要再执行 Windows 安装程序，选择【通讯】【电话拨号员】即可！没错！看完以上的说明，您应该知道我们就是要使用【电话拨号员】，请在声明区中加入以下声明及模组：Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" (ByVal Dest As String, ByVal AppName As String, ByVal CalledParty As String, ByVal Comment As String) As LongPublic Sub PhoneCall(sNumber As String, sName As String)Dim lRetVal As LonglRetVal = tapiRequestMakeCall(Trim$(sNumber), App.Title, Trim$(sName), "")If lRetVal <> 0 ThenMsgBox "不能拨号, 请采取其他行动"End IfEnd Sub‘以上的 PhoneCall 是一个已经完成的模组，就是用来拨号的，它有二个参数：‘第一个参数是电话号码，是指对方的电话号码。‘第二个参数是对方的姓名或代号。‘以下是一个应用实例，要拨号给电话号码为 "27058181" 的 "纪文和"：Private Sub Command1_Click()PhoneCall "27058181", "纪文和"End Sub104、如何用 VB 启动其他程序或开启各类文件？要在 VB 中启动其他程序或开启各类文件，最简单的方法就是使用 Shell 函数，例如：要开启 C:\Test.txt 这个文字文件，则要启动记事本来开启这个文件案，程序如下：Dim RetVal As LongRetVal = Shell("C:\Windows\Notepad.exe C:\Test.txt", 3) ‘3代表视窗会最大化，并具有驻点，细节请查 Help以上的语法虽然很简单，但有一个风险，若是我们不知道开启文件的执行文件位置，则程序便会有错误产生，尤其一般软件在安装的时候都可以让使用者自行选择安装目录，所以执行文件的路径不能写死在程序中，要解决这个问题，就是在注册文件中找到该副文件名之启动程序位置，再放入 Shell 中。但是以上的作法必须熟悉注册文件，而且必须使用 Windows API 来 Call (注册文件的存取以后会有专文来说明)，如果您对注册文件的存取及 API 的使用都很纯熟的话，当然没问题，但是有些人对于注册文件会有畏惧，这时候，您可以使用下面的方法：Shell("Start C:\Test.txt")您完全不用知道这份文件的启动程序是什么？它放在什么地方？参数 Start 便会自动依照附文件名到注册文件中找到启动程序来开启该份文件案！ 不赖吧！注一：在 Windows 95/98/NT 平台中, 什么副文件名之文件案, 该由什么执行文件来启动, 都设在关联中,代码为 HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Extensions例如: 名称为 ".DOC" 之资料为 "C:\Progra~1\Micros~2\Office\WINWORD.EXE ^.DOC"名称为 ".TXT" 之资料为 "notepad.exe ^.txt"注二：使用 Start 之唯一缺点为 "会比直接指定执行文件稍为慢 0.5-1 秒钟."注三：有一个例外就是屏幕保护程序，请看下面。105、由程序中启动屏幕保护程序！(一)如果您曾在民营企业的资讯中心待过，不知您是否曾遇过一种情形，某一个高阶主管 (或他的秘书) 要您帮他改一支报表，当他将有问题的报表交给您时，还千交待万交待，不可以让别人看到这份报表！这时您是不是觉得很好笑，其实在资讯中心，那里还有什么秘密可言？话是如此说，但是如果您能够将程序写得让他们觉得很安全，您也会获得比较多的礼遇，而从程序中启动屏幕保护程序就是技巧之一，为什么呢？因为当他在作业中途要离开位置时，他可以不用结束作业中的程序，而直接启动屏幕保护程序，而在屏幕保护程序中他可以设定密码，这样就不会不小心给人看到资料了！要启动屏幕保护程序可以直接使用 Shell 函数，但是上一个专题《问题 84》中我们讨论到的 Shell 二种作法对于屏幕保护程序却有不同的意义，分别说明如下：错误的作法 ==> x = Shell("c:\windows\Sheep.scr") ‘这种作法只能开启屏幕保护程序的设定画面而已！正确的作法 ==> Shell ("start c:\windows\sheep.scr") ‘这种作法才能正确启动屏幕保护程序106、如何让您的电脑进入待命状态 (Win98) 或启动屏幕保护程序 (Win95)？您的程序使用者会不会开启程序后不结束应用程序，结果就离开座位，久久不回座位？使用以下的方法，您可以做到：1、在 Windows98 中，您可以在程序中让他的电脑进入待命状态！ (屏幕黑黑一片)2、在 Windows95 中，您可以启动他电脑中预设的屏幕保护程序！而要让电脑进入待命状态或启动屏幕保护程序，只要送一个讯息给桌面 (DeskTop Window) 就可以了！‘在声明区中加入以下声明：Const WM_SYSCOMMAND = &H112&Const SC_SCREENSAVE = &HF140&Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function GetDesktopWindow Lib "user32" () As LongFunction gf_StartScreenSaver() As BooleanDim hWnd&On Error Resume NexthWnd& = GetDesktopWindow()Call SendMessage(hWnd&, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)gf_StartScreenSaver = (Err.Number = 0)End Function‘要使用时直接呼叫 gf_StartScreenSaver 即可！例如：Private Sub Command1_Click()gf_StartScreenSaverEnd Sub107、如何在程序中模拟按了 Windows95/98 屏幕左下方之【开始键】？或许有人会问：这有什么意义？当然有，随便举个例子，有的程序在执行时会盖住开始任务栏，就算滑鼠移到屏幕下方，任务栏也不会出现，目前这个方法就可以强迫任务栏出现！当然也可以让使用者选择执行【开始工能表】中各群组之程序。如果您看过了前一个问题 (86-如何让您的电脑进入待命状态 (Win98) 或启动屏幕保护程序 (Win95)？)，您一定会发现这个问题的答案和上一个范例好像！没错！要让程序模拟按了 Windows95/98 屏幕左下方之【开始键】，也只要送一个讯息给桌面 (DeskTop Window) 就可以了！差别只在传入的参数不同而已：‘在声明区中加入以下声明：Const WM_SYSCOMMAND = &H112&Const SC_TASKLIST = &HF130 ‘-------->只有这里不同而已Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function GetDesktopWindow Lib "user32" () As LongFunction gf_StartButton() As BooleanDim hWnd&On Error Resume NexthWnd& = GetDesktopWindow()Call SendMessage(hWnd&, WM_SYSCOMMAND, SC_TASKLIST, 0&)gf_StartButton = (Err.Number = 0)End Function‘要使用时直接呼叫 gf_StartButton 即可！例如：Private Sub Command1_Click()gf_StartButtonEnd Sub108、如何让表单的标题列变成走马灯？说穿了，这个功能就是标准的做苦工的程序！不过效果还算不错！Dim C As String ‘存放现行视窗的标题列Dim CO As Integer ‘存放标题的长度Dim FS As Long ‘存放现行视窗的宽度Private Sub Form_Load()Timer1.Interval = 100Me.Caption = "会移动的标题列"C = Me.CaptionCO = Len(C) + 1Me.Caption = ""If Me.BorderStyle <> 2 ThenFS = Me.ScaleWidth + 250ElseFS = Me.ScaleWidth + 500End IfEnd SubPrivate Sub Form_Resize()If Me.WindowState = 1 ThenFS = 3500ElseFS = Me.ScaleWidthEnd IfEnd SubPrivate Sub Timer1_Timer()On Error GoTo ATHStatic C01 As Integer ‘ 第一个 CounterStatic CO2 As Integer ‘ 第二个 CounterStatic A As String ‘ to move captionDim R As String ‘ restore captionDim T As String ‘ restore captionXX:If CO > 0 ThenC01 = COT = Mid(C, C01, 1)CO = CO - 1R = " "Mid(R, 1) = TMe.Caption = R & Me.CaptionElseA = A & " "R = " "Mid(R, 1) = AMe.Caption = R & Me.CaptionEnd IfIf CO2 >= FS ThenCO2 = 0CO = Len(C)Me.Caption = ""GoTo XXElseCO2 = CO2 + 50End IfExit SubATH:End Sub109、如何求出硬盘大小及剩余空间大小在我们安装软体的时候，在安装选项的画面，常常会出现如下的一些叙述：选择安装项目大小..............................................10,000,000 BytesC 硬盘总空间大小..........................................1,847,328,768 BytesC 硬盘剩余空间大小...........................................51,707,904 Bytes后面的二项是我们硬盘的资讯，我们只要使用一个 API，就可以同时抓到这二个资讯！请在声明区中放入以下声明：Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long‘第一个参数是硬盘代号，其他参数如范例中说明‘在程序中呼叫范例如下：Private Sub Command1_Click()Dim SectorsPerCluster As Long ‘参数二：每个 Cluster 的 Sector 数Dim BytesPerSector As Long ‘参数三：每个 Sector 的 Byte 数Dim NumberOfFreeClusters As Long ‘参数四：剩余的 Cluster 数Dim TotalNumberOfClusters As Long ‘参数五：Cluster 总数Dim FreeBytes As Long ‘剩余的 Byte 数Dim TotalBytes As Long ‘总 Byte 数Dim dummy As Long ‘传回值dummy = GetDiskFreeSpace("c:\", SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters)FreeBytes = NumberOfFreeClusters * SectorsPerCluster * BytesPerSectorTotalBytes = TotalNumberOfClusters * SectorsPerCluster * BytesPerSector剩余空间大小 = FreeBytes硬盘大小 = TotalBytesEnd Sub注：在 VB6 以前的各版本 VB，只能使用这种方法来做，但是到了 VB6 已经有了更简单、不　要使用 API 的新作法，就是使用新物件 FileSystemObject，我们将在 《问题 99》再来探讨。110、如何新增、移除【文件功能表】的内容？在 Windows95/98 环境中，当您开启一份文件后，Windows 便会将这份文件记录在最近开启的文件记录中 (其实是将它放在 Windows/Recent 目录下)。下一次您要开启同一份文件时，有三种以上的方法：1、选择【开始】【文件】，就可以看到【文件功能表】的文件清单，再选择文件名称即可！2、在文件总管文件所在目录下，直接开启该份文件。3、在文件总管 Windows/Recent 目录下选择该份文件。若是您想清除这份文件清单，有二个方法：1、在文件总管中，将 Windows/Recent 目录下的文件通通删除即可。2、在任务栏上按滑鼠右键，选择【内容】，出现【任务栏 内容】选单，选择【开始功能表程序集】，在【文件功能表】框中按【清除】按钮即可。以上是人工的方法及 Windows 内部之作业流程，若是我们的 VB 程序中，要做到这样的功能，也是很简单的，但是它有什么作用呢？有的，举个例子：今天 User 在操作我们的程序中，产生了几份文件，可能有文字档、Word 文件、Excel 文件...等，当然您可以事先和 User 约定好，产生的文件固定放在某一个目录下， User 再自行到该目录下去作处理，但是，如果您将产生的文件清单，直接放入【文件功能表】的文件清单中，User 根本不　知道文件放在那里，他只要在【文件功能表】中选择即可，是不是很方便！‘请在声明区中加入以下声明：Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String)‘新增 (一次增加一笔)Private Sub Command1_Click()Dim NewFile As StringNewFile = "c:\doc\880730订购清单.doc" ‘<----- 要放到【文件功能表】文件清单的文件Call SHAddToRecentDocs(2, NewFile)End Sub‘清除 (一次全部清除)Private Sub Command2_Click()Call SHAddToRecentDocs(2, vbNullString)End Sub111、您认识 VB 的扩展名吗？我不知道您已经使用 VB 多久时间了，但是今天当您面对一堆乱七八糟的文件时，您能由扩展名来判断那一个文件是属於 VB 的文件吗？恐怕不是每一个人都可以？您知道以下这些扩展名都是 VB 指定给【设计阶段文件】的扩展名吗？扩展名 用於VB6 VB5 VB4-32 VB4-16 VB3.bas Basic 模组* * * * *.cls 物件类别模组* * * * 　.ctl 使用者控制项文件* * 　 　 　.ctx 使用者控制项二进位文件* * 　 　 　.dca 现用设计师快取文件* * 　 　 　.dep 安装精灵附属文件* * 　 　 　.dob 使用者文件表单* * 　 　 　.dox 使用者文件二进位表单文件* * 　 　 　.dsr 现用设计师文件* * 　 　 　.dsx 现用设计师二进位文件* * 　 　 　.frm 表单文件* * * * *.frx 二进位表单文件* * * * *.log 载入错误的记录档* * * * *.oca 控制项 Typelib 文件* * * * 　.pag 属性页文件* * 　 　 　.pgx 二进位属性页文件* * 　 　 　.res 资源档* * * * 　.swt Visual Basic 安装精灵范本文件* * 　 　 　.tlb Remote Automation Typelib 文件* * 　 　 　.vbg Visual Basic 群组专案* * 　 　 　.vbl 使用者控制项授权文件* * 　 　 　.vbp Visual Basic 专案* * * * 　.vbr Remote Automation 注册文件* * * * 　.vbw Visual Basic 专案工作区* * 　 　 　.vbz 精灵启动文件* * * * *.wct Webclass 范本文件* 　 　 　 　.ocx 控制项文件 * * * * 　.vbx 控制项文件 　 　 　 * *.mak Visual Basic 专案 * * * * *112、完全模拟【开始】中的【运行...】功能请您现在按下【开始】中的【运行...】，看看【运行...】问话框中的说明，是不是如下：请输入程序、资料夹、文件或 Internet 资源的名称，Windows 会自动开启。如果说您我也可以做到这种功能，只要是可开启的、可执行的，通通可以做到，您相信吗？不要怀疑！不但可以做到，而且更让您惊讶的，是程序竟然这么短，只要一行就可以了！您一定认为要用 API，喔！不是！先别乱猜，这次不用声明 API！直接来看一个例子：在 Form 中放一个 TextBox，名称为 Text1Private Sub Command1_Click()Call Shell("rundll32.exe url.dll,FileProtocolHandler " & Text1, 1)End Sub而其中的 Text1 可以输入程序、资料夹、文件或 Internet 资源的名称，也可以输入快捷方式 (shortcut file)，都可以正确执行！113、模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁盘】在【网路上的芳邻】及【我的电脑】中都有提供【连线网路磁盘】及【中断网路磁盘】的功能，在 VB 的程序中我们一样可以轻易做到。‘请在声明区中加入以下声明及模组：Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As LongDeclare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" _(ByVal lpszName As String, ByVal bForce As Long) As LongFunction AddConnection(MyShareName As String, MyPWD As String, UseLetter As String) As IntegerOn Local Error GoTo AddConnection1_ErrAddConnection = WNetAddConnection(MyShareName, MyPWD, UseLetter)AddConnection_End:Exit FunctionAddConnection1_Err:AddConnection = ErrMsgBox Error$Resume AddConnection_EndEnd FunctionFunction CancelConnection(DriveLetter As String, Force As Integer) As IntegerOn Local Error GoTo CancelConnection_ErrCancelConnection = WNetCancelConnection(DriveLetter, Force)CancelConnection_End:Exit FunctionCancelConnection_Err:CancelConnection = ErrMsgBox Error$Resume CancelConnection_EndEnd Function呼叫的方法如下：连线网路磁盘：传回值 = AddConnection(<共享的路径>, <密码>, <磁盘代号>)中断网路磁盘：传回值 = CancelConnection(<磁盘代号>, <强迫中断？>)呼叫实例：连线网路磁盘：X = AddConnection("\\IO\io_c", "", "H:")中断网路磁盘：X = CancelConnection("H:", True)注：这个范例实际执行，连线时，NT 及 Novell 之速度相若，但是，在中断时，Novell 之速度明显较慢！注：以上的方式乃是由程序中直接指定，另外的一个方法是显示问话框由使用者自行设定，这个方法我们在以后将再说明！114、自制 Round 函数 (取小数点几位)这一个问题，有网友反应在某些情形下，会造成误差 ( 连 VB6.0 提供的 Round 函数都会造成误差 )，我针对多种情形实际测试，结果很令人惊讶，让人怀疑如何做才会百分之百完全正确，根据测试结果，我原本想拿掉这个单元，但後来我重新写了一个比较笨，但是在有限小数位数内仍然会正确的式子，可是这个功能只支援小数点，不再支援整数以上的 Round 功能，如下：‘传入的参数和之前相同，第一个是要判断的数字，第二个是要取小数几位。Public Function round(num As Double, pos As Integer) As Double‘整数以上不处理If pos <= 0 Thenround = Format(num, "#")Exit FunctionEnd IfDim i As IntegerDim formatstr As String‘拼凑 Format 的格式formatstr = "#."For i = 1 To posformatstr = formatstr & "0"Nextround = Format(num, formatstr)End Function115、如何找出 Windows 目录的正确路径？有时候我们在程序中必须用到 Windows 的目录，以存取 Windows 目录下的文件，照理说，这应该是最简单的功能，前提是每个人在 Setup Windows 必须采用 Windows 的预设目录名称，也就是 C:\Windows，但是常常不是这样，有时候由於要使新旧版本共存，或者其他原因，有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......若是程序中必须用到 Windows 目录，要找到正确的路径，做法如下：‘在声明区中加入以下声明：Const MAX_PATH = 260Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongPublic Function GetWinPath()Dim strFolder As StringDim lngResult As LongstrFolder = String(MAX_PATH, 0)lngResult = GetWindowsDirectory(strFolder, MAX_PATH)If lngResult <> 0 ThenGetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)ElseGetWinPath = ""End IfEnd Function‘在程序中使用方法如下：Private Sub Command1_Click()Call MsgBox("您电脑中 Windows 目录的正确路径是： " & GetWinPath, vbInformation)End SubVB问题全功略（24） [查找本页请按Ctrl+F]［上一页］（24）［下一页］116、让您的音乐 CD 动起来！117、如何求出磁盘大小及剩余空间大小 (更简单的 VB6 新功能)118、反向思考---怎样让程序跑慢一点？(二)119、列出电脑中所有磁盘120、模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁盘】(二)116、让您的音乐 CD 动起来！之前，我们讨论过，但是只会开启及关闭，用处还不太大，今天，我们来看看要怎么让您的音乐 CD 动起来！‘请在声明区中加入以下声明： ( 和 "开启及关闭CD－Rom的门" 相同的声明)Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long‘在 Form 中加入二个 CommandButton，分别命名为 cmdPlay 及 cmdStop 并加入以下程序码：Sub cmdPlay_Click()Dim lRet As LongDim nCurrentTrack As Integer‘开启装置lRet = mciSendString("open cdaudio alias cd wait", 0&, 0, 0)‘设定时间格式为 Tracks ( 预设值是 milliseconds )lRet = mciSendString("set cd time format tmsf", 0&, 0, 0)‘从头开始播放lRet = mciSendString("play cd", 0&, 0, 0)‘您也可以指定要从第几首歌 (Track) 开始播放，例如以下指定从第 3 首歌开始播放‘nCurrentTrack = 3lRet = mciSendString("play cd from" & Str(nCurrentTrack), 0&, 0, 0)End Sub‘ 记得在播放完毕时要关闭装置Sub cmdStop_Click()Dim lRet As Long‘停止播放lRet = mciSendString("stop cd wait", 0&, 0, 0)DoEvents ‘给 Windows一点时间去处理其他事件‘关闭装置lRet = mciSendString("close cd", 0&, 0, 0)End Sub注：如果您想指定从第几首歌开始播放，只要将上面绿色那行程序之 Mark 拿掉，改掉数字即可！注：原作者原来的声明是在 mmsystem.dll，现在要使用 winmm.dll 才可以！117、如何求出磁盘大小及剩余空间大小 (更简单的 VB6 新功能)在《问题 91》时，我们使用了 API 来求出磁盘大小及剩余空间大小，也就是下方资讯之后二项：《在我们安装软体的时候，在安装选项的画面，常常会出现如下的一些叙述：》选择安装项目大小..............................................10,000,000 BytesC 磁碟总空间大小..........................................1,847,328,768 BytesC 磁碟剩余空间大小...........................................51,707,904 Bytes在 VB6 以前我们只能如此做，对于不熟悉 API 的人来说，很难，但是在 VB6 就变得很简单，因为在 VB6 中提供了一个新物件：FileSystemObject让我们实№来自看例子：Private Sub Command1_Click()Dim fso As New FileSystemObject, drv As DriveSet drv = fso.GetDrive(fso.GetDriveName("c:"))剩余空间大小 = drv.FreeSpace磁盘大小 = drv.TotalSizeEnd Sub使用上面的方法算出的结果和使用 GetDiskFreeSpace API 算出的结果是完全一样的！118、反向思考---怎样让程序跑慢一点？(二)原来我们提到了使用 Sleep API 来达到让程序暂停的方法，方法很简单，程序码也很简短，但是美中不足的是，它只能用在 32 位元的环境中！难道在 16 位元的环境中就没办法了吗？或者，一定要使用 API 吗？还是有办法的，而且不用 API，最棒的是所有版本的 VB 都可使用！‘在您的程序中，加入以下的模组：Public Sub Delay(HowLong As Date)TempTime = DateAdd("s", HowLong, Now)While TempTime > NowDoEvents ‘让 windows 去处理其他事WendEnd Sub‘在程序中只要如下使用即可：Private Sub Command1_Click()Delay 5End Sub119、列出电脑中所有磁盘我们曾讨论过使用 GetDriveType API 再加上回圈一个一个判断磁盘的型态，再列在 ListBox 中供选择。但是在实际应用程序中，有时候我们根本不需要知道各个磁盘的型态，我们的目的只是很单纯地让使用者来挑选档案的位置而已！例如趋势科技的 Pccillin 要从磁盘 Upgrade 病毒码时，它会询问您磁盘代号，就是使用这种作法！这时候，我们可以换一种更快的方式，(只是有人认为不能顺便列出磁盘型态仍是一种缺点) 如下：‘在声明区中加入以下声明：Const LB_DIR = &H18D ‘LB 即是 ListBox 的缩写Const DDL_DRIVES = &H4000Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Function AddDrives2ListBox(lhWnd As Long)Call SendMessage(lhWnd, LB_DIR, DDL_DRIVES, "*")End Function‘而程序中之使用方法如下：(只有一个参数，就是 ListBox 的 hwnd)Private Sub Form_Load()AddDrives2ListBox List1.hwndEnd Sub有人问我，ListBox 的很多功能都和 ComboBox 很像，这个例子，可以使用 ComboBox 吗？可以的，也不难，将声明区的声明改成：Const CB_DIR = &H145 ‘CB 即是 ComboBox 的缩写Const DDL_DRIVES = &H4000Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Function AddDrives2ComboBox(lhWnd As Long)Call SendMessage(lhWnd, CB_DIR, DDL_DRIVES, "*")End Function‘而程序中之使用方法如下：(只有一个参数，就是 ComboBox 的 hwnd)Private Sub Form_Load()AddDrives2ComboBox Combo1.hwndEnd Sub120、模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁盘】(二)对于实际的网路作业，WNet API 是非常有用的，例如：我们在《问题93》模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁盘】中我们就使用了 WNetAddConnection 及 WNetCancelConnection 这二个 API 很有效地来处理连线及中断网路磁盘，但是我们不知道每一个使用者电脑中的实际设定，使用直接指定的强迫连线及中断，或许会影响使用者原本电脑中的设定。下面的方法是一个比较中性的作法，就是出现【连线 / 中断网路磁盘】的问话框，让使用者根据自己电脑的情形，来决定要连线的网路磁盘要对应到自己的那一个磁盘？要中断的又是那一个对应的磁盘？其实，这个方法更接近实际模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁盘】！请在声明区中加入以下声明及模组：Private Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hwnd As Long, ByVal dwType As Long) As LongPrivate Declare Function WNetDisconnectDialog Lib "mpr.dll" (ByVal hwnd As Long, ByVal dwType As Long) As LongSub ShowMapDrives(hwnd As Long)WNetConnectionDialog hwnd, 1End SubSub ShowUnMapDrives(hwnd As Long)WNetDisconnectDialog hwnd, 1End Sub‘程序中使用方式如下：Private Sub Command1_Click()‘出现 连线网路磁盘 问话框ShowMapDrives Me.hwndEnd SubPrivate Sub Command2_Click()‘出现 中断网路磁盘 问话框ShowUnMapDrives Me.hwndEnd Sub121、取得印表机的连接埠在测试上一个《问题 100》模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁碟机】 (二) 时，我们用到了 WNetConnectionDialog API，这个 API 又让我想到了另一个小功能！您设定过印表机吗，如果有，在设定印表机时，设定问话框中有一个 Tab 是【详细资料】页，在此页中有一个按钮是让我们《取得印表机连接埠》，WNetConnectionDialog 这个 API 的功能之一就是叫出《取得印表机连接埠》问话框！‘一样在声明区中加入以下声明：Private Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hWnd As Long, ByVal dwType As Long) As LongSub ShowPrinterPort(hWnd As Long)WNetConnectionDialog hWnd, 2End Sub‘在程序中使用方法如下：Private Sub Command1_Click()ShowPrinterPort Me.hWndEnd Sub122、读取及设定文件的属性当我们在任一个文件上按滑鼠右键，选择【内容】，在文件内容的【一般】页签中我们可以看到每一个文件有四个属性：保存、只读、隐藏及系统。使用 GetFileAttributes 及 SetFileAttributes 二个 API 我们就可以读取及设定这四个属性。‘请在声明区中加入以下声明：‘设定文件属性Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long‘读取文件属性Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As LongConst FILE_ATTRIBUTE_READONLY = &H1 ‘设定为只读Const FILE_ATTRIBUTE_HIDDEN = &H2 ‘设定为隐藏Const FILE_ATTRIBUTE_SYSTEM = &H4 ‘设定为系统Const FILE_ATTRIBUTE_ARCHIVE = &H20 ‘设定为保存Const FILE_ATTRIBUTE_NORMAL = &H80 ‘设定为一般 (取消前四种属性)‘要设定二种以上的属性可以用 or 串联以上之属性，来看看例子：‘设定 db1.mdb 为只读SetFileAttributes "c:\db1.mdb", FILE_ATTRIBUTE_READONLY‘设定 db1.mdb 为只读 + 隐藏SetFileAttributes "c:\db1.mdb", FILE_ATTRIBUTE_READONLY Or FILE_ATTRIBUTE_HIDDEN‘设定 db1.mdb 为只读 + 隐藏 + 系统 + 保存SetFileAttributes "c:\db1.mdb", FILE_ATTRIBUTE_READONLY Or FILE_ATTRIBUTE_HIDDEN _Or FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_ARCHIVE‘取消 db1.mdb 所有设定SetFileAttributes "c:\db1.mdb", FILE_ATTRIBUTE_NORMAL‘要读取文件目前的属性，则是用 GetFileAttributes API，以读取 db1.mdb 为例：MsgBox GetFileAttributes("c:\db1.mdb")‘返回值如上面的常数声明值，例如：‘若返回值为 6 ( =2+4 ) 表示此文件为 隐藏 + 系统‘但是若返回值为 128 表示此文件未设定任何属123、避免 Null 产生的错误当我们从资料库读出资料时，有的栏位之内容可能为 Null，若不加以处理而要将资料搬给某一栏位时，会有错误产生，虽然 VB 本身有提供一个 IsNull 函数以供判断，但是您知道吗，我写了这么多年的 VB 资料库程序，从来没有用过 IsNull 来判断资料库栏位值，为什么呢？我又怎么做呢？其实很简单，我不管从资料库读出来的是不是 Null，写法一律如下：Text1.text = rs1("Field1") & ""如果这个栏位的值是 Null，加上 ( ＆　〃 ) 之後就变成了 "" 了！但是要小心，我的新同事们常常会犯一个错误，我们看看以下二个式子：1、Text1.text = Trim(rs1("Field1")) & "" ‘ ( 可能是错的 )2、Text1.text = Trim(rs1("Field1") & "") ‘ ( 这样写才对 )第一个式子如果栏位值是 Null，使用 trim$ 便会产生错误，对於这些状况，其实只要记住一个原则即可：不管从资料库读出之资料要做什么动作，不管三七二十一先加上 ( ＆　〃 ) 就对了再来看看一个例子，以加深印象：Text1.text = Format( (rs1("Field1") & ""), "yymmdd")124、如何找出 Windows 目录的正确路径？有时候我们在程序中必须用到 Windows 的目录，以存取 Windows 目录下的文件，照理说，这应该是最简单的功能，前提是每个人在 Setup Windows 必须采用 Windows 的预设目录名称，也就是 C:\Windows，但是常常不是这样，有时候由于要使新旧版本共存，或者其他原因，有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......若是程序中必须用到 Windows 目录，要找到正确的路径，做法如下：‘在声明区中加入以下声明：Const MAX_PATH = 260Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongPublic Function GetWinPath()Dim strFolder As StringDim lngResult As LongstrFolder = String(MAX_PATH, 0)lngResult = GetWindowsDirectory(strFolder, MAX_PATH)If lngResult <> 0 ThenGetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)ElseGetWinPath = ""End IfEnd Function‘在程序中使用方法如下：Private Sub Command1_Click()Call MsgBox("您电脑中 Windows 目录的正确路径是： " & GetWinPath, vbInformation)End Sub125、如何找出 System 目录的正确路径？和《问题104》如何找出 Windows 目录的正确路径？一样，由于有很多系统文件都放在 System 目录下，有时候我们在程序中必须用到 System 的目录，以存取 System 目录下的文件，但是有时候由於要使新旧版本共存，或者其他原因，有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......若是程序中必须用到 System 目录，要找到正确的路径，做法如下：‘在声明区中加入以下声明：Const MAX_PATH = 260Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongPublic Function GetSystemPath()Dim strFolder As StringDim lngResult As LongstrFolder = String(MAX_PATH, 0)lngResult = GetSystemDirectory(strFolder, MAX_PATH)If lngResult <> 0 ThenGetSystemPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)ElseGetSystemPath = ""End IfEnd Function‘在程序中使用方法如下：Private Sub Command1_Click()Call MsgBox("您电脑中 System 目录的正确路径是：" & GetSystemPath, vbInformation)End Sub126、如何找出 Temp 目录的正确路径？有时候，我们的 VB 程序在执行时，会产生一些文件，或许只是暂存档，这时您可以考虑放在 Windows 的 Temp 目录下，这个目录在预设的情形下是在 c:\windows\temp，但是， User 有时候由于要使新旧版本共存，或者其他原因，有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......若是程序中必须用到 Temp 目录，要找到正确的路径，做法如下：‘在声明区中加入以下声明：Const MAX_PATH = 260Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As LongPublic Function GetTmpPath()Dim strFolder As StringDim lngResult As LongstrFolder = String(MAX_PATH, 0)lngResult = GetTempPath(MAX_PATH, strFolder)If lngResult <> 0 ThenGetTmpPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)Else: GetTmpPath = ""End IfEnd Function‘在程序中使用方法如下：Private Sub Command1_Click()Call MsgBox("您电脑中 Temp 目录的正确路径是" & GetTmpPath, vbInformation)End Sub127、建立 Windows95/98 的快捷方式在前面我们提到过快捷方式，不过当时提到的快捷方式是专门用于连结 Internet 的网页使用的，现在我们要谈的则是在 Windows95/98 中的一般快捷方式，也就是要放在【开始】或【桌面】上，方便使用者启动程序的快捷方式！‘请在声明区中加入以下的声明：(以下为 VB4-32 / VB5)‘VB4-32Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName as String, ByVal lpstrLinkName as String, ByVal lpstrLinkPath as String, ByVal lpstrLinkArgs as String) As Long‘VB5Declare Function OSfCreateShellLink Lib "VB5STKIT.DLL" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long‘参数说明：lpstrFolderName 要放置快捷方式的位置，但是指的是对应到【开始】的【程序】的相对位置【程序】的实际目录位置是 C:\Windows\Start Menu\Programs【桌面】的实际目录位置是 C:\Windows\Desktop所以如果想将快捷方式放在桌面上，此参数的设定值应为 "..\..\Desktop"lpstrLinkName 快捷方式要显示出来的说明文字lpstrLinkPath 快捷方式要开启或执行的文件的实际位置lpstrLinkArgs 开启或执行的文件若需要参数，则放在这　‘在程序中使用的方法如下：lngResult = fCreateShellLink("..\..\Desktop", "记事本捷径", " c:\windows\notepad.exe","")128、如何用 VB 呼叫出在【查找：所有文件】中的【浏览资料夹】问话框？相信大家都使用过 Windows 95/98 的【开始】【查找】【文件或资料夹...】功能，当然【查找】的功能不一定要从【开始】开始，在 Windows 的很多地方，例如【资源管理器】或【我的电脑】...等，都可以按下滑鼠右键来使用【查找】的功能。在【查找：所有文件】问话框中，在【名称及位置】页中，有一个【浏览】的按钮，按下后会出现一个大家似曾相识的问话框，叫作【浏览资料夹】问话框，在这个问话框中，您可以看到电脑中所有的磁盘及资料夹，您知道在 VB中要如何呼叫它吗？‘请在声明区中加入以下声明：Private Const BIF_RETURNONLYFSDIRS = 1Private Const BIF_DONTGOBELOWDOMAIN = 2Private Const MAX_PATH = 260Private Declare Function SHBrowseForFolder Lib "shell32" _(lpbi As BrowseInfo) As LongPrivate Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As LongPrivate Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As LongPrivate Type BrowseInfohWndOwner As LongpIDLRoot As LongpszDisplayName As LonglpszTitle As LongulFlags As LonglpfnCallback As LonglParam As LongiImage As LongEnd Type‘在 Form 中放一个 CommandButton，并加入以下程序：Private Sub Command1_Click()Dim lpIDList As LongDim sBuffer As StringDim szTitle As StringDim tBrowseInfo As BrowseInfoszTitle = "请选择要开始搜寻的资料夹" ‘<-- 此标题可根据　要自行更改With tBrowseInfo.hWndOwner = Me.hWnd.lpszTitle = lstrcat(szTitle, "").ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAINEnd WithlpIDList = SHBrowseForFolder(tBrowseInfo)If (lpIDList) ThensBuffer = Space(MAX_PATH)SHGetPathFromIDList lpIDList, sBuffersBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)MsgBox sBufferEnd IfEnd Sub‘好了，执行您的程序，按下按钮看看结果吧！129、让您的文字框有 Undo / Redo 的功能很多软件都有提供 Undo / Redo 的功能，Microsoft 的产品都可以提供多次 Undo 反悔，功能更强大！在 VB 的程序中，我们也可以提供这样的功能！不过只能 Undo / Redo 一次‘在声明区中加入以下声明：‘32位元‘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 EM_UNDO = &HC7‘16位元Private Declare Function SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As LongConst WM_USER = &H400Const EM_UNDO = WM_USER + 23‘在程序中使用的方式如下： ( Undo Text1 中的输入 )Private Sub Command1_Click()Dim UndoResult As LongUndoResult = SendMessage(Text1.hwnd, EM_UNDO, 0, 0)‘传回值 UndoResult = -1 表示 Undo 不成功End Sub‘使用以上的方法，第一次是 Undo ，第二次就等于是 Redo130、如何使点矩阵印表机一次只印一行VB 有提供一个 Printer 物件来帮我们做列印，但是，当我们使用点矩阵印表机列印时，若希望每次只列印一行资料后，印表机不要自动跳页，继续等待列印！这时候往往造成很多人的困扰，因为：若不使用 NewPage 和 EndDoc 方法就不会立刻印出，但是用了又会跳页。这时候，我们就不能再使用 Printer 物件，然而我们可以用以前在 Dos 时代使用的方法如下：Open "PRN" For Output As #1Print #1,"列印内容"但是有一点必须注意的是：上面这个方式绝对可以单行列印英文，但是若你想印中英文, 你的印表机必须有内建中文字体才行！VB问题全功略（27） [查找本页请按Ctrl+F]［上一页］（27）［下一页］131、Printer 物件如何控制打印机跳页至指定的地方?132、如何在按下 Enter 键之后，自动让 Focus 移到下一个物件？133、如何隐藏及显示任务栏？134、取得应用程序执行的路径135、清除 ListBox 及 ComboBox 中重复的项目131、Printer 物件如何控制打印机跳页至指定的地方?在网站上有人提出这样的问题：用 VB6 写一打印程序,打印机是点矩阵的,而纸张为公司特别定做的,所以当用 EndDoc 方法打印时,无法控制打印机跳页至指定的地方(就是可用手撕纸的那一条虚线)VB 的 Printer 物件提供的 EndDoc 会自动根据我们设定的纸张大小，自动跳到下一页，但是当我们所使用的纸张是特殊大小时 (很多套印的表格都是特殊大小的尺寸)，若要让打印机的跳页正常，并不需更改我们的程序，要更改的是我们机器上该打印机的纸张大小的设定。1、开启【我的电脑】，开启【打印机】(或由【开始】或【控制面板】开启打印机)。2、在该点矩阵打印机上按鼠标右键选择【内容】，出现该打印机的【内容】问话框。3、选择【纸张】页签。4、纸张大小选择【自订】，会出现【使用者定义大小】问话框。5、输入纸张的宽度和长度，单位有二种 ( 0.01英寸 / 0.1公　 )用以上的方法设定好后，您就可以不用管纸张大小了，下一次它换页时就会自动跳页至指定的地方。132、如何在按下 Enter 键之后，自动让 Focus 移到下一个物件？如果您希望使用者在 TextBox 中按下 Enter 键之后，能够让 Focus 在各个物件之间游移，在 KeyPress 事件中您就必须判断是否有按下 Enter 键，如果有的话，您就必须取消 Enter 键，并送出一个 Tab 键。在 VB 中，当您送出一个 Tab 键后，游标会依照 TabIndex 的顺序，在各物件之间移动。若要照 TabIndex 顺序移动，指令为 SendKeys "{tab}"若要照 TabIndex 反顺序移动，指令为 SendKeys "+{tab}"其实以上的方法不只适用于 TextBox 物件，很多物件都适用这个原则，但是 CommandButton 就不行了！因为 CommandButton 根本就没有 KeyPress 事件！以下是一段范例程序：Sub Text1_KeyPress (KeyAscii As Integer)If KeyAscii = 13 ThenSendKeys "{tab}"KeyAscii = 0End IfEnd Sub133、如何隐藏及显示任务栏？有时候，我们希望在我们的程序执行中，将任务栏隐藏，让桌面变得比较清爽，等到我们的程序执行完毕之后，再将任务栏显示出来，这时就要用到 SetWindowPos 这个 API 了！Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongConst SWP_HIDEWINDOW = &H80 ‘隐藏视窗Const SWP_SHOWWINDOW = &H40 ‘显示视窗‘在程序中若要隐藏任务栏Private Sub Command1_Click()Dim Thwnd As LongThwnd = FindWindow("Shell_traywnd", "")Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)End Sub‘在程序中若要再显示任务栏Private Sub Command2_Click()Dim Thwnd As LongThwnd = FindWindow("Shell_traywnd", "")Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)End Sub134、取得应用程序执行的路径有时候执行我们的应用程序时，会用到一些和应用程序相关的文件，例如资料库、图档、文字档...等，这些文件我们通常都会放在和应用程序相同的目录或子目录中，于是在我们的应用程序中便有抓取应用程序现行目录的　求，在此我们介绍二种方法：1、App.Path：返回值自动转为大写。2、CurDir：返回值为大小写混合。使用范例如下：Private Sub Command1_Click()Text1.text = App.PathText2.text = CurDirEnd Sub135、清除 ListBox 及 ComboBox 中重复的项目当我们要将一大堆资料加入 ListBox 或 ComboBox 时，为了不让 ListBox 或 ComboBox 中的项目重复，有些人会在将新项目加入 ListBox 或 ComboBox 时，就先作项目比对，资料没有重复时，才将资料加入 ListBox 或 ComboBox 中。但是如果我们将资料统统加入 ListBox 或 ComboBox 之后，再来执行比对动作，不但程序容易维护，而且速度会加快一点点，以下的模组就是做项目比对，以清除 ListBox 或 ComboBox 中重复的项目。模组中需要传入二个参数，说明如下：1、控制项名称：可传入 ListBox 或 ComboBox 的名称。2、是否分别大小写：True 表示要分别大小写，False 则不分大小写。Sub RemoveDups(lst As Control, comptype As Boolean)Dim lPos As Long ‘原始比对项目 indexDim lCompPos As Long ‘待比对项目 indexDim sComp As String ‘原始比对字串Dim sComptype As Long ‘0(binary) / 1(textual) 比对lPos = 0If comptype Then sComptype = 0 Else sComptype = 1Do While lPos < (lst.ListCount - 1)sComp = lst.List(lPos)lCompPos = lPos + 1Do While lCompPos < lst.ListCountIf StrComp(sComp, lst.List(lCompPos), sComptype) = 0 Thenlst.RemoveItem lCompPoslCompPos = lCompPos - 1End IflCompPos = lCompPos + 1LooplPos = lPos + 1LoopEnd Sub‘在程序中使用方式如下：‘要分别大小写Private Sub Command1_Click()RemoveDups List1, TrueRemoveDups Combo1, TrueEnd Sub‘不分别大小写Private Sub Command2_Click()RemoveDups List1, FalseRemoveDups Combo1, FalseEnd Sub136、找出电脑中已经安装的输入法‘在 Form 中加入一个 ListBox，在声明区中加入以下声明：Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As LongPrivate Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" (ByVal HKL As Long, ByVal lpsz As String, ByVal uBufLen As Long) As LongPrivate Declare Function ImmIsIME Lib "imm32.dll" (ByVal HKL As Long) As Long‘在 Form_Load 中加入以下程序码：Private Sub Form_Load()Dim No As Long, i As LongDim hKB(24) As Long, bufflen As LongDim buff As String, RetStr As String, RetCount As Longbuff = String(255, 0)No = GetKeyboardLayoutList(25, hKB(0))For i = 1 To NoIf ImmIsIME(hKB(i - 1)) = 1 Thenbufflen = 255RetCount = ImmGetDescription(hKB(i - 1), buff, bufflen)RetStr = Left(buff, RetCount)List1.AddItem RetStrElseRetStr = "English(American)"List1.AddItem RetStrEnd IfNextEnd Sub137、如何将一串阿拉伯数字转成中文数字字串？在我们的应用系统中，有时候要产生一些比较正式的报表 (套表)，例如合约书、电脑开票....等，在这些报表中，关于数字的部份，尤其是金额的部份，为了防止纠纷的产生，通常都必须将阿拉伯数字转成中文大写数字，这种工作，人工做起来很简单，电脑来做，可就要花点工夫了！以下几个 Function 就是用来处理这个工作的，其中最主要的就是 numbertoword 这个 Function，程序中要呼叫的也就是这个 Function，其他三个 Function 只是配合这个 Function 而已。‘在程序中只要如右使用即可：返回中文数字 = numbertoword( 阿拉伯数字 )程序码如下：Public Function numbertoword(number As String) As String‘-------------------------------------------------------------------‘目的:转换一串阿拉伯数字为中文数字‘参数:一串阿拉伯数字‘返回值:转换后的一串中文数字‘---------------------------------------------------------------------------------------------------------------------------------‘注: 此一 Function 必须包含以下三个 Function‘1.mapword:转换单一数字为国数字(0123456789->零壹贰参肆伍陆柒捌玖)‘2.StringCleaner:清除字串中不要的字元‘3.convtoword:将传入的四个数字转成中文数字字串(1234->壹仟贰佰参拾肆)‘---------------------------------------------------------------------------------------------------------------------------------Dim wlength As Integer ‘数字字串总长度Dim wsection As Integer ‘归属的段落 (0:万以下/1:万/2:亿/3:兆)Dim wcount As Integer ‘剩余的数字字串长度Dim wstr As String ‘暂存字串Dim wstr1 As String ‘暂存字串-兆Dim wstr2 As String ‘暂存字串-亿Dim wstr3 As String ‘暂存字串-万Dim wstr4 As String ‘暂存字串-万以下‘未输入或0不做‘-----------------------------------------------If Trim(number) = "" Or Trim(number) = "0" Thennumbertoword = "零"Exit FunctionEnd If‘-----------------------------------------------wlength = Len(number)wsection = wlength \ 4wcount = wlength Mod 4‘-----------------------------------------------‘每四位一组, 分段 (兆/亿/万/万以下)If wcount = 0 Thenwcount = 4wsection = wsection - 1End If‘----------------------------------------------‘大于兆的四位数转换If wsection = 3 Then‘抓出大于兆的四位数wstr = Left(Format(number, "0000000000000000"), 4)‘转换wstr1 = convtoword(wstr)If wstr1 <> "零" Then wstr1 = wstr1 & "兆"End If‘----------------------------------------------‘大于亿的四位数转换If wsection >= 2 Then‘抓出大于亿的四位数If Len(number) > 12 Thenwstr = Left(Right(number, 12), 4)Elsewstr = Left(Format(number, "000000000000"), 4)End If‘转换wstr2 = convtoword(wstr)If wstr2 <> "零" Then wstr2 = wstr2 & "亿"End If‘----------------------------------------------‘大于万的四位数转换If wsection >= 1 Then‘抓出大于万的四位数If Len(number) > 8 Thenwstr = Left(Right(number, 8), 4)Elsewstr = Left(Format(number, "00000000"), 4)End If‘转换wstr3 = convtoword(wstr)If wstr3 <> "零" Then wstr3 = wstr3 & "万"End If‘----------------------------------------------‘万以下的四位数转换‘抓出万以下的四位数If Len(number) > 4 Thenwstr = Right(number, 4)Elsewstr = Format(number, "0000")End If‘转换wstr4 = convtoword(wstr)‘----------------------------------------------‘组合最多四组字串(兆/亿/万/万以下)numbertoword = wstr1 & wstr2 & wstr3 & wstr4‘去除重复的零 (‘零零‘-->‘零‘)Do While InStr(1, numbertoword, "零零")numbertoword = StringCleaner(numbertoword, "零零")Loop‘----------------------------------------------‘去除最左边的零If Left(numbertoword, 1) = "零" Thennumbertoword = Mid(numbertoword, 2)End If‘----------------------------------------------‘去除最右边的零If Right(numbertoword, 1) = "零" Thennumbertoword = Mid(numbertoword, 1, Len(numbertoword) - 1)End IfEnd FunctionPublic Function mapword(no As String) As String‘-----------------------------------------------------------‘目的:转换单一数字为国数字(0123456789->零壹贰参肆伍陆柒捌玖)‘参数:数字(0123456789)‘返回值:国数字(零壹贰参肆伍陆柒捌玖)‘-----------------------------------------------------------Select Case noCase "0"mapword = "零"Case 1mapword = "壹"Case "2"mapword = "贰"Case "3"mapword = "参"Case "4"mapword = "肆"Case "5"mapword = "伍"Case "6"mapword = "陆"Case "7"mapword = "柒"Case "8"mapword = "捌"Case "9"mapword = "玖"End SelectEnd FunctionPublic Function StringCleaner(s As String, Search As String) As String‘-----------------------------------------------------------‘目的:清除字串中不要的字元‘参数:1.完整字串. 2.要清除的字元(可含多字元)‘返回值:清除后的字串‘‘‘此段之主要目的在去除重复的 ‘零‘ (‘零零‘-->‘零‘)‘-----------------------------------------------------------Dim i As Integer, res As Stringres = sDo While InStr(res, Search)i = InStr(res, Search)res = Left(res, i - 1) & Mid(res, i + 1)LoopStringCleaner = resEnd FunctionPublic Function convtoword(wstr As String) As String‘-----------------------------------------------------------‘目的:将传入的四个数字转成中文数字字串(1234->壹仟贰佰参拾肆)‘参数:4位数的数字 (前面空白补0)‘返回值:转换后的中文数字字串‘-----------------------------------------------------------Dim tempword As String‘仟位数tempword = mapword(Mid(wstr, 1, 1))If tempword <> "零" Then tempword = tempword & "仟"convtoword = convtoword & tempword‘佰位数tempword = mapword(Mid(wstr, 2, 1))If tempword <> "零" Then tempword = tempword & "佰"convtoword = convtoword & tempword‘拾位数tempword = mapword(Mid(wstr, 3, 1))If tempword <> "零" Then tempword = tempword & "拾"convtoword = convtoword & tempword‘个位数tempword = mapword(Mid(wstr, 4, 1))convtoword = convtoword & tempword‘去除最右边的零Do While Right(convtoword, 1) = "零" And Len(convtoword) > 1convtoword = Mid(convtoword, 1, Len(convtoword) - 1)LoopEnd Function‘在程序中只要如右使用即可：返回中文数字 = numbertoword( 阿拉伯数字 )‘-----------------------------------------------------------‘程序中使用实例 ( 加上错误判断 )‘在 Form 中放二个 TextBox 及一个 CommandButton‘Text1 输入数字, Text2 显示转换结果‘-----------------------------------------------------------Private Sub Command1_Click()Text2 = ""‘去除小数点If InStr(1, Text1, ".") <> 0 ThenText1 = Mid(Text1, 1, InStr(1, Text1, ".") - 1)End If‘去除逗点Text1 = StringCleaner(Text1, ",")‘判断不含非数字Dim i As IntegerDim werr As StringFor i = 1 To Len(Text1)If Asc(Mid(Text1, i, 1)) < 48 Or Asc(Mid(Text1, i, 1)) > 57 Thenwerr = "Y"Exit ForEnd IfNextIf werr = "Y" ThenMsgBox "不可含非数字"‘focus 回到 text1 方便输入Text1.SetFocusText1.SelStart = 0Text1.SelLength = Len(Text1)Exit SubEnd If‘主要程序只一行-----------Text2 = numbertoword(Text1)‘-------------------------‘focus 回到 text1 方便输入Text1.SetFocusText1.SelStart = 0Text1.SelLength = Len(Text1)End Sub138、如何将一串阿拉伯数字转成英文数字字串？在在同样情形下，有些情况，我们也必须将阿拉伯数字转成英文数字，以下这个 Function 就是用来处理这个工作的。‘在程序中只要如右使用即可：返回英文数字 = numtoword( 阿拉伯数字 )先看看结果：程序码如下：Public Function numtoword(numstr As Variant) As String‘----------------------------------------------------‘ The best data type to feed in is‘ Decimal, but it is up to you‘----------------------------------------------------Dim tempstr As StringDim newstr As Stringnumstr = CDec(numstr)If numstr = 0 Thennumtoword = "zero "Exit FunctionEnd IfIf numstr > 10 ^ 24 Thennumtoword = "Too big"Exit FunctionEnd IfIf numstr >= 10 ^ 12 Thennewstr = numtoword(Int(numstr / 10 ^ 12))numstr = ((numstr / 10 ^ 12) - Int(numstr / 10 ^ 12)) * 10 ^ 12If numstr = 0 Thentempstr = tempstr & newstr & "billion "Elsetempstr = tempstr & newstr & "billion, "End IfEnd IfIf numstr >= 10 ^ 6 Thennewstr = numtoword(Int(numstr / 10 ^ 6))numstr = ((numstr / 10 ^ 6) - Int(numstr / 10 ^ 6)) * 10 ^ 6If numstr = 0 Thentempstr = tempstr & newstr & "million "Elsetempstr = tempstr & newstr & "million, "End IfEnd IfIf numstr >= 10 ^ 3 Thennewstr = numtoword(Int(numstr / 10 ^ 3))numstr = ((numstr / 10 ^ 3) - Int(numstr / 10 ^ 3)) * 10 ^ 3If numstr = 0 Thentempstr = tempstr & newstr & "thousand "Elsetempstr = tempstr & newstr & "thousand, "End IfEnd IfIf numstr >= 10 ^ 2 Thennewstr = numtoword(Int(numstr / 10 ^ 2))numstr = ((numstr / 10 ^ 2) - Int(numstr / 10 ^ 2)) * 10 ^ 2If numstr = 0 Thentempstr = tempstr & newstr & "hundred "Elsetempstr = tempstr & newstr & "hundred and "End IfEnd IfIf numstr >= 20 ThenSelect Case Int(numstr / 10)Case 2tempstr = tempstr & "twenty "Case 3tempstr = tempstr & "thirty "Case 4tempstr = tempstr & "forty "Case 5tempstr = tempstr & "fifty "Case 6tempstr = tempstr & "sixty "Case 7tempstr = tempstr & "seventy "Case 8tempstr = tempstr & "eighty "Case 9tempstr = tempstr & "ninety "End Selectnumstr = ((numstr / 10) - Int(numstr / 10)) * 10End IfIf numstr > 0 ThenSelect Case numstrCase 1tempstr = tempstr & "one "Case 2tempstr = tempstr & "two "Case 3tempstr = tempstr & "three "Case 4tempstr = tempstr & "four "Case 5tempstr = tempstr & "five "Case 6tempstr = tempstr & "six "Case 7tempstr = tempstr & "seven "Case 8tempstr = tempstr & "eight "Case 9tempstr = tempstr & "nine "Case 10tempstr = tempstr & "ten "Case 11tempstr = tempstr & "eleven "Case 12tempstr = tempstr & "twelve "Case 13tempstr = tempstr & "thirteen "Case 14tempstr = tempstr & "fourteen "Case 15tempstr = tempstr & "fifteen "Case 16tempstr = tempstr & "sixteen "Case 17tempstr = tempstr & "seventeen "Case 18tempstr = tempstr & "eighteen "Case 19tempstr = tempstr & "nineteen "End Selectnumstr = ((numstr / 10) - Int(numstr / 10)) * 10End Ifnumtoword = tempstrEnd Function‘在程序中使用实例：Text1是输入的阿拉伯数字，Text2 是返回的英文字Text2 = numtoword(Text1)139、如何取得屏幕字体Private Sub Combo1_Click()Label1.Font = Combo1.List(Combo1.ListIndex)End SubPrivate Sub Combo1_KeyPress(KeyAscii As Integer)KeyAscii = 0End SubPrivate Sub Command1_Click()Dim i As IntegerFor i = 0 To Screen.FontCount - 1Combo1.AddItem Screen.Fonts(i)Next iCombo1.Text = Combo1.List(0)End Sub140、如何得到某年每个月的第一天是星期几Private Sub Command1_Click()Dim i As Integer, A As Integer, B As Integer, C As StringA = InputBox("请输入年份", "某年每个月的第一天是星期几")Form1.ClsFor i = 1 To 12C = A & "-" & i & "-1"B = Weekday(C)Select Case BCase vbSundayPrint A & "年" & i & "月1日是 星期日"Case vbMondayPrint A & "年" & i & "月1日是 星期一"Case vbTuesdayPrint A & "年" & i & "月1日是 星期二"Case vbWednesdayPrint A & "年" & i & "月1日是 星期三"Case vbThursdayPrint A & "年" & i & "月1日是 星期四"Case vbFridayPrint A & "年" & i & "月1日是 星期五"Case vbSaturdayPrint A & "年" & i & "月1日是 星期六"End SelectNext iEnd Sub141、在 VB 程序中做复制磁片 (DiskCopy) 的功能下面这一段程序并不是实际在程序中就做复制磁片的功能，而是呼叫出 Windows 系统的复制磁片问话框！‘在声明区中加入以下声明Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As LongPrivate Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long‘在 Form 中加入一个 CommandButton 命名为 cmdDiskCopy，再加入一个 DriveListBoxPrivate Sub cmdDiskCopy_Click()‘ DiskCopyRunDll takes two parameters- From and ToDim DriveLetter$, DriveNumber&, DriveType&Dim RetVal&, RetFromMsg&DriveLetter = UCase(Drive1.Drive) ‘磁盘代号 ( A / B / C / D..... )DriveNumber = (Asc(DriveLetter) - 65) ‘磁盘序号，从 0 开始：A=0，B=1....DriveType = GetDriveType(DriveLetter) ‘磁盘型态 ( 软盘 / 硬盘 / 光盘 ... )If DriveType = 2 Then ‘软盘RetVal = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll " & DriveNumber & "," & DriveNumber, 1) ‘Notice space afterElse ‘非软盘RetFromMsg = MsgBox("只有磁盘片才可以复制磁片", 64, "复制磁片")End IfEnd Sub142、在 VB 程序中做制作格式 (Format) 的功能下面这一段程序并不是实际在程序中就做制作格式的功能，而是呼叫出 Windows 系统的制作格式问话框！这个范例程序是从网络上抓下来的，原作者特别注明，这一段程序也可以格式化硬盘，所以要小心控制，程序码中格式化硬盘的部份，我已经 Mark 起来了，若有需要，才将 Mark 拿掉吧！软盘格式化的部份我已测试过没问题，硬盘的部份，我没有空硬盘所以没有测试，大家自己玩玩吧！若有问题再通知我！‘在声明区中加入以下声明Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As LongPrivate Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long‘在 Form 中加入一个 CommandButton 命名为 cmdFormatDrive，再加入一个 DriveListBoxPrivate Sub cmdFormatDrive_Click()Dim DriveLetter$, DriveNumber&, DriveType&Dim RetVal&, RetFromMsg%DriveLetter = UCase(Drive1.Drive) ‘磁盘代号 ( A / B / C / D..... )DriveNumber = (Asc(DriveLetter) - 65) ‘磁盘序号，从 0 开始：A=0，B=1....DriveType = GetDriveType(DriveLetter) ‘磁盘型态 ( 软盘 / 硬盘 / 光盘 ... )If DriveType = 2 Then ‘软盘RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)Else ‘非软盘RetFromMsg = MsgBox("这一张磁盘不是软盘，可能是硬盘！" & vbCrLf & _"您还要继续格式 (Format) 吗?", 276, "格式化")Select Case RetFromMsgCase 6 ‘Yes：表示要格式化硬盘‘ UnComment to do it...‘RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)Case 7 ‘No：表示要取消格式化‘ Do nothingEnd SelectEnd IfEnd Sub143、简简单单做到【剪下 / 复制 / 贴上 / 复原】的功能在很多软件的编辑功能表中，都有提供【剪下 / 复制 / 贴上 / 复原】的功能，在 VB 中我们只要借用 Windows 的系统功能，很容易也可以有这样的功能，看看以下的程序码便能了解了！Sub mnuEditText_Click (Index As Integer)‘ 我们只要使用 SendKeys，其他的就让 Windows 去做吧！Select Case IndexCase 0 ‘复原/UNDOSendKeys "^Z" ‘Keys Ctrl+ZCase 1 ‘剪下/CUTSendKeys "^X" ‘Keys Ctrl+XCase 2 ‘复制/COPYSendKeys "^C" ‘Keys Ctrl+CCase 3 ‘贴上/PASTESendKeys "^V" ‘Keys Ctrl+VEnd SelectEnd Sub144、如何侦测电脑目前是否正在连线中？有些应用程序在程序中有部份功能必须和 Internet 连结沟通，这时候，侦测电脑目前是否正在连线状态就显得很重要了，每当在 Windows 中拨接上网之后，Windows 系统会自动在注册表中做上一点记号 (改变注册表中某些键值的资料)，而我们在 VB 程序中就可以利用这些改变的键值来判断电脑目前是否正在连线状态！‘在模组的声明区中加入以下声明及模组：Public Const ERROR_SUCCESS = 0&Public Const APINULL = 0&Public Const HKEY_LOCAL_MACHINE = &H80000002Public ReturnCode As LongDeclare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongDeclare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As LongDeclare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As LongPublic Function ActiveConnection() As BooleanDim hKey As LongDim lpSubKey As StringDim phkResult As LongDim lpValueName As StringDim lpReserved As LongDim lpType As LongDim lpData As LongDim lpcbData As LongActiveConnection = FalselpSubKey = "System\CurrentControlSet\Services\RemoteAccess"ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)If ReturnCode = ERROR_SUCCESS ThenhKey = phkResultlpValueName = "Remote Connection"lpReserved = APINULLlpType = APINULLlpData = APINULLlpcbData = APINULLReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData)lpcbData = Len(lpData)ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)If ReturnCode = ERROR_SUCCESS ThenIf lpData = 0 ThenActiveConnection = FalseElseActiveConnection = TrueEnd IfEnd IfRegCloseKey (hKey)End IfEnd Function‘而在程序中使用实例如下：If ActiveConnection = True thenCall MsgBox("您的电脑目前正在连线中！",vbInformation)ElseCall MsgBox("您的电脑目前在离线状态！.", vbInformation)End If145、如何在程序中启动【拨号网络连线】对话框？要直接在 VB 程序中开启【拨号网络连线】对话框，要使用 Shell 函数：Private Sub Command1_Click()Dim resres = Shell("rundll32.exe rnaui.dll,RnaDial " & "拨号网络连线名称", 1)End Sub其中 "拨号网络连线名称" 是我们事先在 【拨号网络】中设定的【连线名称】，例如【Hinet】。注：以上方法只适用于 Windows95/98。146、如何中断【拨号网路连线】？要在 VB 程序中中断【拨号网路连线】，可以使用 Remote Access Services Hangup 函数：‘在模组的声明区中加入以下声明及模组：Public Const RAS_MAXENTRYNAME As Integer = 256Public Const RAS_MAXDEVICETYPE As Integer = 16Public Const RAS_MAXDEVICENAME As Integer = 128Public Const RAS_RASCONNSIZE As Integer = 412Public Const ERROR_SUCCESS = 0&Public Type RasEntryNamedwSize As LongszEntryName(RAS_MAXENTRYNAME) As ByteEnd TypePublic Type RasConndwSize As LonghRasConn As LongszEntryName(RAS_MAXENTRYNAME) As ByteszDeviceType(RAS_MAXDEVICETYPE) As ByteszDeviceName(RAS_MAXDEVICENAME) As ByteEnd TypePublic Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As LongPublic Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As LongPublic gstrISPName As StringPublic ReturnCode As LongPublic Sub HangUp()Dim i As LongDim lpRasConn(255) As RasConnDim lpcb As LongDim lpcConnections As LongDim hRasConn As LonglpRasConn(0).dwSize = RAS_RASCONNSIZElpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSizelpcConnections = 0ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)If ReturnCode = ERROR_SUCCESS ThenFor i = 0 To lpcConnections - 1If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) ThenhRasConn = lpRasConn(i).hRasConnReturnCode = RasHangUp(ByVal hRasConn)End IfNext iEnd IfEnd SubPublic Function ByteToString(bytString() As Byte) As StringDim i As IntegerByteToString = ""i = 0While bytString(i) = 0&ByteToString = ByteToString & Chr(bytString(i))i = i + 1WendEnd Function‘在程序中使用实例为Call HangUp147、资料库的导出在很多 VB 的资料库书籍中，都会很完整的提到：如何由其他种类的文件中将资料导入资料库，但是却很少有书提到：如何将资料库中的资料，导出到各种不同的文件类型的文件中，连 VB 的 Help 中也是这样！或许是大家都认为资料库主题的重点是在资料库本身吧！但是，在实际的资料库程序运用中，却常常需要将资料库导出到各种不同的文件类型的文件中，这些文件可能是 DBase文件、文字文件 (.Txt)、Excel 文件、Html 文件、Access 文件或其他类型的资料库文件 (ODBC)...等。在本专题中，考虑到并不是每一个人都有 Oracle 或 SQL Server 的环境，为了让大家都能够实作，我们将以 Access 资料库来作练习，而练习的文件也使用 VB 本身提供的 Biblio.mdb (位于各版本 VB 的目录下)。预计要练习导出的文件类型有五种：DBase文件、文字文件 (.Txt)、Html 文件、Excel 文件、Access 文件。除了这五种之外，下面的语法可以将资料库之资料导出到任一种 VB 支援的资料库或文件中。在练习之前，要将导出文件的 SQL 语法先说明一下：SELECT Table.Fields INTO [dbms type;DATABASE=path].[unqualified filename] FROM [Table or Tables]SELECT Table.Fields INTO [资料库种类;DATABASE=资料库路径].[资料库文件名称] FROM [Table or Tables]至于【资料库种类】及【资料库路径】，视资料库或文件类型之不同而异，详见【注一】。如果上面说的都清楚了，那我们要开始这一个练习了！在 Form 上放置一个 CommandButton，在【专案】【设定引用项目】中加入 Microsoft DAO 3.51 Object Library，我们将使用 Biblio.mdb 的 authors Table，在 Command1_Click 中加入以下程序码：Dim db As DatabaseSet db = Workspaces(0).OpenDatabase(App.Path & "\biblio.mdb")‘db.execute "SELECT Table.Fields INTO [dbms type;DATABASE=path].[unqualified filename] FROM [Table or Tables]"在以上程序中，db.execute 指令行之指令依资料库或文件的种类说明如下：一、DBase文件SQL 语法：SELECT * INTO [dBase III;DATABASE=资料库路径].[dbase文件名称] FROM [authors]db.Execute "SELECT * INTO [dBase III;DATABASE=C:\test].[authors.DBF] FROM [authors]"注意事项：1、authors.DBF 事先不可存在，否则会产生错误！2、若您没有 Dbase，您可以使用 Access 来连结这个 Table，以便观察结果！二、文本文件 (.Txt)SQL 语法：SELECT * INTO [Text;DATABASE=文本文件路径].[文本文件名称] FROM [authors]db.Execute "SELECT * INTO [Text;DATABASE=C:\test].[authors.TXT] FROM [authors]"注意事项：1、authors.TXT 事先不可存在，否则会产生错误！2、此动作会产生的文件有二个，第一个就是文本文件 authors.TXT，第二个是 Schema.ini。3、文本文件之格式为 CSV 之文件格式，即各栏位间以逗点分开，实际呈现方式如下：　　"Au_ID","Author","Year Born"　　1,"Jacobs, Russell",1950　　2,"Metzger, Philip W.",19424、Schema.ini 若事先不存在会新产生一个，若已存在，则会在原文件后面直接 Append。5、至于 Schema.ini 的属性为此次导出的相关资讯，格式同一般的 Ini 文件，详细属性如下：　　[authors.TXT]　　ColNameHeader=True　　CharacterSet=OEM　　Format=CSVDelimited　　Col1=Au_ID Integer　　Col2=Author Char Width 50　　Col3="Year Born" Short三、Html 文件SQL 语法：SELECT * INTO [Excel 8.0;DATABASE=Html文件路径].[Html文件名称] FROM [authors]db.Execute "SELECT * INTO [HTML Export;DATABASE=C:\test].[authors.HTM] FROM [authors]"注意事项：1、authors.HTM 事先不可存在，否则会产生错误！2、此动作会产生的文件有二个，第一个就是文本文件 authors.HTM，第二个是 Schema.ini。3、Schema.ini 若事先不存在会新产生一个，若已存在，则会在原文件后面直接 Append。4、至于 Schema.ini 的属性为此次导出的相关资讯，格式同一般的 Ini 文件，详细属性如下：　　[authors.HTM]　　ColNameHeader=True　　CharacterSet=ANSI　　Format=HTML　　Col1=Au_ID Integer　　Col2=Author Char Width 50　　Col3="Year Born" Short四、Excel 文件SQL 语法：SELECT * INTO [Excel 8.0;DATABASE=文件路径+文件名].[工作表名称] FROM [authors]db.Execute "SELECT * INTO [Excel 8.0;DATABASE=C:\test\authors.XLS].[authors] FROM [authors]"注意事项：1、authors.XLS 可事先存在，也可以不存在，会自动产生一个。2、工作表 authors 事先不可存在，否则会产生错误！五、Access 文件SQL 语法：SELECT * INTO [新资料库路径+文件名][新资料表名称] FROM [authors]‘导出到同一资料库 ( 新 Table 为 authors1 )‘新 Table authors1 事先不可存在，否则会产生错误！db.Execute "SELECT * INTO [authors1] FROM [authors]"‘导出到不同的资料库 ( 新资料库为 db1，新 Table 为 authors )‘新资料库 db1事先必须存在，否则会产生错误！‘但是其中新 Table authors 事先不可存在，否则会产生错误！db.Execute "SELECT * INTO [C:\test\db1.mdb].[authors] FROM [authors]"注一：各种可能的资料库种类 Connect 属性设定方式：资料库种类 资料库声明方式 资料库路径 (或加上文件名)Microsoft Jet Database [database]; drive:\path\filename.mdbdBASE III dBASE III; drive:\pathdBASE IV dBASE IV; drive:\pathdBASE 5 dBASE 5.0; drive:\pathParadox 3.x Paradox 3.x; drive:\pathParadox 4.x Paradox 4.x; drive:\pathParadox 5.x Paradox 5.x; drive:\pathMicrosoft FoxPro 2.0 FoxPro 2.0; drive:\pathMicrosoft FoxPro 2.5 FoxPro 2.5; drive:\pathMicrosoft FoxPro 2.6 FoxPro 2.6; drive:\pathMicrosoft Visual FoxPro 3.0 FoxPro 3.0; drive:\pathMicrosoft Excel 3.0 Excel 3.0; drive:\path\filename.xlsMicrosoft Excel 4.0 Excel 4.0; drive:\path\filename.xlsMicrosoft Excel 5.0 or Microsoft Excel 95 Excel 5.0; drive:\path\filename.xlsMicrosoft Excel 97 Excel 8.0; drive:\path\filename.xlsLotus 1-2-3 WKS and WK1 Lotus WK1; drive:\path\filename.wk1Lotus 1-2-3 WK3 Lotus WK3; drive:\path\filename.wk3Lotus 1-2-3 WK4 Lotus WK4; drive:\path\filename.wk4HTML Import HTML Import; drive:\path\filenameHTML Export HTML Export; drive:\pathText Text; drive:\pathODBC ODBC;DATABASE=database;UID=user;PWD=password;DSN= datasourcename;[LOGINTIMEOUT=seconds;] NoneMicrosoft Exchange Exchange 4.0;MAPILEVEL=folderpath; [TABLETYPE={ 0 | 1 }];[PROFILE=profile;][PWD=password;][DATABASE=database;] drive:\path\filename.mdb148、模拟 Windows 的资源回收站！您现在将屏幕上所有的视窗全部缩小，找到资源回收站，按鼠标右键，选择【属性】，便会出现【资源回收站】的属性问话框。其中有几个选项如下：1、不要将文件移到资源回收站，删除时立即移除文件。2、显示删除确认对话框？根据以上之状况，文件之删除有三种情形：1、删除文件，出现确认对话框，文件移到资源回收站。2、删除文件，出现确认对话框，文件不移到资源回收站。3、删除文件，不出现确认对话框，文件也不移到资源回收站。模拟程序如下：‘在模组的声明区中加入以下声明：Public Type SHFILEOPSTRUCThwnd As LongwFunc As LongpFrom As StringpTo As StringfFlags As IntegerfAnyOperationsAborted As LonghNameMappings As LonglpszProgressTitle As LongEnd TypePublic Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As LongPublic Const FO_DELETE = &H3Public Const FOF_ALLOWUNDO = &H40 ‘可以还原Public Const FOF_NOCONFIRMATION = &H10 ‘不出现确认对话框Public Const FOF_SILENT = &H4‘在程序中之使用方法如下：‘以下之例子会出现确认对话框，文件也会移到资源回收站。Private Sub Command1_Click()Dim SHop As SHFILEOPSTRUCTDim strFile As String ‘要删除的文件(含全路径)strFile = "c:\test.txt"With SHop.wFunc = FO_DELETE.pFrom = strFile.fFlags = FOF_ALLOWUNDOEnd WithSHFileOperation SHopEnd Sub‘若要调整，只要更改 fFlags 之值即可，如下：.fFlags = FOF_SILENT ‘删除文件，出现确认对话框，文件不移到资源回收站。.fFlags = FOF_NOCONFIRMATION ‘删除文件，不出现确认对话框，文件也不移到资源回收站。149、如何得到文件路径的文件名Dim sFilePath As StringsFilePath = "C:\Windows\System\sytem.dll"Dim lGetLen As Long, lNum As LongDim sGetFile As String, sTemp As StringlGetLen = Len(sFilePath) ‘得到文件路径长度sTemp = lGetLenFor lNum = 1 To lGetLenIf Left(sGetFile, 1) = "\" Then Exit ForsGetFile = Mid(sFilePath, sTemp, lNum)sTemp = sTemp - 1Next lNumsGetFile = Mid(sGetFile, 2) ‘得到文件名MsgBox sGetFile150、如何用VB准确计算年龄Function CalcAge(datEmpDateOfBirth as Variant) as IntegerCalcAge = Int(DateDiff("y",datEmpDateOfBirth,Date())/365.25)End Function151、如何算出屏幕的分辨率？如果不使用 Third Party 的控制项，而希望程序的画面能随著屏幕的分辨率而自动调整各个控制项的位置及大小，其中最重要的一件事，便是算出目前执行程序的屏幕之分辨率！而分辨率要如何算呢？看看以下的程序便可知道！ResWidth = Screen.Width \ Screen.TwipsPerPixelXResHeight = Screen.Height \ Screen.TwipsPerPixelYScreenRes = ResWidth & "x" & ResHeightResWidth 就是指屏幕分辨率中的宽ResHeight 就是指屏幕分辨率中的长而最后算出的 ScreenRes，格式会像 800x600 一样！除了 800x600 之外，可能还有 640x480、1024x768....等。152、如何产生一个多行式的提示框 (ToolTipText)？VB5 以后的 VB 版本都有提供一个属性 -- ToolTipText，目的是让使用者在执行阶段，鼠标在物件上徘徊约一秒时，就将该物件的提示字串显示在该物件下面的一个小长方形中，以协助使用者做输入动作。有时候说明字串太长了，于是就有人想将提示字串分行显示，而且自然而然的使用 vbNewLine (=vbCrLf 或 =vbCr ) 来换行，因为根据以往的经验，VB都是这样做换行的，可是这一次很多人都踢到铁板了！VB 用来显示 ToolTipText 的提示框，其实是一个文字框，而且 MultiLine 属性并没有设为 True，您可以自己用一个单行式的文字框来做测试，就算您用 vbCrLf 来换行也不会有作用的！既然 VB 提供的 Default 功能不能满足我们的需求，而我们又想提供使用者多行式的提示框，那要怎么办呢？其实也不难，我们自己动手 DIY 一下就有了，而且程序码也不长！‘首先在 Form 上放一个 Timer (如果需要的话)，以便于叫出突现式说明框Private Function TimeOut(pInterval As Single)Dim sngTimer As SinglesngTimer = TimerDo While Timer < sngTimer + pIntervalDoEventsLoopEnd Function‘然后在 Form 上放一个 Label，取名为 lblToolTip，在 MouseMove 中加入以下程序：Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)lbltooltip.Visible = FalseEnd Sub‘在您想显示说明框的物件加入以下程序码： ( Textbox, listbox etc. )Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)TimeOut 0.3 ‘鼠标移到物件上多久后,要显示提示框lbltooltip.Caption = "大家好 !!" & vbCrLf & "" & vbCrLf & _"您目前看到的黄色标签" & vbCrLf & "是一个多行式的提示框"lbltooltip.Left = Text1.Left + lbltooltip.Widthlbltooltip.Top = Text1.Top + Text1.Heightlbltooltip.Visible = TrueEnd Sub153、如何改变屏幕的分辨率？如果希望使用者在跑我们开发的应用程序时，看到的画面的样子和我们在 Design Time 时一样的话，我们往往需要处理屏幕分辨率的问题，才能使程序的画面能随著屏幕的分辨率而自动调整各个控制项的位置及大小，但是这样子往往会使程序复杂化！除了以上这样子，将就使用者屏幕分辨率大小的民主式做法之外，您还有一个选择，那就是强制改掉使用者屏幕分辨率大小的暴权式做法，如果真的可以这么做，您根本就不用再去处理分辨率的问题了！在讨论区中，不时有人问到如何改变屏幕分辨率的大小，这是因为在 VB 32位元的 API 检视员中漏掉了有关 EnumDisplaySettings、ChangeDisplaySettings 的常数及宣告。‘在模组中加入以下宣告、常数、型态：Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As BooleanDeclare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As LongDeclare Function ExitWindowsEx Lib "user32" _(ByVal uFlags As Long, ByVal dwReserved As Long) As LongPublic Const EWX_LOGOFF = 0Public Const EWX_SHUTDOWN = 1Public Const EWX_REBOOT = 2Public Const EWX_FORCE = 4Public Const CCDEVICENAME = 32Public Const CCFORMNAME = 32Public Const DM_BITSPERPEL = &H40000Public Const DM_PELSWIDTH = &H80000Public Const DM_PELSHEIGHT = &H100000Public Const CDS_UPDATEREGISTRY = &H1Public Const CDS_TEST = &H4Public Const DISP_CHANGE_SUCCESSFUL = 0Public Const DISP_CHANGE_RESTART = 1Type DEVMODEdmDeviceName As String * CCDEVICENAMEdmSpecVersion As IntegerdmDriverVersion As IntegerdmSize As IntegerdmDriverExtra As IntegerdmFields As LongdmOrientation As IntegerdmPaperSize As IntegerdmPaperLength As IntegerdmPaperWidth As IntegerdmScale As IntegerdmCopies As IntegerdmDefaultSource As IntegerdmPrintQuality As IntegerdmColor As IntegerdmDuplex As IntegerdmYResolution As IntegerdmTTOption As IntegerdmCollate As IntegerdmFormName As String * CCFORMNAMEdmUnusedPadding As IntegerdmBitsPerPel As IntegerdmPelsWidth As LongdmPelsHeight As LongdmDisplayFlags As LongdmDisplayFrequency As LongEnd Type‘假设现在我们希望将分辨率改成 800X600，但是不要改变色板 ，程序如下：‘注：色板指的就是 16色 / 256色 / High Color (16Bit) / True Color (24Bit)Private Sub Command1_Click()Dim DevM As DEVMODE ‘将取得的讯息存放在 DevMerg& = EnumDisplaySettings(0&, 0&, DevM)DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT ‘Or DM_BITSPERPELDevM.dmPelsWidth = 800 ‘想要设定的屏幕宽度DevM.dmPelsHeight = 600 ‘想要设定的屏幕高度‘我们不更改色板，因为一旦更改色板就必须重新开机！‘DevM.dmBitsPerPel = 32 (could be 8, 16, 32 or even 4) ‘此行可用于改变色板‘以下这行指令会暂时更改屏幕的分辨率，是测试性的，不一定成功，‘不过因为没将设定值写到注册表，所以虽然可能更改成功，‘但是一旦重新开机后，会自动恢复成更改前的设定值erg& = ChangeDisplaySettings(DevM, CDS_TEST)‘上面的指令若成功，而且您想永久性的更改使用者的屏幕分辨率，‘您还必须使用下一行指令，将资料写到注册表‘erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)‘但是如果您只是想暂时更改使用者的屏幕分辨率，就不需要了.‘当然并不是您随便设定一个值，就一定会成功的更改屏幕分辨率,‘所以还需要检查是否更改成功！下面的程序就是检查是否更改成功Select Case erg&Case DISP_CHANGE_RESTART‘通常如果有更改到色板，或者较老的板子，会要求重新开机an = MsgBox("您必须重新开机！", vbYesNo + vbSystemModal, "讯息")If an = vbYes Thenerg& = ExitWindowsEx(EWX_REBOOT, 0&)End IfCase DISP_CHANGE_SUCCESSFUL‘如果更改成功且不需重新开机，您就可以将设定值写到注册表中erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)MsgBox "分辨率更改成功！", vbOKOnly + vbSystemModal, "成功！"Case Else‘更改不成功MsgBox "不支持此一模式！", vbOKOnly + vbSystemModal, "错误！"End SelectEnd Sub154、如何在程序中启动 NT 的【拨号网络连接】对话框？在【问题125】如何在程序中启动【拨号网络连接】对话框？我告诉大家如何在 VB 中用 Shell 去叫出【拨号网络连接】对话框，程序码如下：Private Sub Command1_Click()Dim resres = Shell("rundll32.exe rnaui.dll,RnaDial " & "拨号网络连接名称", 1)End Sub但是有网友反应，用上述的方法只有在 Windows 95/98 中才行得通，一碰到 Windows NT 可就没辄了！今天，我要告诉大家在 Windows NT 中，要如何做到相同的事情。不难，方法如下：Private Sub Command1_Click()Dim resres = Shell("rasphone.exe [-d 拨号网络连接名称]", 1)End Sub155、如何使用 ADO 來压缩或修复 Microsoft Access 文件以前使用 DAO 時，Microsoft 有提供 CompactDatabase Method 來压缩 Microsoft Access 文件，RepairDatabase Method 來修复损坏的 Microsoft Access 文件，。可是自从 ADO 出來之后，好像忘了提供相对的压缩及修复 Microsoft Access 文件的功能。現在 Microsoft 发现了这个问题了，也提供了解決方法，不过有版本上的限制！限制說明如下：ActiveX Data Objects (ADO), version 2.1Microsoft OLE DB Provider for Jet, version 4.0這是 Microsoft 提出的 ADO 的延伸功能：Microsoft Jet OLE DB Provider and Replication Objects (JRO)这个功能在 JET OLE DB Provider version 4.0 (Msjetoledb40.dll) 及 JRO version 2.1 (Msjro.dll) 中第一次被提出！這些必要的 DLL 文件在您安裝了 MDAC 2.1 之后就有了，您可以在以下的网页中下载 MDAC 的最新版本！Universal Data Access Web Site在下载之前先到 VB6 中檢查一下，【控件】【設定引用項目】中的 Microsoft Jet and Replication Objects X.X library 如果已经是 2.1 以上的版本，您就可以不用下载了！在您安裝了 MDAC 2.1 或以上的版本之后，您就可以使用 ADO 來压缩或修复 Microsoft Access 文件，下面的步骤告訴您如何使用 CompactDatabase Method 來压缩 Microsoft Access 文件：1、新建一個新表单，选择功能表中的【控件】【設定引用項目】。2、加入 Microsoft Jet and Replication Objects X.X library，其中 ( X.X 大于或等于 2.1 )。3、在适当的地方加入以下的程序代码，記得要修改 data source 的內容及目地文件的路径：Dim jro As jro.JetEngineSet jro = New jro.JetEnginejro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\\nwind2.mdb", _ ‘來源文件"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\\abbc2.mdb;Jet OLEDB:Engine Type=4" ‘目的文件在 DAO 3.60 之后，RepairDatabase Method 已经无法使用了，以上的程序代码显示了 ADO CompactDatabase Method 的用法，而它也取代了 DAO 3.5 時的 RepairDatabase method！156、如何建立可卷动的图形框？在各网站的讨论区中常有人问到这个问题，其实答案就在 Msdn 中！以下资料由 Msdn 节录：除了图片方块控制项之外，也可用水平、垂直卷轴来建立可卷动的图形框应用程序。当所包含的图形超过控制项范围时，单独一个图片方块控制项无法制作卷动功能─ 因为图片方块控制项无法自动新增卷轴。应用程序使用两个图片方块。称第一个为平稳的父图片方块控制项。第二个为子图片方块控制项，它包含在父图片方块中。子图片方块中包含图形影像，可用卷轴控制项在父图片方块中搬动子图片方块。先建立一个新工程，然后在表单上绘制两个图片方块、一个水平卷轴和一个垂直卷轴。位置随便放，这里，用表单的 Form_Load 事件设定比例模型，在父图片方块中调整子图片方块的大小，水平、垂直卷轴，搜寻并调整它们的大小，然后载入点阵图图形。将下列程序码新增到表单的 Form_Load 事件程序中：修正：避开 Form_Resize 产生的错误，将程序模组化，并加上范例程序。Private Sub init_object()‘初始化两个图片方块的位置。Picture1.Move 0, 0, ScaleWidth - VScroll1.Width, ScaleHeight - HScroll1.HeightPicture2.Move 0, 0‘将水平卷轴搜寻。HScroll1.Top = Picture1.HeightHScroll1.Left = 0HScroll1.Width = Picture1.Width‘将垂直卷轴搜寻。VScroll1.Top = 0VScroll1.Left = Picture1.WidthVScroll1.Height = Picture1.Height‘设定卷轴的 Max 属性。HScroll1.Max = Picture2.Width - Picture1.WidthVScroll1.Max = Picture2.Height - Picture1.Height‘判断子图片方块是否将充满屏幕。若如此，则无需使用卷轴。VScroll1.Visible = (Picture1.Height < Picture2.Height)HScroll1.Visible = (Picture1.Width < Picture2.Width)End SubPrivate Sub Form_Load()‘设定 ScaleMode 为像素。Form1.ScaleMode = vbPixelsPicture1.ScaleMode = vbPixels‘将 Autosize 设定为 True，以使 Picture2 的边界延伸到实际的点阵图大小。Picture2.AutoSize = True‘将每个图片方块的 BorderStyle 属性设定为 None。Picture1.BorderStyle = 0Picture2.BorderStyle = 0‘载入点阵图。 此处请自行更改图片‘Picture2.Picture = LoadPicture("c:\Windows\ham.bmp")‘初始化各物件init_objectEnd Sub水平和垂直卷轴的 Change 事件，用在父图片方块中上、下、左、右移动子图片方块。请将下列程序码新增到两个卷轴控制项的 Change 事件中：Private Sub HScroll1_Change()Picture2.Left = -HScroll1.ValueEnd SubPrivate Sub VScroll1_Change()Picture2.Top = -VScroll1.ValueEnd Sub将子图片方块的 Left 和 Top 属性分别设定成水平和垂直卷轴数字的负值，这样，当上、下、左、右卷动时，图形可以正确移动。执行阶段中，显示的图形如上图所示。在执行阶段调整表单大小在上例中，表单的初始大小限制图形的可视大小。在执行阶段中，当使用者调整表单大小时，为了调整图形视域应用程序的大小，可将下列程序码新增到表单的 Form_Resize 事件程序中：Private Sub Form_Resize()‘重新初始化各物件‘避开表单最小化的情况If Me.WindowState <> 1 Then init_objectEnd Sub157、如何侦测目前文字框中共有几行？要判断文字框中目前有几行，可以使用回圈判断共有几个换行字元来取得，但是在这儿我们要使用 API 来做到这个功能！‘请在 Form 中放一个 TextBox 及一个 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 LongConst EM_GETLINECOUNT = &HBA‘在 Text1 的 Change 事件中加入以下程序码：Sub Text1_Change()Dim lineCount As LongOn Local Error Resume Next‘立刻侦测目前文字框中共有几行lineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)Label1 = "文字框中共有 " & Format$(lineCount, "##,###") & " 行"End Sub158、如何判断使用者电脑中系统字型大小？在【问题】如何算出屏幕的分辨率？我们提到：如果希望使用者在跑我们开发的应用程序时，看到的画面的样子和我们在 Design Time 时一样的话，我们往往需要处理屏幕分辨率的问题。除了屏幕的分辨率之外，电脑中设定的字型大小是大字型 ( Large Font ) 或小字型 ( Small Font ) 或其他大小的自订字型，也是一个影响的因素，要如何侦测电脑中的字型大小呢？由【控制面板】的【显示器】【设定】页签中，我们可以得知以下讯息：大字型 ( Large Font )：120 dpi小字型 ( Small Font )：96 dpi以下之程序可以判断系统是否使用小字型，当然大字型之判断方式也相同：请在模组中加入以下声明及模组：Public Declare Function GetDesktopWindow Lib "user32" () As LongPublic Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPublic Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As LongPublic Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPublic Const LOGPIXELSX = 88Public Function IsScreenFontSmall() As BooleanDim hWndDesk As LongDim hDCDesk As LongDim logPix As LongDim r As LonghWndDesk = GetDesktopWindow()hDCDesk = GetDC(hWndDesk)logPix = GetDeviceCaps(hDCDesk, LOGPIXELSX)r = ReleaseDC(hWndDesk, hDCDesk)IsScreenFontSmall = (logPix = 96)End Function在程序中呼叫 IsScreenFontSmall 若返回值为 True 即为小字型。159、使用 Label 模拟资源管理器左右窗口中的调整杆 ( Splitter )要模拟这个功能，有很多种不同的作法，今天我们要使用一个 Label 控制项来分割分别放在左右的 TreeView 及 ListView，整个动作的重点在于，当我们在分隔线上按下鼠标左键时，就准备调整视窗中各控制项的大小，当我们放开鼠标左键时，就停止调整的动作！‘在 Form 中放入一个 Label，一个 TreeView 及 一个 ListView，位置不拘，并加入以下程序码：Private mbResizing As Boolean ‘判断是否按下鼠标左键 (准备调整大小)Private Sub Form_Load()‘设定 TreeView1 为屏幕 1/3,ListView1 为屏幕 2/3TreeView1.Move 0, 0, Me.ScaleWidth / 3, Me.ScaleHeightListView1.Move (Me.ScaleWidth / 3) + 50, 0, (Me.ScaleWidth * 2 / 3) - 50, Me.ScaleHeightLabel1.Move Me.ScaleWidth / 3, 0, 100, Me.ScaleHeightLabel1.MousePointer = vbSizeWEEnd SubPrivate Sub Form_Resize()‘设定 TreeView1 为屏幕 1/3,ListView1 为屏幕 2/3TreeView1.Move 0, 0, Me.ScaleWidth / 3, Me.ScaleHeightListView1.Move (Me.ScaleWidth / 3) + 50, 0, (Me.ScaleWidth * 2 / 3) - 50, Me.ScaleHeightLabel1.Move Me.ScaleWidth / 3, 0, 100, Me.ScaleHeightLabel1.MousePointer = vbSizeWEEnd SubPrivate Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)‘准备调整大小If Button = vbLeftButton Then mbResizing = TrueEnd SubPrivate Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)‘按下鼠标左键并移动时, 自动调整各控制项大小If mbResizing ThenDim nX As SinglenX = Label1.Left + XIf nX < 500 Then Exit SubIf nX > Me.ScaleWidth - 500 Then Exit SubTreeView1.Width = nXListView1.Left = nX + 50ListView1.Width = Me.ScaleWidth - nX - 50Label1.Left = nXEnd IfEnd SubPrivate Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)‘停止调整大小mbResizing = FalseEnd Sub160、【万用文件搜寻器】--- 将 Windows 的【寻找文件】功能套进 VB 中这个 Walkdir 模组可以让您从任何一个目录往下所有目录中找寻符合您要求的所有文件！根据实际测试的结果，搜寻文件的速度和 Windows 的【寻找文件】功能不相上下，有时甚至更快呢！共有三个参数说明如下：1、文件类型：可接受万用字符 *，可同时设定多个类型(中间用分号隔开)，例如 ( OLE*.DLL; *.TLB )2、开始目录：可以是根目录。3、字串阵列：用来存放符合的文件名称 (全路径文件名)，是一个动态阵列。这个模组会使用递回的方式一层一层的搜寻所有的子目录，找出所有符合条件的文件，并将文件名称 (含全路径) 放入字串阵列中，这个阵列的大小会自动根据找到的文件个数而自动调整，最后阵列的大小就是找到的文件个数！要实际使用这个模组，您必须先在 Form 中放入一个 DirListBox 及一个 FileListBox，分别取名为 Dir1 及 File1，最好将这二个控制项的 Visible 属性设成 False，可以大大加快搜寻的速度。‘以下是使用的范例： ( 　要一个 CommandButton 及一个 ListBox )Private Sub Command1_Click()ReDim sarray(0) As String‘找寻 Windows 目录下文件类型为 OLE*.DLL 的所有文件Call DirWalk("OLE*.DLL", "C:\windows", sarray)‘将阵列的资料放到 List1 中Dim i As IntegerFor i = LBound(sarray) To UBound(sarray) - 1List1.AddItem sarray(i)NextEnd Sub‘模组内容如下：Sub DirWalk(ByVal sPattern As String, ByVal CurrDir As String, sFound() As String)Dim i As IntegerDim sCurrPath As StringDim sFile As StringDim ii As IntegerDim iFiles As IntegerDim iLen As IntegerIf Right$(CurrDir, 1) <> "\" ThenDir1.Path = CurrDir & "\"ElseDir1.Path = CurrDirEnd IfFor i = 0 To Dir1.ListCountIf Dir1.List(i) <> "" ThenDoEventsCall DirWalk(sPattern, Dir1.List(i), sFound())ElseIf Right$(Dir1.Path, 1) = "\" ThensCurrPath = Left(Dir1.Path, Len(Dir1.Path) - 1)ElsesCurrPath = Dir1.PathEnd IfFile1.Path = sCurrPathFile1.Pattern = sPatternIf File1.ListCount > 0 Then‘在目录中找到符合的文件For ii = 0 To File1.ListCount - 1ReDim Preserve sFound(UBound(sFound) + 1)sFound(UBound(sFound) - 1) = sCurrPath & "\" & File1.List(ii)Next iiEnd IfiLen = Len(Dir1.Path)Do While Mid(Dir1.Path, iLen, 1) <> "\"iLen = iLen - 1LoopDir1.Path = Mid(Dir1.Path, 1, iLen)End IfNext iEnd Sub161、如何移除 MDIForm 的 Max/Min Button？不像其他的 Form 一样，MDIForm 并没有提供 MaxButton 及 MinButton 的属性来让我们移除最大化及最小化的按钮，如果您想移除 MDIForm 的最大化及最小化的按钮，您可以在 MDIForm 中加入以下的程序，但是如果您只想移除其中的一个，则只要将对应的程序码加上注解符号即可。‘请在 MDIForm 的声明区中加入以下声明#If Win32 ThenPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long#ElsePrivate Declare Function SetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Long) As LongPrivate Declare Function GetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Long#End IfConst WS_MINIMIZEBOX = &H20000 ‘最小化Const WS_MAXIMIZEBOX = &H10000 ‘最大化Const GWL_STYLE = (-16)‘在 MDIForm 的 MDIForm_Load 事件中加入以下程序码Sub MDIForm_Load()Dim lWnd As LonglWnd = GetWindowLong(Me.hwnd, GWL_STYLE)lWnd = lWnd And Not (WS_MINIMIZEBOX) ‘最小化lWnd = lWnd And Not (WS_MAXIMIZEBOX) ‘最大化lWnd = SetWindowLong(Me.hwnd, GWL_STYLE, lWnd)End Sub162、如何防止 Form 被移动？有些应用程序，我们希望固定 Form 的位置，不希望使用者移动它，在 VB5 以上的版本，我们可以直接在属性表中设定 Form 的 Moveable 属性为 False 即可。但是 VB4 以下的版本却没有这个功能，这时就得借助 API 的功能了！而我们实际要做的，就是移除系统功能表 ( ControlBox ) 中的【移动】的功能，您可以检查一下您现在使用的浏览器左上方的系统功能表，【移动】的位置是第二个，所以 Index = 1 ( index 由 0 算起 )。‘请在表单的声明区中加入以下声明Private Declare Function GetSystemMenu Lib "User" (ByVal hWnd As Integer, ByVal bRevert As Integer) As IntegerPrivate Declare Function RemoveMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As IntegerConst MF_BYPOSITION = &H400‘在 Form_Load 事件中加入以下程序码Private Sub Form_Load()SystemMenu% = GetSystemMenu(hWnd, 0)Res% = RemoveMenu(SystemMenu%, 1, MF_BYPOSITION) <--- 第二个参数是 IndexEnd Sub163、如何设定 ComboBox 之最大长度？在文字框 (TextBox) 中，我们可以设定 MaxLength 属性来设定文字框可输入的最大长度，但是同样具有一个文字框的 ComboBox，却没有提供这样的功能！要做到这个功能，必须自己写程序来判断。‘下面就是一个范例程序：‘我们在 Key_Press 事件来处理，程序中假设最大长度为 10，并已将倒退键排除在外Private Sub Combo1_KeyPress(KeyAscii As Integer)Const MAXLENGTH = 10 ‘设定最大长度为 10If Len(Combo1.Text) >= MAXLENGTH And KeyAscii <> vbKeyBack ThenKeyAscii = 0End IfEnd Sub164、如何撰写没 Form 的程序？一般在撰写 VB 的程序时，由于一进入 VB 的环境时就会自动产生一个 Form1，而 VB 本身又是一种事件驱动程序，所以有些人一直认为 VB 的程序一定会有一个以上的 Form 存在。其实 VB 也可以撰写一些完全没有表单 (Form) 的程序。撰写的方法如下：1、启动一个新的工程 (Project)2、移除 Form13、开启一个 Module (名称可自取，或使用 Default 名称 Module1)4、在 Module 中加入一段名为 Main 的 SubRoutine (名称一定要取为 Main)‘例：下面的程序执行时会开启 c:\test.txt 并写入一个数字，然后直接结束，没有任何表单。Public Sub Main()Open "c:\test.txt" For Output As #3Print #3, 6666Close #3End ‘可有可无,会自动结束End Sub165、别让 MsgBox 中断了一些 Background 的处理作业在 VB 中，一旦您呼叫了 MsgBox，您正在执行的一些 Background 的处理作业，例如计数器或时钟...等，都会停下来，直到您回应了 MsgBox 之后，一切才会恢复正常！或许您并不希望如此，这也有可能造成一些不必要的错误！要解决这个问题，您必须使用 Windows API 去呼叫 MessageBox Function，它的使用方法、外观和 MsgBox 的结果完全相同，但是它却不会中断一些 Background 的处理作业！在以下的范例中，您要在 Form 中加入一个 Label、二个 CommandButton 及一个 Timer，不更改任何属性。‘在声明区中加入以下声明：Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long‘加入以下程序码：Private Sub Command1_Click()MsgBox "计时器停掉了！", 64, "VB 的讯息框"End SubPrivate Sub Command2_Click()MessageBox Me.hwnd, "注意！计时器还在跑！", "API 的讯息框", 64End SubPrivate Sub Form_Load()Timer1.Interval = 1000Label1.Caption = "目前的时间是：" & TimeEnd SubPrivate Sub Timer1_Timer()Label1.Caption = "目前的时间是：" & TimeEnd Sub166、如何找出 Windows / System / Temp 目录的正确路径？(二)记得我们分三个单元来说明如何找出 Windows / System / Temp 目录的正确路径？当时我们都是使用 API 来做，使用的 API 分别是：问题 如何找出 Windows 目录的正确路径？使用 GetWindowsDirectory Function问题 如何找出 System 目录的正确路径？使用 GetSystemDirectory Function问题 如何找出 Temp 目录的正确路径？使用 GetTempPath Function有的人不太喜欢使用 API，一来有的 API 有点难，一来比较不容易找到完整的资料说明或完整的范例。不过以上三个题目都可以不使用 API 就得到答案的！原因如下：在我们启动电脑的同时，我们的操作系统，会挪出一个区块，用来存放一些系统环境变量，或许您会问，到底存了哪些东西呢？其实说来不外乎几个来源：1、Autoexec.bat：TMP / TEMP / PATH / PROMPT .....2、Config.sys：COMSPEC .....3、Msdos.sys：WinDir / WinBootDir .....4、当然您的电脑中不一定有 Autoexec.bat 或 Config.sys，不过没关系，系统自己会给定一些初始值！而这些环境变量，在 VB 中只要使用 ENVIRON Statement 就可以抓得到！语法如下：Environ[$](environmentstring)其中 environmentstring 是一个环境变量的字串，例如：〈TEMP〉、〈WinDir〉、〈PATH〉...等。所以，如果您 .....要得到 TEMP 的路径，只要使用 Environ("TEMP") 即可，结果可能为 C:\WINDOWS\TEMP。要得到 Windows 的路径，只要使用 Environ("Windows") 即可，结果可能为 C:\WINDOWS。而如果您想找到 System 的路径，我想有了 Windows 路径之后，应该不是难事了吧！167、如何将长文件名转成短文件名格式 (MS-DOS 8.3)虽然在 Windows95/98 中已经都可以使用长文件名/目录 (最长可以到255个字元)，但是在您将长文件名的文件或目录存档时，系统同时给了它一个可以相容于以前 MS-DOS 时代的 8.3 格式的文件名称！到目前为止，还是有些软件会使用 8.3 格式的文件名称，在安装这些软件时，它们写到注册表中的资料，仍然采用 8.3 格式的文件名称，所以有时候，您在维护系统时，必须知道目前这时长文件的档案，转成 8.3 格式的文件名称之后是什么文件。以下这个范例会让您在 DirListBox 及 FileListBox 中选择目录及文件名称，然后将您选出的(长)文件名转成 8.3 格式的文件名称，如果您有注意到的话，它不但是将文件名称转掉，连长文件的目录名称也会一起转成 8.3 格式的文件名称。由于程序码较长，我不再列出程序码，而直接将文件压缩下载：Source Code 下载168、清除画面中各栏位资料当一个 Form 中只有二、三个物件的时候，您要清除其中的资料，您会一个栏位一个栏位来清除，反正就是那么几个物件，二三行指令也就解决了！但是，若您的 Form 中有二、三十个，甚至五、六十个以上的物件时，可就要想想办法了！以下的这个模组就在这种情形下产生了，一般要清除资料，最重要的二个属性就是 .Text 及 .LisIndex。Public Sub ClearAllControls(frmFORM As Form)Dim ctlControl As ObjectOn Error Resume NextFor Each ctlControl In frmFORM.ControlsctlControl.Text = ""ctlControl.ListIndex = -1DoEventsNextEnd Sub而在程序中要呼叫这个模组只要如下使用即可：call ClearAllControls(Me)169、为您精心设计的画面拍张快照吧！( Taking a screenshot )我们在设计系统时，有时候会保留让使用者做屏幕 HardCopy 的功能。以前，我总是要求使用者自己去按键盘上的【Print Screen】按钮，将画面的影像留在【剪贴板】中，并要求使用者自己到 Windows95/98 提供的【小画家】或【小作家】中，先做【贴上】的动作后，再将画面影像存成 .BMP 档或直接由印表机中印出。上面这些动作，对一个程序开发者，或一个熟练的操作者并不困难，但是，很可悲的，大部份的使用者都不属于以上所描述的二种人，例如：我曾经写过一个系统是给大楼清洁维护公司的人员用的，其中有很多使用者甚至是一些学历不高的『欧巴尚』，不但程序的设计都要简化操作，连系统上线都是高难度的，更别说屏幕的 HardCopy 列印、存档的动作了！不过，以上的动作，我们都可以直接在 VB 的程序中做到，要做到这个功能有二个方法：方法一：直接模拟按【Print Screen】按钮，再将【剪贴板】中的图像抓到 Picture 中。方法二：完全使用 API 来处理。下面来看看第二种做法：‘请在声明区中加入以下声明：Private Declare Function GetDesktopWindow Lib "user32" () As LongPrivate Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As LongPrivate Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As LongPrivate Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As LongPrivate Const SRCCOPY = &HCC0020‘在 Form 中加入二个 CommandButton，及一个 PictureBox，不必更改属性，加入以下程序码：Private Sub Form_Load()‘将 Picture1 之长宽设定成和屏幕一样大小Picture1.Width = Screen.WidthPicture1.Height = Screen.HeightEnd SubPrivate Sub Command1_Click()‘将屏幕画面抓下后放到 Picture1 中Dim lngDesktopHwnd As LongDim lngDesktopDC As LongPicture1.AutoRedraw = TruePicture1.ScaleMode = vbPixelslngDesktopHwnd = GetDesktopWindowlngDesktopDC = GetDC(lngDesktopHwnd)Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)Picture1.Picture = Picture1.ImageCall ReleaseDC(lngDesktopHwnd, lngDesktopDC)End SubPrivate Sub Command2_Click()‘将 Picture1 中的屏幕画面存成 .BMP 档SavePicture Picture1, "C:\TEST.BMP"End Sub在以上的范例中，只要按下 Command1 就会将屏幕的画面截取下来放到 Picture1 中，按下 Command2 之后，就会将 Picture1 中的图片存成文件 ( 文件名称可自行更改 )，如果您想打印，也可以直接使用 PaintPicture 将图片丢到打印机中打出！至于图片的打印，以后会另有单元介绍。170、随心所欲地移除表单左上方的系统功能表的某几个项目针对这个主题，其实以前已经讨论过二次了，只不过不是以这样直接了当的方式点出在题目中而已，不知道大家是否有印象？这二次分别是：问题：如何移除 Form 右上方之『X』按钮？对应到系统功能表的【关闭】选项问题：如何防止 Form 被移动？对应到系统功能表的【移动】选项而我在网路上闲逛时，看到有个外国人用了一个很笨的方法写了一个模组，不过对于不想研究 API 的人来说应该是很好用的模组，可以让您用选择的方式随便您想移除系统功能表的任一个项目！完整程序码如下，说明加在其中：‘在声明区中加入以下声明：‘抓取系统 Menu 的 hwndPrivate Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer‘移除系统 Menu 的 APIPrivate Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer‘第一个参数是系统 Menu 的 hwnd‘第二个参数是要移除选项的 IndexPrivate Const MF_BYPOSITION = &H400&‘模组内容如下：Private Sub RemoveMenus(frm As Form, remove_restore As Boolean, remove_move As Boolean, remove_size As Boolean, remove_minimize As Boolean, remove_maximize As Boolean, remove_seperator As Boolean, remove_close As Boolean)Dim hMenu As Long‘ 抓取系统 Menu 的 hwndhMenu = GetSystemMenu(hWnd, False)If remove_close Then RemoveMenu hMenu, 6, MF_BYPOSITION ‘是否移除【关闭】选项If remove_seperator Then RemoveMenu hMenu, 5, MF_BYPOSITION ‘是否移除【分隔线】If remove_maximize Then RemoveMenu hMenu, 4, MF_BYPOSITION ‘是否移除【放到最大】选项If remove_minimize Then RemoveMenu hMenu, 3, MF_BYPOSITION ‘是否移除【缩到最小】选项If remove_size Then RemoveMenu hMenu, 2, MF_BYPOSITION ‘是否移除【大小】选项If remove_move Then RemoveMenu hMenu, 1, MF_BYPOSITION ‘是否移除【移动】选项If remove_restore Then RemoveMenu hMenu, 0, MF_BYPOSITION ‘是否移除【还原】选项End Sub这个模组共有八个参数，第二个到第八个参数分别对应到系统功能表的七个选项！ ( True / False )今天如果我想做到和问题如何移除 Form 右上方之『X』按钮？一样的结果，表示我要将对应到系统功能表的【关闭】选项移除，则我只要将相对应的参数设成 True 即可，其他要保留的则为 False。范例如下：Private Sub Form_Load()　　RemoveMenus Me, False, False, False, False, False, True, TrueEnd SubVB问题全功略（35） [查找本页请按Ctrl+F]［上一页］（35）［下一页］171、如何防止使用者按下 CTRL + ALT + DEL172、如何将 Excel 的资料表导入 Access资料库？173、取得个人电脑中的设定资讯174、您想知道有谁正在使用您的 Access 资料库吗？175、为何声明资料库型态变量时出现《编译错误：使用者自订型态尚未定义》171、如何防止使用者按下 CTRL + ALT + DEL有些时候，我们的应用程序执行时，不希望使用者按下 CTRL + ALT + DEL 来异常结束程序或关机，这时候我们可以在启动程序时，将 CTRL + ALT + DEL 功能键之功能取消，然后在结束程序之前，再从新恢复 CTRL + ALT + DEL 之功能。在模组声明区中加入以下声明及模组：Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As LongPublic Const SPI_SCREENSAVERRUNNING = 97Public Sub Disable_Ctrl_Alt_Del()‘让 CTRL+ALT+DEL 失效Dim AyW As IntegerDim TurFls As BooleanAwY = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, TurFls, 0)End SubPublic Sub Enable_Ctrl_Alt_Del()‘让 CTRL+ALT+DEL 恢复功能Dim AwY As IntegerDim TurFls As BooleanAwY = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, TurFls, 0)End Sub‘实际使用时，在 Form 中加入以下程序码：Private Sub Form_Load()Disable_Ctrl_Alt_DelEnd SubPrivate Sub Form_Unload(Cancel As Integer)Enable_Ctrl_Alt_DelEnd Sub172、如何将 Excel 的资料表导入 Access资料库？将程序码做成模组，只要传入必要之参数即可！此一模组共有四个参数：1、sSheetName：要导出资料的资料表名称 (Sheet name)，例如 Sheet12、sExcelPath：要导出资料的 Excel 文件路径名称 (Workbook path)，例如 C:\book1.xls3、sAccessTable：要导入的 Access Table 名称，例如 TestTable4、sAccessDBPath：要导入的 Access 文件路径名称，例如 C:\Test.mdb在声明区中加入以下声明：Private Sub ExportExcelSheetToAccess(sSheetName As String, sExcelPath As String, sAccessTable As String, sAccessDBPath As String)Dim db As DatabaseDim rs As RecordsetSet db = OpenDatabase(sExcelPath, True, False, "Excel 5.0")Call db.Execute("Select * into [;database=" & sAccessDBPath & "]." & sAccessTable & " FROM [" & sSheetName & "$]")MsgBox "Table exported successfully.", vbInformation, "Yams"End Sub使用范例如下：将 C:\book1.xls 中的 Sheet1 导入 C:\Test.mdb 成为 TestTableExportExcelSheetToAccess "Sheet1", "C:\book1.xls", "TestTable", "C:\Test.mdb"173、取得个人电脑中的设定资讯许多在控制面板中的设定，如果在 VB 的程序中需要知道的话，我们都可以透过 GetLocaleInfo 这个 API 来取得！以下我们已经将它模组化 (WinLocaleInfo)，只　传入一个参数即可得到解答！在声明区中加入以下的声明及模组：Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As LongPublic Function WinLocaleInfo(ByVal lnfoType As Long) As StringDim sLCData As StringDim nRet As LongnRet = GetLocaleInfo(0, lnfoType, sLCData, 0)If nRet ThensLCData = Space$(nRet)nRet = GetLocaleInfo(0, lnfoType, sLCData, Len(sLCData))If nRet ThenWinLocaleInfo = Left$(sLCData, nRet)End IfEnd IfEnd Function实际在运用时，可传入的参数相当多，连我也不知道到底有多少个，不过别担心，只要在 VB 附的 API 检视员中就可以找到所有可以传入的参数了！这些参数有一个共通点，都是以 "LOCALE_" 为开头字串，以下举几个例子给大家看看：LOCALE_SCURRENCY = &H14 ‘ 货币符号LOCALE_SDATE = &H1D ‘ 日期分隔字元LOCALE_SDAYNAME1 = &H2A ‘ 完整星期名称LOCALE_SDECIMAL = &HE ‘ 小数点符号‘以下是一个实例：Private Sub Command1_Click()Text1 = WinLocaleInfo(&H14) ‘可能返回 NT$Text2 = WinLocaleInfo(&H1D) ‘可能返回 /Text3 = WinLocaleInfo(&H2A) ‘可能返回 星期一Text4 = WinLocaleInfo(&HE) ‘可能返回 .End Sub174、您想知道有谁正在使用您的 Access 资料库吗？如果您使用 Access 建立了一个多人使用的资料库环境，有时候您必须要知道有谁正在使用程序连进这个共享的资料库，但是您又不想因为如此而要建立一套完整的 Access 安全系统，您有二个选择：第一个：您可以在资料库中建立一个 "Login Table"，每次使用者进入或离开系统时就 Update 这个 Table.第二个：较好一点，您可以使用 msldbusr.dll，它可以告诉您目前正连进资料库的电脑名称 (Computer Name)，这些资料其实是存放在扩展名为 LDB 的文件中。一旦您从 DLL 中抓到这些资料，您便可以送出讯息，通知 Client 端的使用者 (Remote User) 结束应用程序，以中断和资料库的连结，然后您便可以使用 Exclusive Mode 来维护资料库了。在这里，我们要说明的是第二种方法，也就是使用 msldbusr.dll。它提供了二个 Function，说明如下：1、LDBUser_GetUsers：呼叫后会返回二部份，一个是使用者阵列，一个是连结到资料库的使用者数。Declare Function LDBUser_GetUsers Lib "MSLDBUSR.DLL" (lpszUserBuffer() _As String, ByVal lpszFilename As String, ByVal nOptions As Long) As IntegerlpszUserBuffer()：返回使用者阵列，注意！必须使用 ReDim 声明成变动阵列！lpszFilename：资料库名称 ( .mdb 完整路径 )，若 .ldb 文件不存在，会返回错误代码。nOptions：下参数声明资料回传的型态。可以使用的参数有四个，如下：1=返回自从 .ldb 产生后，所有曾经使用资料库的使用者机器名称 (Computer Name) 及数目。2=只返回目前正在使用资料库的使用者机器名称 (Computer Name) 及数目。4=只返回导致目前资料库损毁的使用者机器名称 (Computer Name)。8=只返回使用者的总数，但是并不返回使用者阵列。2、LDBUser_GetError：呼叫 LDBUser_GetUsers 若有错误产生，可根据返回的错误代码找到说明。Declare Function LDBUser_GetError Lib "MSLDBUSR.DLL" (ByVal nErrorNo As Long) As StringnErrorNo：呼叫 LDBUser_GetUsers 产生错误所返回的代码，介于 -1 至 -14 之间。说明如下：-1 = Can‘t open the LDB file. ( 无法开启 LDB 文件 )-2 = No user connected. ( 没有使用者在使用资料库 )-3 = Can‘t create an array. ( 无法建立阵列 )-4 = Can‘t redimension array. ( 无法重新建立阵列 )-5 = Invalid argument passed. ( 传入无效的参数 )-6 = Memory allocation error. ( 内存配置错误 )-7 = Bad index. ( 无效的索引 )-8 = Out of memory. ( 内存不足 )-9 = Invalid argument. ( 无效的参数 )-10= LDB is suspected as corrupted. ( LDB 文件可能损毁 )-11= Invalid argument. ( 无效的参数 )-12= Unable to read MDB file. ( 无法读取 MDB 文件 )-13= Can‘t open the MDB file. ( 无法开启 MDB 文件 )-14= Can‘t find the LDB file. ( 找不到 LDB 文件 )‘范例程序：( 移除所有的 Form，请将以下程序复制到 .bas 文件中即可执行 )Option ExplicitDeclare Function LDBUser_GetUsers Lib "MSLDBUSR.DLL" (lpszUserBuffer() _As String, ByVal lpszFilename As String, ByVal nOptions As Long) As IntegerDeclare Function LDBUser_GetError Lib "MSLDBUSR.DLL" (ByVal nErrorNo As Long) As StringSub MAIN()Dim psMDBFilename As StringpsMDBFilename = InputBox("请输入资料库名称：")If Len(psMDBFilename) ThenShowUsers psMDBFilenameEnd IfEnd SubSub ShowUsers(psFilename As String)ReDim lpszUserBuffer(1) As StringDim psError As StringDim cUsers As LongDim iLoop As Long‘呼叫 LDBUser_GetUsers 返回使用者阵列cUsers = LDBUser_GetUsers(lpszUserBuffer(), psFilename, 1)‘确认是否返回使用者阵列If (cUsers = 0) ThenDebug.Print "No Users."GoTo Exit_ShowUsersEnd If‘若有错误则显示错误讯息If (cUsers < 0) ThenpsError = LDBUser_GetError(cUsers)Debug.Print "Error #:"; cUsers; "--"; psErrorGoTo Exit_ShowUsersEnd If‘显示使用者阵列For iLoop = 1 To cUsersDebug.Print "User "; iLoop; ":"; lpszUserBuffer(iLoop)Next iLoopExit_ShowUsers:End Sub‘除了上面的范例之外，Microsoft 也提供了一个更完整的范例，它有一个容易理解的介面设计：如果您在这个主题中想要更多的资讯，或想取得 Microsoft 提供的更多的工具程序，您可以参考：http://support.microsoft.com/support/kb/articles/q176/6/70.asp175、为何声明资料库型态变量时出现《编译错误：使用者自订型态尚未定义》很多人在学习用 VB 撰写资料库程序时，都会从使用 VB 提供的 Data Control 加上各种资料库感知控制项 ( Data Aware Control ) 开始，因为这样子的组合，您甚至一行程序都不用写就可以完成一支简单的资料库程序了！然而，为了程序控制的灵活度或其他原因，您会开始想要自己声明资料库物件，自己控制各种资料的处理动作，于是您在程序中加入了类似以下的声明： ( 因为书上及 Help 都这么写 )Dim DB As DatabaseDim SS As Snapshot:写了一支很简单的程序之後，当您想看看成果，而按下【开始执行】的按钮时，却从电脑中发出了一声令人惊心动魄、代表错误的声响！ (如果您有装 Sound Card 的话) 您一遍一遍的检查程序，已经是最简单的程序了，怎么可能会错误呢！让我们来看看错误讯息：《编译错误：使用者自订型态尚未定义》其实您的程序并没有错，您声明的资料型态也都是对的，只是定义它的物件程序库或型态程序库并没有在 Visual Basic 中注册而已。解决方法如下：从【专案】功能表中选择【设定引用项目】，在【可引用的项目】栏中选择【Microsoft DAO x.x Object Library】【Microsoft DAO x.x/x.x Compatibility Library】即可。其中 x.x 代表的是某一个资料库引擎的版本，x.x/x.x 则代表相容于好几个版本的资料库引擎！如果您的公司中有人使用 Access2.0 / Access95 / Access97 ...等多个不同的版本时，您可以使用 【Microsoft DAO 2.5/3.5 Compatibility Library】。176、模拟 VB 程序执行时产生的错误讯息VB 程序执行时若有错误产生，而程序中又没有错误控制的话，便会出现 VB 内定的错误编号及错误讯息，但是这个错误讯息通常都很简短，所以使用者和写程序的人反应时，有时候也不知道是什么意思及该如何处理。而且这种错误有时候在开发人员的机器上不会发生，只有在使用者的机器上才会发生，所以开发人员也模拟不出来！虽然 VB 的错误编号及讯息都很简短，但是在 VB 的线上说明中都有比较详细的错误分析及解决方法，只是有些人找不到，所以常常有人在问 VB 产生的错误讯息是什么意思及该如何处理。VB 的 Err 物件其实就可以让我们模拟错误，以下的 Sample 是从 VB 的 HELP 中节录出来的：‘ If an error occurs, construct an error messageOn Error Resume Next ‘ Defer error handling.Err.ClearErr.Raise 6 ‘ Generate an "Overflow" error.‘ Check for error, then show message.If Err.Number <> 0 ThenMsg = "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & Err.DescriptionMsgBox Msg, , "Error", Err.HelpFile, Err.HelpContextEnd If以上的程序加了 On Error Resume Next，所以并不会中断跳出来，而出现的讯息框内容如下，有错误编号及错误讯息，而且错误讯息很简短，而且它只有一个【确定】按钮，对我们帮助不大：Error # 6 was generated by Project1OverFlow今天如果在 Design Time 时将 On Error Resume Next 拿掉，出现的讯息框如下：Run-time error ‘6‘OverFlow除了以上的讯息外，它有四个按钮，分别是【Continue】、【End】、【Debug】、【Help】，而最后一个按钮【Help】就可以让我们直接进到 Help 看到以下的详细说明：Overflow (Error 6)An overflow results when you try to make an assignment that exceeds the limitations of the target of the assignment. This error has the following causes and solutions:The result of an assignment, calculation, or data type conversion is too large to be represented within the range of values allowed for that type of variable.Assign the value to a variable of a type that can hold a larger range of values.An assignment to a property exceeds the maximum value the property can accept.Make sure your assignment fits the range for the property to which it is made.For additional information, select the item in question and press F1.所以，下一次您就可以使用这个方法来方便找到详细的错误说明！177、如何取得文件大小？VB6 提供了一个新的物件模型，叫做 FSO (File System Object) 物件模型，运用它，我们可以很方便的处理磁盘、资料夹和文件的一些动作。FSO 物件模型含有好几个物件，其中有一个 File 物件是用来求得文件的相关资讯，在目前这个主题，我们就可以使用 File 物件！它有一个属性是 Size，对文件来说就是指文件的大小 (单位为位元组)。 (注一)虽然使用 File 物件的 Size 属性就可以求得文件的大小，但是它有以下二个缺点：1、只能用于 VB6 以后的版本。2、它不是 VB6 内定的功能，必须另外引用 Scrrun.dll (Microsoft Scripting Runtime) 才可以！以下的二个方法就可以使用在所有的 VB 版本中 (含 VB6)，而且是 VB 内定的功能：1、FileLen 函数：返回一个 Long，代表一个文件的长度，单位是位元组。语法：FileLen(pathname) ‘ pathname 是全路径之文件名称适用：取得一个尚未开启的文件的长度大小 (注二)2、LOF 函数：返回一个 Long ，单位为位元组，用来代表由 Open 陈述式所开启的文件之大小。语法：LOF(filenumber) ‘ filenumber 是一个文件代码适用：取得一个已开启的文件的长度大小注一：File 物件的 Size 属性除了可以求得一个文件的大小，也可以用来取得整个目录的所有文件大小！注二：使用 FileLen 函数时，如果所指定的文件正在开启中，则所返回的值是这个文件在开启前的大小。178、如何一次读取整个文件的内容？通常我们要读取整个文件的内容时，都是一行一行读进来，再使用变数来累加。除了这种方法之外，您还可以使用 GET Function，只要呼叫一次就可以读入一整个文件了！而且速度更快！以下这个模组就是使用 GET 来读入整个文件，参数只有一个，就是含路径的文件名：Function FileContent(FileName As String) As StringDim FileNo As IntegerDim FileString As StringFileNo = FreeFileOpen FileName For Binary As #FileNoFileString = Space(FileLen(FileName))Get #FileNo, , FileStringClose #FileNoFileContent = FileStringEnd Function使用实例如下：Private Sub Command1_Click()RichTextBox1 = FileContent("C:\Test.txt") (注)End Sub注：当文件大小小于 64K 时可使用 TextBox当文件大小大于 64K 时请使用 RichTextBox若是 VB6 您还可以使用 FSO 物件模型中的 TextStream 物件的 ReadAll 方法来读一个完整的 TextStream 文件并返回得到的字串。对于太大的文件，使用以上的方法浪费记忆体资源。应使用其它的技术去输入一个文件，比如一列一列地读取文件。179、如何使用文本文件来存取 ListBox 内的资料？当我第一次在网路上的讨论区中看到有人提到以下的二个问题时：1、请问如何将 TextBox 或 ListBox 的资料存到文本文件中？2、请问如何将文本文件中的资料一行一行读出放到 ListBox 中？我真的有一点惊讶，因为我一直都是待在民营企业的 MIS 部门，所有的系统都要使用到资料库，像这样的问题，我们在系统设计时，都会在资料库中用一个片语文件来存放，不管系统大小，都可以将这一类的资料存在片语文件中，再依类别来区分，还可以依使用者　要来加以编号排序，除此之外，也方便统一管理。不过，不管是国内或国外的讨论区中，这样的问题却一直不断的有人在问，而且频率不低，这让我体会到，基于各种理由，并不是所有人都一定要使用资料库来存放这些资料！若要使用文本文件来存放这些资料，其实最需要了解的，就是文本文件的存取方法！在以下的范例中，我使用到二个 ListBox 及二个 CommandButton，不需更改任何属性！按下 Command1 时，会将 List1 中的资料放到暂存文件中，按下 Command2 时，再将暂存文件中的资料放到 List2 中。Private Sub Command1_Click()‘将 ListBox 资料放到文本文件中Dim i As IntegerOpen "c:\temp.txt" For Output As #1For i = 0 To List1.ListCount - 1Print #1, List1.List(i)NextClose #1End SubPrivate Sub Command2_Click()‘将文本文件中资料读出放到 ListBox 中Dim wstr As StringOpen "c:\temp.txt" For Input As #1Do While Not EOF(1) ‘执行回圈直到文件尾为止。Input #1, wstrList2.AddItem wstrLoopClose #1End Sub不过如果您的系统有使用到资料库，而您之前没有想到要使用资料库的片语文件来存放这些资料的话，我建议您试试看，您会发现片语文件真的很方便，不管什么杂七杂八的资料，只要一个文件就解决了！180、字串取代之【全部取代】在一般的应用软体中，例如 Word、小作家、Excel....等，都会提供字串取代【全部取代】的功能，这个功能很简单，就是将整篇文章从头到尾找一遍，碰到您要找的字串，就将它转换成您要取代的字串。当然，或许您会说 VB6 不是己经有提供这个功能了吗？没错！VB6 己经有提供这个功能了，但是据我所知，目前企业界实际在使用 VB6 的比例并不高！大部份还是使用 VB5 / VB4-32，这个模组就是专为 VB6 以前的版本写的。以下这个模组 myReplaceString ，它共有三个参数，说明如下：1、hString：您要搜寻的一篇文章。2、hSource：要搜寻到的子字串。3、hTarget：用来取代的子字串。整个模组的程序码很短，如下：Public Function myReplaceString(ByVal hString As String, ByVal hSource As String, ByVal hTarget As String) As String　　tLen = Len(hSource)　　tChk = (Len(hTarget) = Len(hSource))　　tLoc = 1　　Do　　　　tLoc = InStr(tLoc, hString, hSource)　　　　If tLoc <> 0 Then　　　　　　If tChk Then　　　　　　　　Mid(hString, tLoc, tLen) = hTarget　　　　　　Else　　　　　　　　hString = Left(hString, tLoc - 1) + hTarget + _　　　　　　　　Mid(hString, tLoc + tLen)　　　　　　End If　　　　　　tLoc = tLoc + Len(hTarget)　　　　Else　　　　　　Exit Do　　　　End If　　Loop　　myReplaceString = hStringEnd Function而返回值就是已经经过转换后的新文章！181、如何在 VB5 中打开 VB6 的工程？如果您用 VB5 打开 VB6 撰写的工程，会出现一个类似以下的讯息："Retained 为不正确的键。无法载入文件 C:\Windows\Desktop\Project1.vbp。""Retained is an invalid key. The file C:\Windows\Desktop\Project1.vbp can‘t be loaded".那是因为在 VB6 的工程的 .vbp 文件中，多了一个之前的 VB 版本不认得的键值 "Retained" 的缘故！要解决这个问题很简单，您只要依照以下的几个步骤：1、使用记事本 (Notepad.exe) 打开 VB6 的工程的 .vbp 文件。2、在这个文件中找到包含 "Retained" 字串的那一行，将那一整行移除。3、存文件。这样子您就可以使用 VB5 来打开之前使用 VB6 开发的工程了！很简单吧！注：我在别的网站上看到有人说，这样子做了之后不一定百分之百成功，不过我自己试了之后，倒是没有出现错误，各位也自己试试吧！182、VB6.0 的 Help 在那里？MSDN 是什么？很多人在安装了 VB6.0 ，开始撰写程序之后，遇到了问题，按下【F1】，却出现了错误讯息，告诉您：【MSDN 不存在......，请重新安装 MSDN】有的人还会觉得很奇怪，VB6.0 的 Help 出了什么问题了？MSDN 又是什么？为什么要重新安装 MSDN？其实，从 VB6.0 以后，Microsoft 已经将它所有的开发软件，合并成 Microsoft Visual Studio 6.0，一起出售 ( 当然，也有分开独立贩售的版本 )，在合并软件的同时，Microsoft 也将每一个开发软件的 Help 挪出来，统一放在 MSDN 光盘中，所以，现在不管您买的是合并软件的 Microsoft Visual Studio 6.0 或是独立贩售的 VB6.0 版本，都会另外附上二片 Microsoft MSDN Library 光盘。今天，如果您购买的是独立贩售的 VB6.0 版本，在您安装完 VB6.0 之前，安装程序会要求您放入 MSDN 光盘，它会继续帮您安装 MSDN (也就是新版的 Help)。至于安装的注意事项，请参考问题10:不方便的 Msdn -- VB6.0 的 Help如果您安装 VB6.0 时，没有同时安装 MSDN，也没关系，您只要找到 MSDN 光盘，将第一片放入光驱，直接执行 Setup.exe 即可！注：VB6 及 Microsoft Visual Studio 6.0 所附之 MSDN Library 光盘其实只是一个特殊版本，是专门针对 Microsoft Visual Studio 6.0 所推出的！MSDN Library 光盘在 VB6 及 Microsoft Visual Studio 6.0 出现之前就已经存在很久了，是微软针对程序开发人员的官方的技术资源，它定期提供产品操作手册、范例程序、技术文章、公用程序及许多最新的技术资料。而随 VB6 及 Microsoft Visual Studio 6.0 所附之 MSDN Library 光盘内容包含 VB6 及 Microsoft Visual Studio 6.0 的最新产品手册 (电子书) 及技术资料。183、如何判断资料库中某一个 Table 是否存在？(ADO)要判断资料库中某一个 Table 是否存在？最简单的方法就是错误尝试法！什么叫做错误尝试法呢？就是先假设它存在，直接去打开它，如果它真的存在，不会有错误产生，但是如果它不存在的话，就会有错误产生！做法大致如下：1、设定 On Error Resume Next2、直接打开要检查的 Table3、如果文件存在，则 err.Number=0我们就以 Access 为例，资料库使用 VB 内附的 Biblio.mdb，程序码如下：On Error Resume Next ‘1Set Conn = CreateObject("ADODB.Connection")Conn.open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=C:\Biblio.mdb"Set rs = Conn.execute("Titles") ‘2If Err.Number <> 0 Then MsgBox "Table 不存在" Else MsgBox "Table 存在" ‘3184、如何移除或更改桌面背景的底色图案 (Wallpaper)？SystemParametersInfo 这个 API 可以设定许多 Windows 系统的功能参数，而其中一个参数就是桌面底图！通常一般的使用者会透过控制面板中的【显示器】来设定桌面底图。在底下的范例中，我们使用 SPI_SETDESKWALLPAPER 这个参数及图片文件名称来设定新的桌面底图，同时使用 SPIF_SENDWININICHANGE 来通知各个视窗这个改变。‘在表单的声明区中加入以下声明及常数：Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As String, ByVal fuWinIni As Long) As LongConst SPI_SETDESKWALLPAPER = 20Const SPIF_UPDATEINIFILE = &H1Const SPIF_SENDWININICHANGE = &H2‘在表单上加入一个 CommandButton (Command1) 来移除桌面底图，程序码如下：Private Sub Command1_Click()Dim X As LongX = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, "(None)", SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)MsgBox "桌面底图 (Wallpaper) 已经被移除"End Sub‘在表单上加入另一个 CommandButton (Command2) 来更改桌面底图，程序码如下：Private Sub Command2_Click()Dim FileName As StringDim X As LongFileName = "c:\windows\test.bmp"X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, FileName, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)MsgBox "桌面底图 (Wallpaper) 已经被更改"End Sub185、如何在不开启文件的情况下打印各类文件？您还记得或怀念以前 DOS 时代，在 DOS 的命令列就可以直接下指令打印文件吗？其实这个题目的标题，就如同当今的报纸标题一般，有点夸张，因为要打印文件，势必要先开启文件！但是您也不用失望，既然标题会这样订，表示我也有好方法 (其实应该说 Microsoft 有提供好方法)！您只要使用 ShellExecuteAny 这个 API，对于各种不同格式不同类型的文件，您都不用自己先去启动开启该类文件的应用程序，再开启文件，再打印文件！看到上面的说明，是否让您回想起之前我们提到过的二个主题：如何用 VB 启动其他程序或开启各类文件？完全模拟【开始】中的【运行...】功能在这二个主题中，我们都有提到，不必管文件的扩展名是什么？格式是什么？您都可以使用如下面Shell("Start C:\Test.txt")Call Shell("rundll32.exe url.dll,FileProtocolHandler " & Text1, 1)的方式来启动程序或开启文件。今天，我们要提到的 API 也可以开启或执行各种不同类型的文件，但是那不是我们今天的重点 (如果各位有兴趣的话，请自行研究！)，今天的重点是 ShellExecuteAny 这个 API 它可以：1、自动依文件型态帮我们在 Background 启动应用程序。2、自动打印文件。3、自动再关闭文件。应用在我们的 VB 程序中的话，使用者只要输入或选择文件，不管什么文件 (当然是指在注册表中曾经注册过的文件类型)，都可以打印！‘以下是完成的模组：Private Declare Function ShellExecuteAny Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As Any, ByVal lpDirectory As Any, ByVal nShowCmd As Long) As LongConst SW_SHOWMINNOACTIVE = 7Sub PrintAnyFile(FileToPrint As String)Dim Ret As LongRet = ShellExecuteAny(Me.hwnd, "print", FileToPrint, ByVal 0&, ByVal 0&, SW_SHOWMINNOACTIVE)End Sub‘实际使用案例如下：Private Sub Command1_Click()PrintAnyFile Text1.TextEnd Sub其实上面这种打印文件的方式，它的作用方式，和我们直接将文件文件拖拉到打印机的图示上去打印文件是一样的道理！ (如果您之前尚不知道这个功能的话，您现在可以试试看将一份文件直接拖拉放到打印机的图示上，看看结果如何！)186、谁终结了我的程序？您开发的应用程序或许写得非常完整，您也很满意，但有时候却莫名其妙地出现了一点问题，在不该结束程序的时候，它被强迫结束了！可能使用者是按下了 Ctrl + Alt + Del，使用 Microsoft Windows 工作管理员关闭应用程序，或者强迫关机了！然而您的程序却没有考虑到这一点。在正常情况下要结束一个表单，会经过三个事件 (当您使用 End 结束程序时是例外！)，顺序如下：1、Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)2、Private Sub Form_Unload(Cancel As Integer)3、Private Sub Form_Unload(Cancel As Integer)在这三个事件中都允许您设定 Cancel=True 来避免表单被结束，但是它们是不分青红皂白的，唯一能让您分辨表单为什么被结束的，就是在 Form_QueryUnload 中的 UnloadMode 参数！unloadmode 参数返回下列的值：常数 值 描述vbFormControlMenu 0 使用者从表单上的控制功能表中选取「关闭」指令。vbFormCode 1 Unload 陈述式被程序代码呼叫。vbAppWindows 2 目前 Microsoft Windows 作业环境任务结束。vbAppTaskManager 3 Microsoft Windows 工作管理员正在关闭应用程序。vbFormMDIForm 4 因为 MDI 表单正在关闭的缘故，MDI 子表单正在关闭。vbFormOwner 5 表单因其拥有人关闭而关闭。所以下次您就可以在 Form_QueryUnload 中利用 UnloadMode 参数来判断程序是否　要做什么特别处理！187、完全模拟【开始】中的【关机】功能在【问题：如何从您的应程序中结束 Windows 重开机？】我们曾经提到过，如何由程序中强迫关机、重开机，但是在这个主题中，我们要告诉您的，是如何模拟按下了【开始】中的【关机】选项，屏幕变成灰灰一片，并且在屏幕中央出现【关闭 Windows】问话框！在声明区中加入以下声明：Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal lType As Long) As LongPublic Const EWX_LOGOFF = 0Public Const EWX_SHUTDOWN = 1Public Const EWX_REBOOT = 2Public Const EWX_FORCE = 4Public Const EWX_POWEROFF = 8要 Show 出【关闭 Windows】问话框时用法如下：SHShutDownDialog EWX_SHUTDOWN188、如何将桌面上所有的视窗最小化？有很多好用的桌面工具软件都有提供这个功能，将桌面上所有的视窗最小化，也会提供将它们复原的功能，当然，要提供这种功能的软件，执行后都是将程序缩到桌面右下角的工具列中，使用 Menu 来操控，否则，将桌面上所有的视窗最小化，也包括它自己的程序本身的视窗的！‘请在视窗声明区中加入以下声明及模组：Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate Const WM_COMMAND As Long = &H111Private Const MIN_ALL As Long = 419Private Const MIN_ALL_UNDO As Long = 416Public Sub MinimizeAll()Dim lngHwnd As LonglngHwnd = FindWindow("Shell_TrayWnd", vbNullString)Call PostMessage(lngHwnd, WM_COMMAND, MIN_ALL, 0&)End SubPublic Sub RestoreAll()Dim lngHwnd As LonglngHwnd = FindWindow("Shell_TrayWnd", vbNullString)Call PostMessage(lngHwnd, WM_COMMAND, MIN_ALL_UNDO, 0&)End Sub‘而实际使用之范例如下：Private Sub Command1_Click()MinimizeAll ‘将桌面上所有的视窗最小化End SubPrivate Sub Command2_Click()RestoreAll ‘将最小化的视窗还原End Sub189、如何动态新增、移除 ODBC DSN？一般我们建立 Client 端 DSN 都是在使用者的机器上进入【控制台】【ODBC 资料来源管理员】去建立，但是如果我们开发的 APP 使用者很多时，这就有点累人了，所以我们可以将这个动作放在程序中！新增 DSN 的方法有二种：1、使用 DBEngine 物件的 RegisterDatabase 方法2、呼叫 SQLConfigDataSource API不管使用以上任何一种方法新增 DSN，一共会写入二个地方，一个是注册表，一个是 ODBC.INI。而删除 DSN 的方法同上面的第二种方法，呼叫 SQLConfigDataSource API。以下之模组以 Oracle73 Ver 2.5 为例，在 Form 的声明区中加入以下声明及模组：Private Const ODBC_ADD_DSN = 1 ‘ Add data sourcePrivate Const ODBC_CONFIG_DSN = 2 ‘ Configure (edit) data sourcePrivate Const ODBC_REMOVE_DSN = 3 ‘ Remove data sourcePrivate Const vbAPINull As Long = 0& ‘ NULL PointerPrivate Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As LongPublic Sub CreateDSN(sDSN As String)Dim nRet As LongDim sDriver As StringDim sAttributes As StringsDriver = "Oracle73 Ver 2.5"sAttributes = "Server=Oracle8" & Chr$(0)sAttributes = sAttributes & "DESCRIPTION=" & sDSN & Chr$(0)‘sAttributes = sAttributes & "DSN=" & sDSN & Chr$(0)sAttributes = sAttributes & "DATABASE=DBFinance" & Chr$(0)sAttributes = sAttributes & "Userid=Scott" & Chr$(0)‘sAttributes = sAttributes & "PWD=myPassword" & Chr$(0)DBEngine.RegisterDatabase sDSN, sDriver, True, sAttributes ‘注一‘nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, sDriver, sAttributes) ‘注二End SubPublic Sub DeleteDSN(sDSN As String)Dim nRet As LongDim sDriver As StringDim sAttributes As StringsDriver = "Oracle73 Ver 2.5"sAttributes = sAttributes & "DSN=" & sDSN & Chr$(0)nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, sDriver, sAttributes)End Sub‘假设要产生的 DSN 为 Test，实际使用范例如下：Private Sub Command1_Click()CreateDSN "Test"End SubPrivate Sub Command2_Click()DeleteDSN "Test"End Sub‘而写到系统的资料如下：1、ODBC.INI[ODBC 32 bit Data Sources]Test=Oracle73 Ver 2.5 (32 bit)[Test]Driver32=C:\ORAWIN95\ODBC250\sqo32_73.dll2、注册表机码：HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources名称：Test 资料：Oracle73 Ver 2.5机码：HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Test名称：Description 资料：Test名称：Driver 资料：C:\ORAWIN95\ODBC250\sqo32_73.dll名称：Server 资料：Oracle8名称：UserId 资料：Scott※注一及注二可任选一种，只要将不使用的方法 Mark 起来即可！※若您想使用其他之资料库，只要将以上模组稍作修改即可！190、如何从全路径文件名中分别抓出路径及文件名？这是一个很简单很常碰到的问题，只要有用到文件的程序常常都会需要处理这样的问题！既然很简单为什么还要提出这样的问题呢？没错，是很简单，但是我的着眼点是：它太常出现了，值得做成模组！要解决这个问题，第一个要了解的就是全路径文件名称的构成要素：磁盘代号、目录名称、文件名称，而这三个组成要素之间，都是使用反斜线符号 (即 "\") 分开！所以，要从全路径文件名中分别抓出路径及文件名，第一件事就是要找到从右边倒数的第一个反斜线符号！不多说，直接来看看模组及实例：‘模组：抓出路径Function ExtractDirName(PathName As String) As StringDim X As IntegerFor X = Len(PathName) To 1 Step -1If Mid$(PathName, X, 1) = "\" Then Exit ForNextExtractDirName = Left$(PathName, X - 1)End Function‘模组：抓出文件名Function ExtractFileName(PathName As String) As StringDim X As IntegerFor X = Len(PathName) To 1 Step -1If Mid$(PathName, X, 1) = "\" Then Exit ForNextExtractFileName = Right$(PathName, Len(PathName) - X)End Function‘使用实例：Private Sub Command1_Click()Dim PathName As StringPathName = "C:\倪匡小说原稿\未整理小说\黄金故事.txt"Text1.Text = ExtractFileName(PathName) ‘ 黄金故事.txtText2.Text = ExtractDirName(PathName) ‘ C:\倪匡小说原稿\未整理小说End Sub196、如何一次关闭 MDIForm 内的所有子表单？以下这段程序可以让您一次关闭 MDIForm 内的所有子表单，首先在 MDIForm 中建立一个 Menu，假设取名为 mnuCloseAll，则程序码如下：Private Sub mnuCloseAll_Click()‘Screen.MousePointer = vbHourglassDo While Not (Me.ActiveForm Is Nothing)Unload Me.ActiveFormLoop‘Screen.MousePointer = vbDefaultEnd Sub197、按下 CommandButton 之前后，如何让鼠标停留在同一个物件中？在一般表单输入画面中，使用者输入了一笔资料后，会去按 ‘存档‘ 按钮，当然他也可能去按任一个按钮，但是不管他是按那一个按钮，如果您不在程序中将鼠标移到下一笔输入的第一个栏位，或其他特定的栏位，使用者便必须自己去移动鼠标，如果这个使用者是使用键盘输入，那更是麻烦！他必须使用 Tab 键一个物件一个物件移动光标。下面这个范例将示范如何做到在按下 CommandButton 之前后，让鼠标停留在同一个物件中！请在表单中放入二个 TextBox 及一个 CommandButton，不必更改任何属性，将以下之程序复制到表单中：Dim mCtl As ControlPrivate Sub Command1_Click()‘ 在这一个段落中可以执行您想做的动作, 例如存档动作‘ 然后将鼠标移回按下 Command1 之前鼠标停留的物件上On Error Resume NextmCtl.SetFocusEnd SubPrivate Sub Text1_GotFocus()Set mCtl = Text1End SubPrivate Sub Text2_GotFocus()Set mCtl = Text2End Sub198、您用过【符号字型】吗？有时候您是否觉得，同样的开发环境，为什么 Microsoft 写出来的程序，画面总是在某些地方看来特别一点点，例如 CommandButton 的样子就是和我们自己写的不一样，您总是感觉他们的 CommandButton 上放的是图形，其实，在 CommandButton 上的不是图形，只不过是某一种字型而已！而且这些字型在每一台 Windows95 / Windows98 / NT 上都有，如果没有，您只要安装了 IE4 或 IE5 就有了。举个例子好了，如果您要在 CommandButton 上放一个向右或向左的箭头，不使用图片的话，您会使用【>】【<】，但是您在 Microsoft 写出来的程序中看到的是【4】【3】，为什么呢？因为它用的是一种符号字型，就是 Marlett 字型的 3 【4】及 4【3】！这些字型在那里呢？在本页的下方列了七种符号字型，每一种字型分别列出了 0-9 / a-z / A-Z 共 62 个字元，如果在某些栏位中您看到的仍然是 0-9 / a-z / A-Z，表示您的电脑中没有这种字型，当然，符号字型不只这七种而已，如果您想知道您的电脑中暗藏多少种符号字型的话，方法如下：在任何可以设定字型的应用程序中，叫出【字型】设定对话框，我们就用 VB 的开发环境来举例好了：1、在表单上放一个 Label，Caption 随意输入 0-9 / a-z / A-Z 的字元，在属性表中设定字型 (Font)。2、在【字型】设定对话框的左上方，您随便选择一种【字型】。3、看看【字型】设定对话框的右下方，【字集】也会跟著改变！每一种字型会包含一种以上的字集。4、如果字集中出现的是 symbol，表示这种字型就是符号字型！5、按下确定按钮，看看 Label 上面的字有何改变，很令人惊讶吧！6、Marlett 字型的 012345 变成了 012345了！这些符号字型有的非常精美，下一次要使用图片之前，记得找一找符号字型，使用符号字型不但美观，而且可以避免使用图片，让程序瘦身！注：符号字型范例( 由于此页档案太大，怕影响速度，所以移除了部份英文字元，若有需要，请自行测试 )字型 Marlett Monotype Sorts r_symbol MT Extra Wingdings Wingdings 2 Wingdings 30 0 0 0 0 0 0 01 1 1 1 1 1 1 12 2 2 2 2 2 2 23 3 3 3 3 3 3 34 4 4 4 4 4 4 45 5 5 5 5 5 5 56 6 6 6 6 6 6 67 7 7 7 7 7 7 78 8 8 8 8 8 8 89 9 9 9 9 9 9 9a a a a a a a a: : : : : : : :A a A A A A A A: : : : : : : :Z Z Z Z Z Z Z Z199、避免使用没有效率的 IIF Function 及 Choose Function！IIF Function 的功能是根据逻辑判断，返回给定的二个值中的一个 (二选一)；Choose Function 的功能是从引数串列中选择并返回一个值 (多选一)。二个函数的语法如下：IIf(expr, truepart, falsepart)Choose(index, choice-1[, choice-2, ... [, choice-n]])这二个函数乍看之下，好像和 IF....Else IF....Else....End IF 是一样的，没错，结果好像是一样的，但是事实上 IF....Else....End IF 却比较有效率和安全多了，为什么呢？1、IIf 会计算 truepart 以及 falsepart，虽然它只返回其中的一个，所以您应该要留意这项副作用，例如，如果 falsepart 会产生除以零的错误，那么程序就会发生错误，即使 expr 为 True。2、Choose 会计算串列中的每个选择项，即使它只返回一个选项值。所以您应该注意这项副作用，例如，当您在每个选择项中使用了 MsgBox 函数，那么每计算一个选择项，就会显示一次讯息方块。而 IF....Else....End IF 却没有上述的缺点！所以，虽然 IIF 及 Choose Function 的程序码看起来相当简洁，但效率不见得比较好，最重要的，是可能还会导致错误产生。我的建议就是：能不用就不用！200、如何用TextBox打开和保存文件作为轻量级的控件，TextBox控件使用率很高，但相关的资料极少谈及如何用TextBox控件打开和保存文件，大都采用回避的态度，对VB初学者带来很多不便。笔者近日为友人做一个英文朗读软件，按友人的要求，软件要能象MS的记事本那样能打开和保存文档。其实实现方法并不复杂，现将心得写出来，希望对大家有帮助。如果您有更好的方法，请来信：handanfang@163.net。‘新建标准EXE，加入一个TextBox控件，一个公共对话框，两个菜单。‘打开Private Sub mnuOpen_Click()CommonDialog1.Filter = "文档文件(*.txt)|*.txt|所有文件(*.*)|*.*"CommonDialog1.ShowOpenOpen CommonDialog1.FileName For Input As #1Text1.Text = StrConv(InputB$(LOF(1), 1), vbUnicode)Close #1End Sub‘保存Private Sub mnuSave_Click()On Error Resume NextCommonDialog1.Filter ="文档文件(*.txt)|*.txt|所有文件(*.*)|*.*"CommonDialog1.ShowSaveOpen CommonDialog1.FileName For Output As #1Print #1, Text1.TextClose 1End SubTextBox只支持打开64K以下的文件，建议最好设置出错处理。以上程序在PWin98、VB6.0下调试通过。201、避免使用没有效率的 IIF Function 及 Choose Function！IIF Function 的功能是根据逻辑判断，返回给定的二个值中的一个 (二选一)；Choose Function 的功能是从引数串列中选择并返回一个值 (多选一)。二个函数的语法如下：IIf(expr, truepart, falsepart)Choose(index, choice-1[, choice-2, ... [, choice-n]])这二个函数乍看之下，好像和 IF....Else IF....Else....End IF 是一样的，没错，结果好像是一样的，但是事实上 IF....Else....End IF 却比较有效率和安全多了，为什么呢？1、IIf 会计算 truepart 以及 falsepart，虽然它只返回其中的一个，所以您应该要留意这项副作用，例如，如果 falsepart 会产生除以零的错误，那么程序就会发生错误，即使 expr 为 True。2、Choose 会计算串列中的每个选择项，即使它只返回一个选项值。所以您应该注意这项副作用，例如，当您在每个选择项中使用了 MsgBox 函数，那么每计算一个选择项，就会显示一次讯息方块。而 IF....Else....End IF 却没有上述的缺点！所以，虽然 IIF 及 Choose Function 的程序码看起来相当简洁，但效率不见得比较好，最重要的，是可能还会导致错误产生。我的建议就是：能不用就不用！202、使用一个指令建立目录 (巢状目录)假设您需要建立目录，不管是在根目录或者是好几层的目录，例如：C:\Dir1\Dir2\Dir3\Dir4 下面这个模组都可以满足您的需求！它只需要一个参数，就是完整的目录名称 (指全路径)，例如："C:\Dir1\Dir2\Dir3\Dir4"。如果您给的目录中，前几层目录都已经存在，例如："C:\Dir1\Dir2\"，则它只会帮您再往下建立 Dir3 及 Dir4 二层目录而己。除了本机的磁盘之外，您已经 Mapped 的网路磁盘也可以做到！而如果您没有给定磁盘代号，它会将目录建立在应用程序的预设目录之下！Public Function MkDirs(ByVal PathIn As String) As BooleanDim nPos As LongMkDirs = True ‘先假设成功If Right$(PathIn, 1) <> "\" Then PathIn = PathIn + "\"nPos = InStr(1, PathIn, "\")Do While nPos > 0If Dir$(Left$(PathIn, nPos), vbDirectory) = "" ThenOn Error GoTo FailedMkDir Left$(PathIn, nPos)On Error GoTo 0End IfnPos = InStr(nPos + 1, PathIn, "\")LoopExit FunctionFailed:MkDirs = FalseEnd Function‘使用范例如下：在 Text1 中输入要建立的目录 (指全路径)Private Sub Command1_Click()Dim istrue As Booleanistrue = MkDirs(Text1)If istrue ThenMsgBox "目录已成功建立！", 64, "建立目录"ElseMsgBox "建立目录失败！", 16, "建立目录"End IfEnd Sub‘或许您在测试时找不到失败的范例，给您一个提示：将目录建在只读光盘驱动器试试！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.CloseEnd 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 LongConst EM_LINEFROMCHAR = &HC9Function LineNo(txthwnd As Long) As LongOn Local Error Resume NextLineNo = SendMessageLong(txthwnd, EM_LINEFROMCHAR, -1&, 0&) + 1LineNo = Format$(lineno, "##,###")End Function‘呼叫这个模组时要导入的是 TextBox 的 hwnd‘实际使用时，必须在 TextBox 的以下几个事件中呼叫这个模组，才会完全正确：‘1. Change事件：输入资料时可侦测计算‘2. Click 事件：用鼠标移动光标时可侦测计算‘3. KeyUp 事件：用上下左右键移动光标时可侦测计算Sub Text1_Change()Label1 = LineNo(Text1.hwnd)End SubPrivate Sub Text1_Click()Label1 = LineNo(Text1.hwnd)End SubPrivate Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)Label1 = LineNo(Text1.hwnd)End Sub205、当前操作系统的语言集声明：Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long例子：Dim LocaleID As LongLocalID = 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 LongConst EM_GETLINECOUNT = &HBAFunction LineCount(txthwnd As Long) As LongOn Local Error Resume NextLineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)LineCount = Format$(lineCount, "##,###")End Function‘呼叫这个模组时要传入的是 TextBox 的 hwnd‘实际使用时，用法如下：Private Sub Command1_Click()Label1 = LineCount(Text1.hwnd)End Sub207、如何预先算出目前在 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 LongConst EM_GETLINECOUNT = &HBAConst EM_LINEINDEX = &HBBConst EM_LINELENGTH = &HC1Function TextSize(txthwnd As Long) As LongDim lineCount As LongDim ChrsUpToLast As LongDim DocumentSize As LongOn Local Error Resume Next‘首先，算出 TextBox 的总行数lineCount& = SendMessageLong(txthwnd, EM_GETLINECOUNT, 0&, 0&)‘接著 ，算出 TextBox 的位元组数ChrsUpToLast& = SendMessageLong(txthwnd, EM_LINEINDEX, lineCount& - 1, 0&)If ChrsUpToLast& = 0 ThenDocumentSize& = 0ElseIf ChrsUpToLast& < 65000 ThenDocumentSize& = SendMessageLong(txthwnd, _EM_LINELENGTH, ChrsUpToLast&, 0&) + ChrsUpToLastEnd IfTextSize = Format$(DocumentSize&, "##,###")End Function‘呼叫这个模组时要传入的是 TextBox 的 hwnd‘实际使用时，用法如下：Private Sub Command1_Click()Label1 = TextSize(Text1.hwnd)End Sub208、如何以桌面上的背景图来设定 Form 的背景？这个功能是由网友 jimmy 所提供，它的功能就是将 User 桌面的图片直接拿来当作我们表单的背景图。PaintDesktop API 只　要传入一个数值，就是表单的 hDC 属性值。请直接将以下之程序码复制到表单中即可：Private Declare Function PaintDesktop Lib "user32" (ByVal hDC As Long) As LongPrivate Sub Form_Paint()PaintDesktop Me.hDCEnd 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 LongConst CB_GETCURSEL = &H147Const CB_SETCURSEL = &H14EConst LB_SETCURSEL = &H186Const LB_GETCURSEL = &H188函数：Public Function SetListIndex(lst As Control, ByVal NewIndex As Long) As LongIf TypeOf lst Is ListBox ThenCall SendMessage(lst.hWnd, LB_SETCURSEL, NewIndex, 0&)SetListIndex = SendMessage(lst.hWnd, LB_GETCURSEL, NewIndex, 0&)ElseIf TypeOf lst Is ComboBox ThenCall SendMessage(lst.hWnd, CB_SETCURSEL, NewIndex, 0&)SetListIndex = SendMessage(lst.hWnd, CB_GETCURSEL, NewIndex, 0&)End IfEnd Function210、调整 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 LongPrivate Const CB_GETDROPPEDWIDTH = &H15FPrivate Const CB_SETDROPPEDWIDTH = &H160Private Const CB_ERR = -1函数：‘ 取得 Combo 下拉的宽度‘ 可以利用该函数比例放大或缩小宽度Public Function GetDropdownWidth(cboHwnd As Long) As LongDim lRetVal As LonglRetVal = SendMessage(cboHwnd, CB_GETDROPPEDWIDTH, 0, 0)If lRetVal <> CB_ERR ThenGetDropdownWidth = lRetVal‘单位为 pixelsElseGetDropdownWidth = 0End IfEnd Function‘设置 Combo 下拉的宽度‘单位为 pixelsPublic Function SetDropdownWidth(cboHwnd As Long, NewWidthPixel As Long) As BooleanDim lRetVal As LonglRetVal = SendMessage(cboHwnd, CB_SETDROPPEDWIDTH, NewWidthPixel, 0)If lRetVal <> CB_ERR ThenSetDropdownWidth = TrueElseSetDropdownWidth = FalseEnd IfEnd Function004 把所有的字体名称放到 Combo 98-6-07For I = 0 To Screen.FontCount - 1cboFont.AddItem Screen.Fonts(I)Next I211、如何将短文件名格式转成长文件名？虽然在 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 StringDim sLongName As StringDim sTemp As StringDim iSlashPos As Integer‘在短文件名之后加上倒斜线 "\"，避免 Instr 造成错误sShortName = sShortName & "\"‘略过磁盘代号，从第四码开始iSlashPos = InStr(4, sShortName, "\")‘从文件名之第四码之后，一段一段处理在二个倒斜线 "\"之间的字串转换While iSlashPossTemp = Dir(Left$(sShortName, iSlashPos - 1), vbNormal + vbHidden + vbSystem + vbDirectory)If sTemp = "" Then ‘Error 52 - Bad File Name or NumberGetLongFilename = ""Exit FunctionEnd IfsLongName = sLongName & "\" & sTempiSlashPos = InStr(iSlashPos + 1, sShortName, "\")Wend‘将转换后的文件名加上原先略过的磁盘代号，变成完整的全路径文件名GetLongFilename = Left$(sShortName, 2) & sLongNameEnd 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 LongPrivate Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As LongPrivate Const GW_CHILD = 5Private Const LVA_ALIGNLEFT = &H1Private Const LVM_ARRANGE = &H1016Private Sub Command1_Click()Dim hWnd1 As LongDim hWnd2 As LongDim Ret As LonghWnd1 = 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 LongPublic Const CB_FINDSTRING = &H14CPrivate Sub Combo1_Change()Dim iStart As IntegerDim sString As StringStatic iLeftOff As IntegeriStart = 1iStart = Combo1.SelStartIf iLeftOff <> 0 ThenCombo1.SelStart = iLeftOffiStart = iLeftOffEnd IfsString = CStr(Left(Combo1.Text, iStart))Combo1.ListIndex = SendMessage(Combo1.hwnd, B_FINDSTRING, -1, ByVal CStr(Left(ombo1.Text, iStart)))If Combo1.ListIndex = -1 TheniLeftOff = Len(sString)combo1.Text = sStringEnd IfCombo1.SelStart = iStartiLeftOff = 0End 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 LongPrivate Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const GWL_STYLE = -16&Private Const TVM_SETBKCOLOR = 4381&Private Const TVM_GETBKCOLOR = 4383&Private Const TVS_HASLINES = 2&Dim frmlastForm As FormPrivate Sub Form_Load()Dim nodX As NodeSet 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.EnsureVisibleTreeView1.style = tvwTreelinesText ‘ Style 4.TreeView1.BorderStyle = vbFixedSingleEnd SubPrivate Sub Command1_Click()Dim lngStyle As LongCall 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