VB实例操作举例
VB实例操作举例
列举210多种例子
列举了200多种实例程序，通俗易懂。
适合各级编程人员阅读使用。
1、如何在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 Long
Declare 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 Explicit
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 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=Sen
dMessage(Text1.hwnd, WM_UNDO, 0, 0)
End Sub
除了TextBox外SendMessage 还可以对RitchTextBox和ComboBox等进行操作,只要相应改变hwnd参数即可。
2、在VB中如何创建闪烁(标语)屏
大型应用系统启动运行的时间需要很长时间,其时间会根据需要初始化的数量和用户系统的速度变化,因此在主窗口显示前,应显示一个初始化窗口,使应用程序看起来更具吸引力,因为当装载程序时不断可以向用户显示一些信息，而且可产生美观的视觉效果。例如vb、delphi在启动时均在主界面前显示一splash窗口.
---- 1. 下面是显示闪烁(标语)屏splash的一种简单方法:
option explicit
private sub form_load()
'显示主窗口
me.show
'显示splash窗口
frmsplash.show
doevents
'执行应用程序初始化
initialize
'关闭splash窗口
unload spalsh
end 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 explicit
private sub form_load()
frmsplash.lbllicenseto=app.legaltrademarks
frmsplash.lblcompanyproduct=app.productname
frmsplash.lblplatform="window 98"
frmsplash.lblcopyright=app.legalcopyright
frmsplash.lblcompany=https://www.360docs.net/doc/cc8096698.html,panyname
frmsplash.lblwarning="Warning:this program is protected" & _
"by copyright law,so don't copy "
frmsplash.show
doevents
initialize
unload frmsplash
end sub
---- 注意这里使用了app对象，该对象可以访问有关你的应用程序的信息;
---- splash screen 窗体摸板代码模块的代码如下所示:
Private Sub Form_keypress(keyascii as integer)
unload me
End sub
Private sub form_load()
lblversion.caption="version"&app.major&".
"app.minor"."app.revision
lblproductname.caption=app.title
end sub
private sub frame1_click()
unload me
End Sub
3、如何用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 Long
Sub Command1_Click()
Dim lReturn As Long
'添加到桌面
lReturn = fCreateShellLink("..\..\Desktop", "Shortcut to Calculator", "c:\windo
ws\calc.exe", "")
'添加到程序组
lReturn = fCreateShellLink("", "Shortcut to Calculator", "c:\windows\calc.exe", "")
'添加到启动组
lReturn = fCreateShellLink("\Startup", "Shortcut to Calculator", "c:\windows\calc.exe", "")
End Sub
4、如何去优化你的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）使用进度条。要使用进度条，需要事先知道数据量，所以它很适合用于对已知数据的操作，如数据库的排序。
总之，优化程序要从自己、从用户等多方面考虑，使程序开发周期短，且高效易用。
5、如何在Windows操作系统中改变文件打开方式
在Wind
ows 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 = ＆H80000000
Declare 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 Long
Declare Function OSRegOpenKey Lib “advapi32”Alias “RegOpenKeyA”(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
Declare 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 Long
Declare 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=valuel
keyword2=value2
……
[section2]
keyword1=value1
keyword2=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模块的程序代码如下:
在Ge
neral-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 Integer
Declare FunctionGetPrivatePfileInt Lib "Kernel"(ByVal lpAppName As String，ByVal lpKeyName As String，ByVal lpDefault As Integer，ByVal Filename As String)As Integer
Declare FuncitonWritePrivateprofileString Lib "Kernel"(ByVal lpApplicationName As String，ByVal lpKeyName As String，ByVal lpString As String，ByVal lplFileName As String)As Integer
Function GetIniS(ByVal SectionName As String，ByVal KeyWord As String，ByVal DefString As String)As String
Dim ResultString As String * 144，Temp As Integer
Dims As String，i As Integer
Temp%=GetPrivateProfileString(SectionName，KeyWord，""，ResultString，144，AppProfileName())
‘检索关键词的值
IfTemp%＞0Then‘关键词的值不为空
s=""
Fori=1To144
IfAsc(Mid$(ResultString，I，1))=0Then
ExitFor
Else
s=s&Mid$(ResultString，I，1)
EndIf
Next
Else
Temp%=WritePrivateProfilesString(sectionname，KeyWord，DefString，ppProfileName())
‘将缺省值写入INI文件
s=DefString
EndIf
GetIniS=s
EndFunction
FunctionGetIniN(ByValSectionNameAsString，ByValKeyWordAsString，ByValDefValue
AsIneger)AsInteger
DimdAsLong，sAsString
d=DefValue
GetIniN=GetPrivateProfileInt(SectionName，
KeyWord，DefValue，ppProfileName())
Ifd＜＞DefValueThen
s=""&d
d=WritePrivateProfileString(SectionName，
KeyWord，s，AppProfileName())
EndIf
EndFunction
SubSetIniS(ByValSectionNameAsString，BtVaKeyWordAsString，ByValValStr
AsString)
Dimres%
res%=WritePrivateprofileString(SectionName，KeyWord，ValStr，AppProfileName())
EndSub
SubSetIniN(ByValSectionNameAsString，ByValKeyWordAsString，ByValValInt
AsInteger)
Dimres%，s$
s$=Str$(ValInt)
res%=WriteprivateProfileString(SectionName，KeyWord，s$，AppProfileName())
EndSub
SectionName为每一部分的标题，KeyWord为关键词，GetIniS和GetIniN中的DefValue为关键词的缺省值，SetIniS和SetIniN的ValStr和ValInt为要写入INI文件的关键词的值。为了能更好地说明如何使用以上函数和过程，下面举两个实例。
实例1:
开发应用程序通常要使用数据库和其它一些文件，这些文件的目录(包括路径和文件名)不应在程序中固定，而是保存在INI文件中，程序运行时由INI文件中读入。读入数据库文件的代码如下:
DimDatabasenameAsString
Databasename=GetIniS("数据库"，"职工"，"")
IfDatabaseName=""ThenDatabaseName=InputBox("请输入数据库《职工》的目录")，
App.Title)’也可通过"文件对话框"进行选择
OnErrorResumeNext
Setdb=OpenDatabas(DatabaseName)
IfErr＜＞0Then
MsgBox"打开数据库失败!"，MB-
ICONSTOP，App.Title:GotoErrorProcessing
Else
SetIniS"数据库"，"职工
"，DatabaseName
EndIf
OnErrorGoTo0
……
实例2:
为了方便用户操作，有时需要保存用户界面的某些信息，例如窗口的高度和宽度等。装载窗体时，从INI文件中读入窗体高度和宽度，卸载窗体时将窗体当前高度和宽度存入INI文件，代码如下:
Sub Form1_Load()
……
Forml.Height=GetIniN("窗体1"，"高度"，6000)
Form1.Width=GetIniN("窗体1"，"高度"，4500)
EndSub
……
Sub Form1_Unload()
……
SetIniN"窗体1"，"高度"，Me.Height
SetIniN"窗体1，"宽度"，Me.Width
……
End Sub
7、程序中如何启动默认的拨号连接
随着因特网的迅猛发展，现在编程常需要在程序中直接联网来处理一些事项，如在线注册和在线帮助，这就要求我们要在程序中建立某些连接。很多软件在不知用户是否联网的情况下不管三七二十一就启动浏览器查找网址，费了九牛二虎之力只能查出一错误页来（当然不可能有什么好的结果）。如果我们在程序编写时能自动判断用户是否已经联网，如已经联网则打开联接，如没有则启动默认的拨号连接，这样是不是让人觉得你的软件更胜人一处呢？判断是否已联网很多地方都有介绍，这里我们只介绍如何启动默认的拨号连接。
---- 在介绍之前让我们首先看看如何打开拨号网络。由于拨号网络不是一个可执行文件，所以不能用 “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 Long
Private 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 Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
'常数
Const HKEY_CURRENT_USER = &H80000001
Const ERROR
_SUCCESS = 0&
Private Sub cmdCallConnect_Click()
'启动默认拨号连接
Shell "rundll rnaui.dll,RnaDial " + GetConnect, vbNormalFocus
End Sub
Public Function GetConnect() As String
Dim hKey As Long
Dim SubKey As String
hKey = HKEY_CURRENT_USER '主键
SubKey = "RemoteAccess" '子键
'取得默认连接名
GetConnect = GetRegValue(hKey, SubKey, "Default")
End Function
Public Function GetRegValue(hKey As Long, lpszSubKey As String, szKey As String) As Variant
On Error GoTo ErrorRoutineErr:
Dim phkResult As Long
Dim lResult As Long
Dim szBuffer As String
Dim 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 Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue = ""
End If
Exit Function
ErrorRoutineErr:
GetRegValue = ""
End Function
以上程序在 WIN98,VB6.0 下调试通过。
8、如何通过VB获取网卡地址
[功能描述] IPX和NETBIOS接口需要网络地址。该文通过详细的步骤演示了如何通过VB获取网卡地址。
步骤：
1)在Visual Basic生成标准的EXE文件。缺省创建 Form1。
2)在Form1中添加一命令按钮，缺省名为Command1。
3)把下列代码放到Form1中说明部分。
Option Explicit
Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32
Private 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 Long
End Type
Private 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 Integer
End Type
Private Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End Type
Private Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End Type
Private Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
Private 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 Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private 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 https://www.360docs.net/doc/cc8096698.html,stDllError
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 https://www.360docs.net/doc/cc8096698.html,stDllError
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, pASTAT
End Sub
4)按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.1
Microsoft 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 (Msj
ro.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.JetEngine
Set jro = New jro.JetEngine
https://www.360docs.net/doc/cc8096698.html,pactDatabase "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.Path
If Right(str, 1) <> "\" Then
str = str + "\"
End If
data1.databasename=str & "\数据库名"
data1.recordsource="数据表名"
data1.refresh
sub end
这几句话的意为，打开当前程序运行的目录下的数据库。
你只要保证你的数据库在你程序所在的目录之下就行了。
二、利用adodc（ADO Data Control)进行数据库链接：
private form_load ()
Dim str As String '定义
str = App.Path
If Right(str, 1) <> "\" Then
str = str + "\"
End If
str = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & str & "\tsl.mdb"
Adodc1.ConnectionString = str
https://www.360docs.net/doc/cc8096698.html,mandType = adCmdText
Adodc1.RecordSource = "select * from table3"
Adodc1.Refresh
end sub
三、利用DataEnvironment进行数据库链接
可在过程中放入：
On Error Resume Next
If DataEnvironment1.rsCommand1.State <> adStateClosed Then
DataEnvironment1.rsCom
mand1.Close '如果打开，则关闭
End If
'i = InputBox("请输入友人编号:", "输入")
'If i = "" Then Exit Sub
DataEnvironment1.Connection1.Open App.Path & "\userdatabase\tsl.mdb"
DataEnvironment1.rsCommand1.Open "select * from table3 where 编号='" & i & "'"
'Set DataReport2.DataSource = DataEnvironment1
'DataReport2.DataMember = "command1"
'DataReport2.show
end sub
四、利用ADO(ActiveX Data Objects)进行编程：
建立连接：
dim conn as new adodb.connection
dim rs as new adodb.recordset
dim str
str = App.Path
If Right(str, 1) <> "\" Then
str = str + "\"
End If
str = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & str & "\tsl.mdb"
conn.open str
rs.cursorlocation=aduseclient
rs.open "数据表名",conn,adopenkeyset.adlockpessimistic
用完之后关闭数据库：
conn.close
set conn=nothing
11、如何让用户自行输入方程式，并计算其结果？
假设我们要让使用者在“方程式”栏位中自由输入方程式，然后利用方程式进行计算，则引用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_click
Form1.printfo
rm
End sub
---- 这样即可通过打印窗体FORM1的方法把GRID1的数据打印出来，遗憾的是只能打印GRID1中显示的数据部分，显示不出来的则无法打印， 而且这种打印方法很象屏幕硬拷贝把其他控件也打印出来。也不能灵活的控制字体等。
---- 方法二：通过PRINTER实现打印。这种方法
---- 1、加入打印命令按钮(command1)、函数(print1)即可实现打印功能，写入下面代码，读者稍加改动可写成标准的函数或过程。
Function prnt1 (x As Integer, y As Integer,
font As Single, txt As String)
printer.CurrentX = x
printer.CurrentY = y
printer.FontBold = False
printer.FontSize = font
printer.Print txt
End Function
Sub command1_click
Dim fnt As Single
Dim pp as integer
Pp=0'设置开始页码0
Dim stry,strx,strx1,stry1,linw,page1,p As Integer
Static a(8) As Integer'定义打印的列数
ss$ = "内部结算存入款对帐单"'定义表头
kan = 0
For i = 0 To 8
a(i) = 1500'定义每列宽
kan = kan + a(i)'计算表格总宽度
Next
page1 = 50'定义每页行数
strx = 200
strx1 = 200'定义X方向起始位置
stry = 1400
stry1 = 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 = j
strx = strx1
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
p = p + 1
For i = 0 To 8
grid1.col = i
dd = prnt1(strx, stry, fnt, grid1.text)
strx = strx + a(i)
Next
If p > page1 Then'next page
p = 0
strx = strx1
'line last line
printer.Line (strx - 50, stry + linw)
-(strx + kan - 10, stry + linw)
stry = stry1
'line col
For n = 0 To 8
printer.Line (strx - 30, stry - 30)
-(strx - 30, stry + (page1 + 2) * linw)
strx = strx + a(n)
Next
printer.Line (strx - 30, stry - 30)
-(strx - 30, stry + (page1 + 2) * linw)
pp=pp+1
foot$="第 "+cstr(pp)+"页"
dd = prnt1(strx - 30-1000, stry + (page1 + 2)
* linw+100, 10, foot$)'打印页角码
printer.NewPage'next page
dd = prnt1(4000, 700, 18, ss$) '打印标题
strx = strx1
stry = stry1
printer.Line (strx - 50, stry - 30)-
(strx + kan - 10, stry - 30)' print first row
Else
stry = stry + linw
End If
Next
st = stry
If p < page1 Then '在最后页剩余划空行
For o = p To page1 + 1
strx = strx1
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
stry = stry + linw
Next
End If
stry = stry1
strx = strx1
stry = stry1 'line col
For n = 0 To 8
printer.Line (strx - 30, stry - 30)-
(strx - 30, stry + (page1 + 2) * linw)
strx = strx + a(n)
Next
printer.Line (strx - 30, stry - 30)-
(strx - 30, stry + (page1 + 2) * linw)
pp=pp+1
foot$="第 "+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 = 11
Set msword = CreateObject("word.basic")
Dim AppID, ReturnValue
appID = Shell("d:\office97\office\WINWORD.EXE", 1)
' Run Microsoft Word.
msword.AppActivate "Microsoft Word"
'msword.AppActivate "Microsoft Word", 1
full
Screen.MousePointer = 0
End Sub
---- 2、写入以下过程full()
Sub full()
Dim i As Integer, j As Integer,
col As Integer, row As Integer
Dim cellcontent As String
Me.Hide
cols = 4'表格的列数
row = gridrow'打印表的行数
msword.filenewdefault
msword.MsgBox "正在建立MS_WORD报表，
请稍候.......", "", -1
msword.leftpara
msword.screenupdating 0
msword.tableinserttable , col, row, , , 16, 167
msword.startofdocument
for j=0 to gridrow' 表格的行数
grid1.row=j
For i = 1 To cols
Gri1d.col=i
If IsNull(grid1.text) Then
cellcontent$ = ""
Else
cellcontent$ = grid1.text
End If
msword.Insert cellcontent$
msword.nextcell
Next i
Next j
msword.tabledeleterow
msword.startofdocument
msword.tableselectrow
msword.tableheadings 1
msword.centerpara
'msword.startdocument
msword.screenrefresh
msword.screenupdating 1
msword.MsgBox " 结束", "", -1
Me.Show
End Sub
---- 方法四：通过发送到MICROSOFT EXCEL实现表格打印
---- 1、加入打印命令按钮(command3)，CAPTION 设为"生成EXCEL 表格"，写入下面代码
Private Sub command3_Click()
Dim i As Integer
Dim j As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
'Set xlBook = xlApp.Workbooks.Add
'On Error Resume Next
Set xlBook = xlApp.Workbooks.Add 'Open("d:\text2.xls")
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(6, 1) = "i"
For i = 0 To gridrow
grid1.Row = i
For j = 0 To 6
Grid1.Col = j
If IsNull(Grid1.Text) = False Then
xlSheet.Cells(i + 5, j + 1) = Grid1.Text
End If
Next j
Next i
Exit Sub
13、如何在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 Explicit
Private Old_X As Single
Private Old_Y As Single
Private isMouseDown As Boolean
Private Box_X0 As Single
Private Box_Y0 As Single
Private Box_X1 As Single
Private Box_Y1 As Single
Private PenColor As Long
Private CrossColor As Long
Private Sub Form_Load()
CrossColor = QBColor(8)
PenColor = QBColor(15)
picDraw.DrawMode = vbXorPen
picDraw.MouseIcon = LoadPicture
(App.Path & "\no.cur")
picDraw.MousePointer = vbCustom
isMouseDown = False
Box_X0 = Box_X1 = Box_Y0 = Box_Y1 = 0
End Sub
Private Sub picDraw_MouseDown
(Button As Integer,
Shift As Integer, X As Single, Y As Single)
If isMouseDown = True Then
'先前已经用鼠标定义了一个点
Box_X1 = X
Box_Y1 = Y
isMouseDown = False
picDraw.DrawMode = vbCopyPen
picDraw.Line (Box_X0, Box_Y0)-
(Box_X1, Box_Y1),
PenColor, B
picDraw.DrawMode = vbXorPen
'画一个光标
picDraw.Line (0, Y)-(picDraw.ScaleWidth, Y),
CrossColor
picDraw.Line (X, 0)-(X, picDraw.ScaleHeight),
CrossColor
Old_X = X
Old_Y = Y
Else
'定义了一个矩形的第一个顶点，则擦除光标
picDraw.Line (0, Y)-(picDraw.ScaleWidth, Y),
CrossColor
picDraw.Line (X, 0)-(X, picDraw.ScaleHeight),
CrossColor
Box_X0 = X
Box_Y0 = Y
isMouseDown = True
End If
End Sub
Private 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, B
picDraw.Line (Box_X0, Box_Y0)-(X, Y), PenColor, B
Else
'消除旧光标线
picDraw.Line (0, Old_Y)-(picDraw.ScaleWidth, Old_Y),
CrossColor
picDraw.Line (Old_X, 0)-(Old_X, picDraw.ScaleHeight),
CrossColor
'画新的光标线
picDraw.Line (0, Y)-(picDraw.ScaleWidth, Y),
CrossColor
picDraw.Line (X, 0)-(X, picDraw.ScaleHeight),
CrossColor
End If
Old_X = X
Old_Y = Y
End Sub
14、如何充分扩充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
二、在控件层使用VBX
VB功能强大的第二个部分是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 Variant
For Each obj In objs
obj.Enabled = Enabled
Next obj
End Sub
应用：
EnableAll True, Text1, Text2, Command1, Command2
VB问题全功略（4） [查找本页请按Ctrl+F]
［上一页］（4）［下一页］
16、如何避免程式重复执行？（侦测是否存在前一副本，若有，则结束目前新启动的程式）
17、如何让一个 App 永远保持在最上层 ( Always on Top )
18、表单配置视窗和解析度
19、连续变量的声明 Dim a, b, c as string * 4
20、正确的除错 (Debug) 方式
16、如何避免程式重复执行？（侦测是否存在前一副本，若有，则结束目前新启动的程式）
使用者在启动程式后，有时会将程式缩小在工作列上，之后要用时，又会重新启动一次程式，资料库程式有时会因此造成资料错乱！若您不希望使用者重复启动程式，您可以使用 APP 物件来判断，方法如下：
Private Sub Form_Load()
If App.PrevInstance Then '检视前一版本
MsgBox "此程式已经在执行中！", 48
End
End If
End Sub
17、如何让一个 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 Long
Const 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, FLAGS
18、表单配置视窗和解析度
这个地方不是要告诉您如何写出一支程式，会自动根据使用者荧幕的解析度调整 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 * 4
Dim b as string * 4
Dim c as string * 4
若想写在同一行，也可以，写法如下：
Dim a as string * 4, b as string * 4, c as string * 4
20、正确的除错 (Debug) 方式
当程式执行起来怪怪的，很多人在除错 (Debug) 时，都喜欢在程式中使用中断点 (Break) 加上 MsgBox 来看执行结果，但有些时候，这样子的作法会造成某些事件 (Event) 无法触发，甚至改变事件原来触发的顺序！
比较正确的作法是在程式中使用 Debug.Print "事件名称/要显示的讯息" ，而不要用中断点 (Break)。
21、Move Method 速度较快
当我们要移动控制项 (Control) 或表单 (Form) 时，很多人习惯这样写：
frmCustomer.Left = frmCustomer.Left + 100
frmCustomer.Top = frmCustomer.Top + 50
但是若使用 Move Method ，可以加快 40%：
frmCustomer.Move frmCustomer.Left + 100, frmCustomer.Top + 50
22、哇！我的变量名称变成了保留字！
当我们升级 VB 的版本时，有时候会因为以前程序中使用的变量名称或函数名称变成了保留字，而使程序跑起来完全不正常，例如：
print：VB3 时不是保留字，但到了 VB4 却变成了保留字。
array：VB4 时不是保留字，但到了 VB5 却变成了保留字。
遇到这种情形，其实也很简单！只要在 VB 中叫出该工程，打开任何一个表单的程序码，选择【编辑功能表】中的【取代】，搜寻范围设定成【整个工程】，并将【全字拼写须符合】选项打勾，然后将该工程中该字串改成另一