《2022年VB精典实用源代码).pdf》由会员分享，可在线阅读，更多相关《2022年VB精典实用源代码).pdf（19页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、VB精典实用源代码 ( 详细 ) 个人收藏的VB 精典实用源代码。若朋友您想要问如何才能学好vb,或者入门需要瞧什么教材一类的问题,建议您抱着一颗刻苦钻研的心去面对这门学问,多动脑 ,少提问 ,遇到不知道的,多查资料 ,多瞧瞧帖子 ,或者用断点来亲自试验。 实在不会了 ,请在此贴中查找您的常见问题,如果还没有 ,那请您发出新贴,向各位高手讨教 :) 查找方法 :按 ctrl+f,输入要查找的问题关键字即可每个问题中间用/ 分隔 ,这只就是一部分最常见到的问题,以后会逐渐更新。/ 如何用 VB建立快捷方式Private Declare Function fCreateShellLink Lib
2、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:windowscalc、 exe, ) 添加到程序组lReturn = f
3、CreateShellLink(, Shortcut to Calculator, c:windowscalc、exe, ) 添加到启动组lReturn = fCreateShellLink(Startup, Shortcut to Calculator, c:windowscalc、exe, ) End Sub / 如何让程序在Windows 启动时自动执行？有以下二个方法: 方法 1: 直接将快捷方式放到启动群组中。方法 2: 在注册档HKEY_LOCAL_MACHINE 中找到以下机码SoftwareMicrosoftWindowsCurrentVersionRun 新增一个字串值,包括
4、二个部份1、 名称部份 :自己取名 ,可设定为AP 名称。2、 资料部份 :则就是包含全路径档案名称 及 执行参数 例如 : Value Name = Notepad Value Data = c:windowsnotepad 、exe / 在 TextBox 中如何限制只能输入数字？参考下列程序 : Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii 57 Then KeyAscii = 0 End If End Sub / 我希望TextBox 中能不接受某些特定字符,例如#$%,有没有简单一点的写法？精品资料 - - - 欢迎下载 -
5、- - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 1 页，共 19 页 - - - - - - - - - - VB精典实用源代码 ( 详细 ) 方法有好几种 , 以下列举二种 : 方法 1: 可以使用IF 或 Select Case 一个个判断 , 但如果不接受的字符多时, 较麻烦 ! 方法 2: 将要剔除的字符统统放在一个字串中,只要一个IF 判断即可! 如下 : Private Sub Text1_KeyPress(KeyAscii As Integer) Dim sTemplate As String sTemplate = !#$%
6、&*()_+-= 用来存放不接受的字符If InStr(1, sTemplate, Chr(KeyAscii) 0 Then KeyAscii = 0 End If End Sub / 如何让鼠标进入TextBox 时自动选定TextBox 中之整串文字？这个自动选定反白整串文字的动作,会使得输入的资料完全取代之前在TextBox 中的所有字符。Private Sub Text1_GotFocus() Text1、SelStart = 0 Text1、SelLength = Len(Text1) End Sub / 如何检查软盘驱动器里就是否有软盘？使用 : Dim Flag As Boole
7、an Flag = Fun_FloppyDrive(A:) If Flag = False Then MsgBox A:驱没有准备好 ,请将磁盘插入驱动器！, vbCritical - 函数 :检查软驱中就是否有盘的存在- Private Function Fun_FloppyDrive(sDrive As String) As Boolean On Error Resume Next Fun_FloppyDrive = Dir(sDrive) End Function / 如何弹出与关闭光驱托盘？Option Explicit Private Declare Function mciSend
8、String Lib winmm 、 dll Alias mciSendStringA (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Sub Command1_Click() mciExecute set cdaudio door open 弹出光驱Label2、Caption = 弹 出 End Sub Private Sub Command2_Click() L
9、abel2、Caption = 关 闭 mciExecute set cdaudio door closed 合上光驱精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 2 页，共 19 页 - - - - - - - - - - VB精典实用源代码 ( 详细 ) Unload Me End End Sub / 如何让您的程序在任务列表隐藏Private Declare Function RegisterServiceProcess Lib kernel32 (ByVal ProcessID As Long,
10、 ByVal ServiceFlags As Long) As Long Private 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 键后 ,滑鼠游标会自动移到
11、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(KeyAs
12、cii As Integer) If KeyAscii = 13 Then x% = (Form1、Left + Command2、 Left + Command2、Width / 2 + 60) / Screen 、TwipsPerPixelX y% = (Form1、Top + Command2、Top + Command2、Height / 2 + 360) / Screen 、TwipsPerPixelY SetCursorPos x%, y% End If End Sub / 如何用鼠标移动没有标题的Form,或移动Form 中的控制项？在声明区中放入以下声明: 16 位版本 : (
13、 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 Long Private
14、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 = &H112 Const SC_MOVE = &HF012 若要移动Form,程序码如下 : 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 3 页，共 19 页
15、- - - - - - - - - - VB精典实用源代码 ( 详细 ) Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim i As Long i = ReleaseCapture i = SendMessage(Form1、 hwnd, WM_SYSCOMMAND, SC_MOVE, 0) End Sub 以上功能也适用于用鼠标在Form 中移动控制项,程序码如下 : Private Sub Command1_MouseDown(Button As Int
16、eger, Shift As Integer, X As Single, Y As Single) Dim i As Long i = ReleaseCapture i = SendMessage(Command1、hwnd, WM_SYSCOMMAND, SC_MOVE, 0) End Sub / 检查文件就是否存在？Function ( As String) As Integer Dim i As Integer On Error Resume Next i = Len(Dir$() If Err Or i = 0 Then = False Else = True End Function
17、 / 如何设置对VB 数据库连接的动态路径我个人因为经常作一些数据库方面的程序,对于程序间如何与数据库进行接口的问题之烦就是深有体会 ,因为 VB在数据库链接的时候,一般就是静态,即数据库存放的路径就是固定的,如用 VB的 DATA,adodc,DataEnvironment 等到作数据库链接时,如果存放数据库的路径被改变的话,就会找不到路经,真就是一个特别烦的事。笔者的解决方法就是利用app、path 来解决这个问题。一、用 data 控件进行数据库链接,可以这样 : 在 form_load() 过程中放入 : private form_load() Dim str As String 定义
18、str = App、 Path If Right(str, 1) Then str = str + End If data1、数据库名 data1、recordsource= 数据表名 data1、refresh sub end 这几句话的意为,打开当前程序运行的目录下的数据库。您只要保证您的数据库在您程序所在的目录之下就行了。二、利用adodc(ADO Data Control)进行数据库链接: private form_load () Dim str As String 定义str = App、 Path 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载
19、 名师归纳 - - - - - - - - - -第 4 页，共 19 页 - - - - - - - - - - VB精典实用源代码 ( 详细 ) 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 Adodc1、CommandType = adCmdText Adodc1、RecordSource =
20、select * from table3 Adodc1、Refresh end sub 三、利用DataEnvironment 进行数据库链接可在过程中放入: On Error Resume Next If DataEnvironment1 、rsCommand1、State adStateClosed Then DataEnvironment1 、rsCommand1、Close 如果打开 ,则关闭End If i = InputBox( 请输入友人编号:, 输入 ) If i = Then Exit Sub DataEnvironment1 、Connection1、Open App、Pa
21、th & userdatabasetsl 、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 adod
22、b、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 c
23、onn=nothing / 如何让用户自行输入方程式,并计算其结果？假设我们要让使用者在“方程式”栏位中自由输入方程式,然后利用方程式进行计算,则引用精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 5 页，共 19 页 - - - - - - - - - - VB精典实用源代码 ( 详细 ) ScriptControl 控件可以很方便地做到。( ScriptControl 控 件 附 属 于VB 6 、 0, 如 果 安 装 后 没 有 瞧 到 此 一 控 件 ,可 在 光 盘 的CommonToolsV
24、BScript 目录底下找此一控件, 其、文件名为 Msscript 、ocx。) 假设放在窗体上的 ScriptControl 控件名称为ScriptControl1,则在“计算”按钮的Click 事件中编写如下代码: Dim Statement As String Statement = X= + Text1、Text + vbCrLf + _ Y= + Text2 、Text + vbCrLf + _ MsgBox 计算结果 = & Y ScriptControl1 、ExecuteStatement( Statement / 如何让一个App 永远保持在最上层( Always on T
25、op ) 请在声明区中加入以下声明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
26、 = -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 / 我要如何在程序中开启网页？在声明区中声明如下(在 、bas 档中用Public, 在 Form 中用Private) Private Declare F
27、unction ShellExecute Lib shell32、 dll Alias ShellExecuteA (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lp String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 在程序中Intranet: ShellExecute Me、hWnd, open, 主机 /目录 , , , 5 Internet: ShellExecute Me、h
28、Wnd, open, , , , 5 / 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 Long Private De
29、clare Function SetWindowRgn Lib user32 (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Private Sub Form_Load() Dim lReturn As Long Me、Show lReturn = SetWindowRgn(hWnd, CreateEllipticRgn(10, 10, 340, 150), True) 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - -
30、- - -第 6 页，共 19 页 - - - - - - - - - - VB精典实用源代码 ( 详细 ) End Sub 执行结果图片CreateEllipticRgn 之四个参数说明如下: X1:椭圆中心点之X 轴位置 ,但以 Form 的实边界为限。Y1:椭圆中心点之Y轴位置 ,但以 Form 的实边界为限。X2:椭圆长边的长度Y2:椭圆短边的长度的/ 如何移除Form 右上方之 X按钮？其实Form 右上方之三个按钮分别对应到Form 左上方控制盒(ControlBox) 中的几个选项(缩到最小/ 放到最大/ 关闭 ),而其中的最大化(MaxButton) 及最小化(Minbutto
31、n) 都可以直接在Form 的属性中设定 ,但就是VB 并没有提供设定 X按钮的功能！ 要达到这个功能,必须借助API: 由于 X按钮对应到ControlBox 的关闭选项,所以我们只要移除系统Menu (就就是ControlBox) 的关闭选项即可！您自己可以先瞧瞧您现在使用的Browser 左上方的系统Menu,【关闭】选项就是在第几个,不就是第6 个！就是第7 个 ,分隔线也算一个！分隔线才就是第6 个！当我们移除了关闭选项之後,会留下一条很奇怪的分隔线,所以最好连分隔线也一并移除。而Menu 的 Index 就是从0 开始 ,分隔线就是第6 个,所以Index = 5。修正 :为了让程
32、序码在Windows NT 也能运作正常,将各Integer 型态改成Long。 89、05、04 抓取系统Menu 的 hwnd Private Declare Function GetSystemMenu Lib user32 Alias GetSystemMenu (ByVal hwnd As Long, ByVal bRevert As Long) As Long 移除系统Menu 的 API Private Declare Function RemoveMenu Lib user32 Alias RemoveMenu (ByVal hMenu As Long, ByVal nPosi
33、tion As Long, ByVal wFlags As Long) As Long 第一个参数就是系统Menu 的 hwnd 第二个参数就是要移除选项的Index / 如何制作透明的表单(Form)？请在声明区中放入以下声明Const GWL_EXSTYLE = (-20) Const WS_EX_TRANSPARENT = &H20& Const SWP_FRAMECHANGED = &H20 Const SWP_NOMOVE = &H2 Const SWP_NOSIZE = &H1 Const SWP_SHOWME = SWP_FRAMECHANGED Or SWP_NOMOVE Or
34、 SWP_NOSIZE Const HWND_NOTOPMOST = -2 Private Declare Function SetWindowLong Lib user32 Alias SetWindowLongA (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetWindowPos Lib user32 (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Lon
35、g, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 7 页，共 19 页 - - - - - - - - - - VB精典实用源代码 ( 详细 ) 在 Form_Load 使用的范例如下: Private Sub Form_Load() SetWindowLong Me 、hwnd, GWL_EXSTYLE, WS_EX_TRANSPARE
36、NT SetWindowPos Me 、hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME Me、Refresh End Sub / 如何在Menu 中加入 MM 的图案？在模组中加入以下程序码: Declare Function GetMenu Lib user32 (ByVal hwnd As Long) As Long Declare Function GetSubMenu Lib user32 (ByVal hMenu As Long, ByVal nPos As Long) As Long Declare Function GetMenu
37、ItemID Lib user32 (ByVal hMenu As Long, ByVal nPos As Long) As Long Declare 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 Long Public Const MF_BITMAP = &H4& Type MENUITEMINF
38、O cbSize As Long fMask As Long fType As Long fState As Long wID As Long hSubMenu As Long hbmpChecked As Long hbmpUnchecked As Long dwItemData As Long dwTypeData As String cch As Long End Type Declare Function GetMenuItemCount Lib user32 (ByVal hMenu As Long) As Long Declare Function GetMenuItemInfo
39、Lib user32 Alias GetMenuItemInfoA (ByVal hMenu As Long, ByVal un As Long, _ ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean Public Const MIIM_ID = &H2 Public Const MIIM_TYPE = &H10 Public Const MFT_STRING = &H0& 在 Form 中加入一个PictureBox,属性设定为 : AutoSize = True Picture = 、bmp (尺寸大小为13x13
40、,不可设定为、ico) 在 Form_Load 中的程序码如下: Private Sub Form_Load() 取得程序中Mennu 的 handle hMenu& = GetMenu(Form1 、hWnd) 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 8 页，共 19 页 - - - - - - - - - - VB精典实用源代码 ( 详细 ) 取得第一个submenu 的 handle hSubMenu& = GetSubMenu(hMenu&, 0) 取得Submenu 第一个选项的menu
41、Id hID& = GetMenuItemID(hSubMenu&, 0) 加入图片SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP , Picture1、 Picture, Picture1、Picture 在一个Menu 选项中您一共可以加入二张图片一张就是checked 状态用 ,一张就是unchecked 状态用End Sub 89、如何把小图片填满Form 成为背景图？对于这个问题 ,我瞧过很多方法,有的方法很麻烦,要声明一大堆Type,用一大堆的API,但就是有一个最笨但我认为最好的方法如下: (就好像拼磁砖一样,不用任何API, 不必声明任何T
42、ype) 在 Form 中放一个PictureBox,Picture 属性设定为某一张小图,AutoSize 属性性设定True,完成的模组如下 : Sub PictureTile(Frm As Form, Pic As PictureBox) Dim i As Integer Dim t As Integer Frm、AutoRedraw = True Pic、BorderStyle = 0 For t = 0 To Frm、Height Step Pic、ScaleHeight For i = 0 To Frm、Width Step Pic、ScaleWidth Frm、PaintPict
43、ure Pic、Picture, i, t Next i Next t End Sub PictureTile 这个模组共有二个参数,第一个就是表单名称,第二个则就是PictureBox 的名称。以下为一应用实例: Private Sub Form_Load() PictureTile Me, Picture1 End Sub 90、如何把小图片填满MDIForm 成为背景图？以下这个范例 ,要: 1、一个MDIForm: 不必设定任何属性。2、一个Form1:不一定就是MDIChild, 最好MDIChild 为False,但就是AutoRedraw 设成True。3、Form1 上面放一个
44、隐藏的PictureBox:名称为Picture1,不必设定Picture 属性。4、一张图片的完整路径。将以下模组放入MDIForm 的声明区中 : Sub TileMDIBkgd(MDIForm As Form, bkgdtiler As Form, bkgd String) If bkgdfile = Then Exit Sub Dim ScWidth%, ScHeight% ScWidth% = Screen、Width / Screen 、TwipsPerPixelX ScHeight% = Screen 、 Height / Screen、TwipsPerPixelY 精品资料 -
45、 - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 9 页，共 19 页 - - - - - - - - - - VB精典实用源代码 ( 详细 ) Load bkgdtiler bkgdtiler 、Height = Screen、Height bkgdtiler 、Width = Screen 、Width bkgdtiler 、ScaleMode = 3 bkgdtiler!Picture1 、Top = 0 bkgdtiler!Picture1 、Left = 0 bkgdtiler!Picture1 、Pictu
46、re = LoadPicture(bkgdfile) bkgdtiler!Picture1 、ScaleMode = 3 For n% = 0 To ScHeight% Step bkgdtiler!Picture1、ScaleHeight For o% = 0 To ScWidth% Step bkgdtiler!Picture1、 ScaleWidth bkgdtiler 、PaintPicture bkgdtiler!Picture1 、Picture, o%, n% Next o% Next n% MDIForm、Picture = bkgdtiler 、 Image Unload b
47、kgdtiler End Sub 以下为一应用实例: Private Sub MDIForm_Load() TileMDIBkgd Me, Form1, c:windowsTiles、bmp End Sub / 关闭指定的程序要做到像Task Manager 一样 ,可以关闭指定的程序,方法如下 : 在声明区中放入以下声明:(16 位改成win31 API) Declare Function FindWindow Lib user32 Alias FindWindowA (ByVal lpClassName As String, ByVal lpWindowName As String) As
48、 Long Declare Function PostMessage Lib user32 Alias PostMessageA (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Const WM_CLOSE = &H10 以下之范例示范如何关闭一个视窗标题(Caption) 为 【小算盘】的程序: Dim winHwnd As Long Dim RetVal As Long winHwnd = FindWindow(vbNullString, 小算盘 ) D
49、ebug、Print winHwnd If winHwnd 0 Then RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&) If RetVal = 0 Then MsgBox Error posting message、 End If Else MsgBox 并未开启小算盘程序、 End If / 如何隐藏及再显示鼠标精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 10 页，共 19 页 - - - - - - - - - - VB精典实用源代码 ( 详细 )
50、 很简单 ,只用到了一个ShowCursor API,参数也很简单 ,只有一个bShow,设定值如下 : True:显示鼠标/ False:隐藏鼠标Declare Function ShowCursor Lib user32 Alias ShowCursor (ByVal bShow As Long) As Long / 如何从您的应程序中结束Windows 重开机？很多软件在Setup 完之后都会自动关机重开机,以便让某些设定值可以生效,其实这个功能很简单 ,只要几行指令就可以做到了！关键就就是要使用ExitWindowsEx 这个API,这个API 只有二个参数,第一个参数就是一个Flag