VB精典实用源代码详细.docx

1、VB精典实用源代码详细个人收藏的VB精典实用源代码。若朋友您想要问如何才能学好vb，或者入门需要看什么教材一类的问题，建议你抱着一颗刻苦钻研的心去面对这门学问，多动脑，少提问，遇到不知道的，多查资料，多看看帖子，或者用断点来亲自试验。实在不会了，请在此贴中查找您的常见问题，如果还没有，那请您发出新贴，向各位高手讨教：）查找方法：按ctrl+f，输入要查找的问题关键字即可每个问题中间用/分隔，这只是一部分最常见到的问题，以后会逐渐更新。/如何用VB建立快捷方式Private Declare Function fCreateShellLink Lib STKIT432.DLL (ByVal lps

2、trFolderName 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:windowscalc.exe, )添加到程序组lReturn = fCreateShellLink(, Shortcut to Cal

3、culator, c:windowscalc.exe, )添加到启动组lReturn = fCreateShellLink(Startup, Shortcut to Calculator, c:windowscalc.exe, )End Sub/如何让程序在 Windows 启动时自动执行？有以下二个方法：方法1: 直接将快捷方式放到启动群组中。方法2:在注册档 HKEY_LOCAL_MACHINE 中找到以下机码SoftwareMicrosoftWindowsCurrentVersionRun新增一个字串值，包括二个部份1. 名称部份：自己取名，可设定为 AP 名称。2. 资料部份：则是包含

4、 全路径档案名称 及 执行参数例如：Value Name = NotepadValue Data = c:windowsnotepad.exe/在 TextBox 中如何限制只能输入数字？参考下列程序：Sub Text1_KeyPress(KeyAscii As Integer)If KeyAscii 57 ThenKeyAscii = 0End IfEnd Sub/我希望 TextBox 中能不接受某些特定字符，例如 #$%，有没有简单一点的写法？方法有好几种, 以下列举二种：方法1: 可以使用 IF 或 Select Case 一个个判断, 但如果不接受的字符多时, 较麻烦! 方法2: 将

5、要剔除的字符统统放在一个字串中，只要一个 IF 判断即可 ! 如下： Private Sub Text1_KeyPress(KeyAscii As Integer)Dim sTemplate As StringsTemplate = !#$%&*()_+-= 用来存放不接受的字符If InStr(1, sTemplate, Chr(KeyAscii) 0 ThenKeyAscii = 0End IfEnd Sub/如何让鼠标进入 TextBox 时自动选定 TextBox 中之整串文字？这个自动选定反白整串文字的动作，会使得输入的资料完全取代之前在 TextBox 中的所有字符。Private

6、 Sub Text1_GotFocus()Text1.SelStart = 0Text1.SelLength = Len(Text1)End Sub/如何检查软盘驱动器里是否有软盘？使用：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_

7、FloppyDrive = Dir(sDrive) End Function/如何弹出和关闭光驱托盘？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()mc

8、iExecute set cdaudio door open 弹出光驱Label2.Caption = 弹 出End SubPrivate Sub Command2_Click()Label2.Caption = 关 闭mciExecute set cdaudio door closed 合上光驱Unload MeEndEnd Sub/如何让你的程序在任务列表隐藏 Private Declare Function RegisterServiceProcess Lib kernel32 (ByVal ProcessID As Long, ByVal ServiceFlags As Long) A

9、s LongPrivate Declare Function GetCurrentProcessId Lib kernel32 () As Long请你试试 Ctrl+Alt+Del 是不是你的程序隐藏了Private Sub Command1_Click()i = RegisterServiceProcess(GetCurrentProcessId, 1)End Sub /如何用程序控制滑鼠游标 (Mouse Cursor) 到指定位置？以下这个例子，当 User 在 Text1 中按下 Enter 键后，滑鼠游标会自动移到 Command2 按钮上方 请在声明区中加入以下声明：16 位版本

10、： ( 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%

11、= (Form1.Left + Command2.Left + Command2.Width / 2 + 60) / Screen.TwipsPerPixelXy% = (Form1.Top + Command2.Top + Command2.Height / 2 + 360) / Screen.TwipsPerPixelYSetCursorPos x%, y%End IfEnd Sub/如何用鼠标移动没有标题的 Form，或移动 Form 中的控制项？在声明区中放入以下声明： 16 位版本： ( Sub 无返回值 )Private Declare Sub ReleaseCapture Lib

12、 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 SendMess

13、ageA (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(Form

14、1.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 Sub/检查文件是否存在？Function FileExists(filename A

15、s String) As IntegerDim i As IntegerOn Error Resume Nexti = Len(Dir$(filename)If Err Or i = 0 Then FileExists = False Else FileExists = TrueEnd Function/如何设置对VB数据库连接的动态路径我个人因为经常作一些数据库方面的程序，对于程序间如何与数据库进行接口的问题之烦是深有体会，因为VB在数据库的时候，一般是静态，即数据库存放的路径是固定的，如用VB的DATA，adodc,DataEnvironment 等到作数据库时，如果存放数据库的路径被改变

16、的话，就会找不到路经，真是一个特别烦的事。笔者的解决方法是利用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这几句话的意为，打开当前程序运行的目录下的数据库。你只要保证你的数据库在你程序所在的目录之下就行了

17、。二、利用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.mdbAdodc1.ConnectionString = strAdodc1.CommandType = adCmdTextAdodc1.RecordSourc

18、e = select * from table3Adodc1.Refreshend sub三、利用DataEnvironment进行数据库可在过程中放入：On Error Resume NextIf DataEnvironment1.rsCommand1.State adStateClosed ThenDataEnvironment1.rsCommand1.Close 如果打开，则关闭End Ifi = InputBox(请输入友人编号:, 输入)If i = Then Exit SubDataEnvironment1.Connection1.Open App.Path & userdatab

19、asetsl.mdbDataEnvironment1.rsCommand1.Open select * from table3 where 编号= & i & Set DataReport2.DataSource = DataEnvironment1DataReport2.DataMember = command1DataReport2.showend sub四、利用ADO(ActiveX Data Objects)进行编程：建立连接：dim conn as new adodb.connectiondim rs as new adodb.recordsetdim strstr = App.Pa

20、thIf Right(str, 1) Thenstr = str + End Ifstr = Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source= & str & tsl.mdbconn.open strrs.cursorlocation=aduseclientrs.open 数据表名,conn,adopenkeyset.adlockpessimistic用完之后关闭数据库：conn.closeset conn=nothing/如何让用户自行输入方程式，并计算其结果？假设我们要让使用者在“方程式”栏

21、位中自由输入方程式，然后利用方程式进行计算，则引用ScriptControl控件可以很方便地做到。( ScriptControl 控件附属于VB 6.0，如果安装后没有看到此一控件，可在光盘的 CommonToolsVBScript 目录底下找此一控件， 其.文件名为Msscript.ocx。) 假设放在窗体上的ScriptControl控件名称为ScriptControl1，则在“计算”按钮的Click事件中编写如下代码： Dim Statement As String Statement = X= + Text1.Text + vbCrLf + _ Y= + Text2.Text + vb

22、CrLf + _ MsgBox 计算结果= & Y ScriptControl1.ExecuteStatement( Statement /如何让一个 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 wFlag

23、s 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,

24、0, 0, 0, 0, FLAGS/我要如何在程序中开启网页？在声明区中声明如下 (在 .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

25、 As Long) As Long在程序中Intranet：ShellExecute Me.hWnd, open, Intranet主机/目录, , , 5Internet：ShellExecute Me.hWnd, open, .ruentex.tw, , , 5/VB可以产生四角形以外其他形状的 Form 吗？这个问题，您一定无法想像有多容易，您可以产生任何形状的 Form，但必须借助 CreateEllipticRgn 及 SetWindowRgn 二个 API ，例如：Private Declare Function CreateEllipticRgn Lib gdi32 (ByVal

26、 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