vb常用代码大全.pdf

《vb常用代码大全.pdf》由会员分享，可在线阅读，更多相关《vb常用代码大全.pdf（16页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、VBVB 常用代码常用代码移动无标题栏的窗体移动无标题栏的窗体dim m（borderstyle=none)ouseX as integerdim mouseY as integerdim moveX as integerdim moveY as integerdim down as booleanform_mousedown:mousedown 事件down=truemouseX=xmouseY=yform_mouseup：mouseup 事件down=falseform_mousemoveif down=true then moveX=me。leftmouseX+X moveY=me.to

2、p-mouseY+Y me.move moveX,moveYend if*闪烁控件比如要闪烁一个 label(标签)添加一个时钟控件 间隔请根据实际需要设置 enabled 属性设为 true代码为：label1.visible=not label1.visible*禁止使用 Alt+F4 关闭窗口Private Declare Function DeleteMenu Lib”user32（ByVal hMenu As Long,ByValnPosition As Long，ByVal wFlags As Long）As LongPrivate Declare Function GetMenu

3、ItemCount Lib”user32”(ByVal hMenu As Long)As LongPrivate Const MF_BYPOSITION=H400&Private Sub Form_Load(）Dim hwndMenu As LongDim c As LonghwndMenu=GetSystemMenu(Me。hwnd,0）c=GetMenuItemCount（hwndMenu）-1-DeleteMenu hwndMenu，c-1,MF_BYPOSITIONc=GetMenuItemCount(hwndMenu）DeleteMenu hwndMenu,c-1,MF_BYPOSI

4、TIONEnd Sub启动控制面板大全启动控制面板大全打开控制面板Call Shell（”rundll32.exe shell32。dll,Control_RunDLL,9)辅助选项 属性-键盘Call Shell(”rundll32。exe shell32.dll，Control_RunDLL access.cpl,1,9）辅助选项 属性声音Call Shell（rundll32.exe shell32。dll,Control_RunDLL access。cpl，2”,9）辅助选项 属性显示Call Shell（rundll32.exe shell32.dll,Control_RunDLL

5、access。cpl,3，9）辅助选项 属性鼠标Call Shell（”rundll32。exe shell32.dll，Control_RunDLL access.cpl,，4,9）辅助选项 属性常规Call Shell（rundll32.exe shell32.dll，Control_RunDLL access.cpl，5，9)添加/删除程序 属性安装/卸载Call Shell（rundll32。exe shell32.dll，Control_RunDLL Appwiz。cpl，,1，9）添加/删除程序 属性-Windows 安装程序Call Shell（rundll32.exe shel

6、l32。dll，Control_RunDLL Appwiz。cpl,2”,9）添加/删除程序 属性启动盘Call Shell(”rundll32.exe shell32.dll，Control_RunDLL Appwiz。cpl，3，9）显示 属性-背景Call Shell(”rundll32.exe shell32.dll,Control_RunDLL desk.cpl,，0，9)显示 属性-屏幕保护程序Call Shell(rundll32。exe shell32.dll,Control_RunDLL desk.cpl,，1,9）显示 属性-外观Call Shell（”rundll32.e

7、xe shell32.dll，Control_RunDLL desk.cpl,，2,9)显示 属性设置Call Shell（”rundll32。exe shell32.dll，Control_RunDLL desk.cpl,3,9）Internet 属性-常规Call Shell(”rundll32。exe shell32。dll,Control_RunDLL Inetcpl.cpl,0”,9)Internet 属性安全Call Shell(rundll32.exe shell32。dll，Control_RunDLL Inetcpl。cpl,1”,9)Internet 属性内容Call Sh

8、ell（rundll32。exe shell32.dll,Control_RunDLL Inetcpl.cpl，,2”,9)Internet 属性连接Call Shell（rundll32.exe shell32。dll,Control_RunDLL Inetcpl。cpl，,3，9)*怎样关闭一个程序你可以使用 API 函数 FindWindow 和PostMessage 来寻找一个窗口并且关闭它。下面的范例演示如何关闭一个标题为”Calculator的窗口。Dim winHwnd As LongDim RetVal As LongwinHwnd=FindWindow（vbNullStrin

9、g,”Calculator”）Debug.Print winHwndIf winHwnd 0 ThenRetVal=PostMessage（winHwnd,WM_CLOSE，0&,0&)If RetVal=0 ThenMsgBox”Error posting message。End IfElseMsgBox”The Calculator is not open。End IfFor this code to work，you must have declared the API functions in a module in your project.You must put the foll

10、owing in the declarations section of the module。-2-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,lPa

11、ram As Any)As LongPublic Const WM_CLOSE=&H10*如何使 Form 的背景图随 Form 大小改变单纯显示图形用 Image 即可,而且用Image 也正好可解决你的问题设定 Image 的 Stretch=true在加入以下的 codePrivate Sub Form_Resize（）Image1.Move 0，0,ScaleWidth,ScaleHeightEnd Sub或者使用以下的方式来做也可以Private Sub Form_Paint（）Me。PaintPicture Me。Picture,0，0，ScaleWidth,ScaleHeight

12、End Sub*软件的注册可用注册表简单地保存已用的天数或次数次数限制（如次）如下：Private Sub Form_Load（)Dim RemainDay As LongRemainDay=GetSetting（MyApp,set,times，0)If RemainDay=30 Then MsgBox”试用次数已满，请注册 Unload MeEnd IfMsgBox 现在剩下:&30-RemainDay&”试用次数,好好珍惜！RemainDay=RemainDay+1SaveSetting”MyApp，set”,”times,RemainDayEnd Sub时间限制的(如天）Private

13、Sub Form_Load（）Dim RemainDay As LongRemainDay=GetSetting(”MyApp，set”，”day”,0）If RemainDay=30 Then MsgBox 试用期已过,请注册”Unload MeEnd IfMsgBox”现在剩下:”&30-RemainDay&”试用天数，好好珍惜！if day（now）remainday0 then RemainDay=RemainDay+1SaveSettingMyApp”，set”,times”,RemainDayEnd Sub*MMControl 控件全屏播放Option ExplicitPrivat

14、e Declare Function mciSendString Lib”winmm。dll”_ Alias mciSendStringA”（ByVal lpstrCommand As _ String，ByVal lpstrReturnString As Any,ByVal _ uReturnLength As Long，ByVal hwndCallback As _ Long)As LongPrivate Declare Function mciSendCommand Lib winmm。dll”_ Alias mciSendCommandA”(ByVal wDeviceID As Lon

15、g，_ ByVal uMessage As Long,ByVal dwParam1 As Long，_ dwParam2 As MCI_OVLY_RECT_PAR-3-MS)As LongPrivate Declare Function GetShortPathName Lib”kernel32”_ Alias GetShortPathNameA（ByVal lpszLongPath As _ String，ByVal lpszShortPath As String，ByVal _ cchBuffer As Long）As LongPrivate Type RECT Left As Long

16、Top As Long Right As Long Bottom As LongEnd TypePrivate Type MCI_OVLY_RECT_PARMS dwCallback As Long rc As RECTEnd TypeConst MCI_OVLY_WHERE_SOURCE=H20000Const MCI_OVLY_WHERE_DESTINATION=&H40000Const MCI_WHERE=H843Dim Play As BooleanPrivate Sub Form_Load(）MMControl1。Wait=True MMControl1.UpdateInterval

17、=50 MMControl1.hWndDisplay=Picture1。hWnd Picture1.ScaleMode=3 Timer1。Interval=50End SubPrivate Sub Form_Unload(Cancel As Integer)MMControl1。Command=”stop”MMControl1.Command=closeEnd SubPrivate Sub Command1_Click(）MMControl1。Command=”stop MMControl1。Command=”close”Play=False CommonDialog1。Filter=(”VB

18、-Dateien（*.avi)|*.avi;”)CommonDialog1。InitDir=App.Path CommonDialog1.ShowOpen If CommonDialog1.filename ”Then MMControl1.DeviceType=”avivideo MMControl1.filename=CommonDialog1.filename MMControl1.Command=open”MMControl1。Notify=True Label4。Caption=MMControl1.Length If Check2。Value=vbChecked And Optio

19、n2 Then Call AdaptPicture End If If Option3.Value Then Call Option3_Click Me.Caption=CommonDialog1.filename End IfEnd SubPrivate Sub Command2_Click（）If Not Option3。Value Then If Play=False And MMControl1.filename Then MMControl1。Command=play”Play=True End If Else Call Option3_Click End IfEnd SubPriv

20、ate Sub Command3_Click（)Play=False MMControl1.Command=”stop”End SubPrivate Sub Command4_Click（）-4-MMControl1。Command=pause”End SubPrivate Sub MMControl1_Done（NotifyCode As Integer）If Play And Check1。Value=vbChecked Then Play=False MMControl1。Command=”stop MMControl1。Command=”prev”MMControl1.Command=

21、play Play=True End IfEnd SubPrivate Sub MMControl1_StatusUpdate(）Label2.Caption=MMControl1.PositionEnd SubPrivate Sub Option1_Click()Check1.Enabled=True Check2。Enabled=False MMControl1。hWndDisplay=0End SubPrivate Sub Option2_Click（)Check1。Enabled=True Check2。Enabled=True MMControl1。hWndDisplay=Pictu

22、re1。hWndEnd SubPrivate Sub Option3_Click（）注意这里 Dim R，AA$Check1。Enabled=False Check2.Enabled=False MMControl1.Command=stop Play=False AA=Space$(255)R=GetShortPathName（CommonDialog1.filename,AA,Len（AA)）AA=Mid$(AA,1,R）R=mciSendString（play&AA ”fullscreen,0，0,0&)End SubPrivate Sub Check2_Click（）If Check2

23、。Value=vbChecked And MMControl1。filename ”Then Call AdaptPicture End IfEnd SubPrivate Sub Timer1_Timer（)Dim x%，AA$x=MMControl1。Mode Select Case x Case 524：AA=NotOpen”Case 525:AA=Stop”Case 526：AA=Play Case 527:AA=”Record Case 528:AA=Seek Case 529：AA=Pause Case 530:AA=Ready End Select Label6.Caption=A

24、AEnd SubPrivate Sub AdaptPicture（）Dim Result，Par As MCI_OVLY_RECT_PARMS Par。dwCallback=MMControl1.hWnd Result=mciSendCommand（MMControl1。DeviceID,_ MCI_WHERE,MCI_OVLY_WHERE_SOURCE,Par）If Result 0 Then MsgBox（”Fehler)Else Picture1。Width=(Par.rc.Right-Par。rc.Left）*15+4*15 Picture1.Height=(Par。rc.Bottom

25、-Par.rc。Top)*15+4*15 End If-5-End Sub*通用对话框专辑（全）使用API调用Winodws各种通用对话框（Common Diaglog)的方法（一)1。文件属性对话框Type SHELLEXECUTEINFOcbSize As LongfMask As Longhwnd As LonglpVerb As StringlpFile As StringlpParameters As StringlpDirectory As StringnShow As LonghInstApp As LonglpIDList As Long 可选参数lpClass As Stri

26、ng 可选参数hkeyClass As Long可选参数dwHotKey As Long 可选参数hIcon As Long 可选参数hProcess As Long 可选参数End TypeConst SEE_MASK_INVOKEIDLIST=HCConst SEE_MASK_NOCLOSEPROCESS=H40Const SEE_MASK_FLAG_NO_UI=&H400Declare Function ShellExecuteEX Lib shell32。dll Alias ShellExecuteEx _(SEI As SHELLEXECUTEINFO）As LongPublic F

27、unction ShowProperties（filename As String，OwnerhWnd As Long）As Long打开指定文件的属性对话框,如果返回值=32 则出错Dim SEI As SHELLEXECUTEINFODim r As LongWith SEI.cbSize=Len(SEI）.fMask=SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI。hwnd=OwnerhWnd.lpVerb=”properties”。lpFile=filename。lpParameters=v

28、bNullChar.lpDirectory=vbNullChar。nShow=0。hInstApp=0。lpIDList=0End Withr=ShellExecuteEX（SEI）ShowProperties=SEI。hInstAppEnd Function新建一个工程,添加一个按钮和名为Text1的文本框把以下代码置入CommandbButton_Click 中Dim r As LongDim fname As String从 Text1中获取文件名及路径fname=（Text1）r=ShowProperties(fname,Me.hwnd）If r=32 Then MsgBox”Erro

29、r”2。使用 Win95 的关于对话框Private Declare Function ShellAbout Lib shell32。dll”_Alias”ShellAboutA”（ByVal hwnd As Long，ByVal szApp As String,_ByVal szOtherStuff As String，ByVal hIcon As Long)As Long示例:Dim x As Longx=shellabout（Form1.hwnd，VisualBasic 6。0,_Alp Studio MouseTracker Ver 1。0”，Form1.icon）2。调用捕获打印机端

30、口”对话框Private Declare Function WNetConnectionDialog Lib mpr。dll _(ByVal hwnd As Long,ByVal dwType As Long)As Long示例：-6-Dim x As Longx=WNetConnectionDialog(Me。hwnd，2）3.调用颜色对话框Private Type ChooseColorlStructSize As LonghwndOwner As LonghInstance As LongrgbResult As LonglpCustColors As Stringflags As Lo

31、nglCustData As LonglpfnHook As LonglpTemplateName As StringEnd TypePrivate Declare Function ChooseColor Lib comdlg32.dll Alias ChooseColorA（pChoosecolor As ChooseColor)As Long将以下代码置入某一事件中：Dim cc As ChooseColorDim CustColor(16）As Longcc。lStructSize=Len(cc）cc。hwndOwner=Form1.hWndcc。hInstance=App.hInst

32、ancecc。flags=0cc.lpCustColors=String(16*4,0）Dim aDim xDim c1Dim c2Dim c3Dim c4a=ChooseColor(cc）ClsIf(a)ThenMsgBox”Color chosen：Str(cc。rgbResult)For x=1 To Len（cc.lpCustColors)Step 4c1=Asc（Mid(cc.lpCustColors，x，1)）c2=Asc（Mid（cc。lpCustColors,x+1，1)c3=Asc(Mid$（cc.lpCustColors,x+2，1）)c4=Asc(Mid(cc。lpCus

33、tColors,x+3,1）)ByVal options As Long）As LongCustColor(x/4）=(c1）+(c2 256）+(c3 65536）+(c4*16777216）MsgBox”Custom Color Int(x/4)”=&CustColor（x/4）Next xElseMsgBox Cancel was pressedEnd If4。调用复制磁盘对话框Private Declare Function SHFormatDriveLib shell32（ByVal hwnd As Long，ByVal Drive As Long,ByVal fmtID As Lo

34、ng，ByVal options As Long)As LongPrivate Declare Function GetDriveType Lib”kernel32”Alias”GetDriveTypeA（ByVal nDrive As String)As Long示例:向窗体中添加一个名为 Drive1 的DriveListBox,将以下代码置入某一事件中Dim DriveLetter，DriveNumber&,DriveTypeDim RetVal，RetFromMsgDriveLetter=UCase(Drive1。Drive）DriveNumber=(Asc(DriveLetter）6

35、5）DriveType=GetDriveType（DriveLetter）If DriveType=2 ThenFloppies,etcRetVal=Shell(”rundll32。exe diskcopy.dll,DiskCopyRunDll _&DriveNumber ，DriveNumber,1）Notice space afterElse Just in case DiskCopyRunDllRetFromMsg=MsgBox(”Only floppies can”&vbCrLf&_”be diskcopied!,64，DiskCopy Example”）End If5.调用格式化软盘

36、对话框Private Declare Function SHFormatDriveLib shell32”(ByVal hwnd As Long，ByVal Drive As Long，ByVal fmtID As Long，-7-Private Declare Function GetDriveType Lib”kernel32”Alias GetDriveTypeA（ByVal nDrive As String）As Long参数设置:fmtID-3。5”5。25”-0 1.44M 1.2M1 1.44M 1.2M2 1。44M 1.2M3 1.44M 360K4 1.44M 1.2M5

37、720K 1.2M6 1。44M 1。2M7 1。44M 1.2M8 1。44M 1。2M9 1。44M 1。2M选项0 快速1 完全2 只复制系统文件3 只复制系统文件4 快速5 完全6 只复制系统文件7 只复制系统文件8 快速9 完全示例:要求同上Dim DriveLetter$,DriveNumber,DriveTypeDim RetVal，RetFromMsg%DriveLetter=UCase(Drive1。Drive)DriveNumber=(Asc（DriveLetter）-65)Change letter to Number:A=0DriveType=GetDriveType（

38、DriveLetter）If DriveType=2 ThenFloppies,etcRetVal=SHFormatDrive(Me.hwnd，DriveNumber，0,0&)ElseRetFromMsg=MsgBox(”This drive is NOT a removeable vbCrLf _drive！Format this drive?，276，”SHFormatDrive Example）Select Case RetFromMsgCase 6 Yes UnComment to do it.。.RetVal=SHFormatDrive（Me。hwnd，DriveNumber,0&

39、，0&)Case 7 No Do nothingEnd SelectEnd If*使用API调用Winodws 各种通用对话框（Common Diaglog)的方法(二）1。选择目录/文件夹对话框将以下代码置于一模块中Option Explicit调用方式:string=BrowseForFolders(Hwnd，TitleOfDialog）例如:String1=BrowseForFolders（Hwnd，Select target folder.。)Public Type BrowseInfohwndOwner As LongpIDLRoot As LongpszDisplayName As

40、 LonglpszTitle As LongulFlags As LonglpfnCallback As LonglParam As LongiImage As LongEnd TypePublic Const BIF_RETURNONLYFSDIRS=1Public Const MAX_PATH=260Public Declare Sub CoTaskMemFree Lib ole32。dll（ByVal hMem As Long)Public Declare Function lstrcat Lib”kernel32”Alias lstrcatA”（ByVal lpString1 AsSt

41、ring,ByVal lpString2 As String)As LongPublic Declare Function SHBrowseForFolder Lib shell32”(lpbi As BrowseInfo）As Long-8-Public Declare Function SHGetPathFromIDList Lib shell32(ByVal pidList As Long，ByVal lpBuffer As String）As LongPublic Function BrowseForFolder(hwndOwner As Long,sPrompt As String)

42、As StringDim iNull As IntegerDim lpIDList As LongDim lResult As LongDim sPath As StringDim udtBI As BrowseInfo初始化变量With udtBI。hwndOwner=hwndOwner。lpszTitle=lstrcat（sPrompt，”）。ulFlags=BIF_RETURNONLYFSDIRSEnd With调用 APIlpIDList=SHBrowseForFolder(udtBI）If lpIDList ThensPath=String（MAX_PATH，0）lResult=SH

43、GetPathFromIDList(lpIDList,sPath)Call CoTaskMemFree(lpIDList）iNull=InStr(sPath，vbNullChar)If iNull Then sPath=Left（sPath,iNull-1）End If如果选择取消,sPath=”BrowseForFolder=sPathEnd Function2。调用”映射网络驱动器”对话框Private/Public Declare Function WNetConnectionDialog Lib mpr.dll _（ByVal hwnd As Long,ByVal dwType AsL

44、ong）As Longx%=WNetConnectionDialog（Me。hwnd，1）3。调用”打开文件”对话框Private Type OPENFILENAMElStructSize As LonghwndOwner As LonghInstance As LonglpstrFilter As StringlpstrCustomFilter As StringnMaxCustFilter As LongnFilterIndex As LonglpstrFile As StringnMaxFile As LonglpstrFileTitle As StringnMaxFileTitle A

45、s LonglpstrInitialDir As StringlpstrTitle As Stringflags As LongnFileOffset As IntegernFileExtension As IntegerlpstrDefExt As StringlCustData As LonglpfnHook As LonglpTemplateName As StringEnd TypePrivate Declare Function GetOpenFileName Lib comdlg32.dll Alias”GetOpenFileNameA(pOpenfilename As OPENF

46、ILENAME)As Long将以下代码置于某一事件中Dim ofn As OPENFILENAMEofn.lStructSize=Len(ofn）ofn。hwndOwner=Form1。hWndofn。hInstance=App。hInstanceofn.lpstrFilter=”Text Files（*。txt)”+Chr$（0)+*。txt+Chr(0)+Rich Text Files（*。rtf)+Chr(0）+”。rtf”+Chr$（0）ofn.lpstrFile=Space$（254)ofn.nMaxFile=255ofn.lpstrFileTitle=Space(254)ofn。

47、nMaxFileTitle=255ofn。lpstrInitialDir=curdirofn.lpstrTitle=Our File Open Titleofn。flags=0Dim aa=GetOpenFileName(ofn)If(a)ThenMsgBox File to Open：+Trim$(ofn。lpstrFile)ElseMsgBox”Cancel was pressedEnd If-9-4.调用”打印”对话框Private Type PrintDlglStructSize As LonghwndOwner As LonghDevMode As LonghDevNames As

48、Longhdc As Longflags As LongnFromPage As IntegernToPage As IntegernMinPage As IntegernMaxPage As IntegernCopies As IntegerhInstance As LonglCustData As LonglpfnPrintHook As LonglpfnSetupHook As LonglpPrintTemplateName As StringlpSetupTemplateName As StringhPrintTemplate As LonghSetupTemplate As Long

49、End TypePrivate Declare Function PrintDlg Lib comdlg32。dll Alias PrintDlgA（pPrintdlg As PrintDlg)As Long将以下代码置于某一事件中Dim tPrintDlg As PrintDlgtPrintDlg。lStructSize=Len(tPrintDlg)tPrintDlg.hwndOwner=Me。hwndtPrintDlg.hdc=hdctPrintDlg.flags=0tPrintDlg.nFromPage=0tPrintDlg.nToPage=0tPrintDlg.nMinPage=0tP

50、rintDlg。nMaxPage=0tPrintDlg.nCopies=1tPrintDlg。hInstance=App.hInstancelpPrintTemplateName=Print PageDim aa=PrintDlg（tPrintDlg）If a ThenlFromPage=tPrintDlg。nFromPagelToPage=tPrintDlg。nToPagelMin=tPrintDlg.nMinPagelMax=tPrintDlg.nMaxPagelCopies=tPrintDlg。nCopiesPrintMyPageCustom printing SubroutineEnd