vb常用代码大全

1、VB常用代码移动无标题栏的窗体dimm(borderstyle=none)ouseXasintegerdimmouseYasintegerdimmoveXasintegerdimmoveYasintegerdimdownasbooleanform_mousedown:mousedown事件down=truemouseX=xmouseY=yform_mouseup:mouseup事件down=falseform_mousemoveifdown=truethenmoveX=me.left-mouseX+XmoveY=me.top-mouseY+Yme.movemoveX,moveYendif*闪烁

2、控件比如要闪烁一个label（标签）添加一个时钟控件间隔请根据实际需要设置enabled属性设为true代码为：label1.visible=notlabel1.visible*禁止使用Alt+F4关闭窗口PrivateDeclareFunctionDeleteMenuLibuser32(ByValhMenuAsLong,ByValnPositionAsLong,ByValwFlagsAsLong)AsLongPrivateDeclareFunctionGetMenuItemCountLibuser32(ByValhMenuAsLong)AsLongPrivateConstMF_BYPOSIT

3、ION=&H400&PrivateSubForm_Load()DimhwndMenuAsLongDimcAsLonghwndMenu=GetSystemMenu(Me.hwnd,0)c=GetMenuItemCount(hwndMenu)DeleteMenuhwndMenu,c-1,MF_BYPOSITIONc=GetMenuItemCount(hwndMenu)DeleteMenuhwndMenu,c-1,MF_BYPOSITIONEndSub启动控制面板大全打开控制面板CallShell(rundll32.exeshell32.dll,Control_RunDLL,9)辅助选项属性-键盘C

4、allShell(rundll32.exeshell32.dll,Control_RunDLLaccess.cpl,1,9)辅助选项属性-声音CallShell(rundll32.exeshell32.dll,Control_RunDLLaccess.cpl,2,9)辅助选项属性-显示CallShell(rundll32.exeshell32.dll,Control_RunDLLaccess.cpl,3,9)辅助选项属性-鼠标CallShell(rundll32.exeshell32.dll,Control_RunDLLaccess.cpl,4,9)辅助选项属性-常规CallShell(run

5、dll32.exeshell32.dll,Control_RunDLLaccess.cpl,5,9)添加/删除程序属性-安装/卸载CallShell(rundll32.exeshell32.dll,Control_RunDLLAppwiz.cpl,1,9)添加/删除程序属性-Windows安装程序CallShell(rundll32.exeshell32.dll,Control_RunDLLAppwiz.cpl,2,9)添加/删除程序属性-启动盘CallShell(rundll32.exeshell32.dll,Control_RunDLLAppwiz.cpl,3,9)显示属性-背景CallS

6、hell(rundll32.exeshell32.dll,Control_RunDLLdesk.cpl,0,9)显示属性-屏幕保护程序CallShell(rundll32.exeshell32.dll,Control_RunDLLdesk.cpl,1,9)显示属性-外观CallShell(rundll32.exeshell32.dll,Control_RunDLLdesk.cpl,2,9)显示属性-设置CallShell(rundll32.exeshell32.dll,Control_RunDLLdesk.cpl,3,9)Internet属性-常规CallShell(rundll32.exes

7、hell32.dll,Control_RunDLLInetcpl.cpl,0,9)Internet属性-安全CallShell(rundll32.exeshell32.dll,Control_RunDLLInetcpl.cpl,1,9)Internet属性-内容CallShell(rundll32.exeshell32.dll,Control_RunDLLInetcpl.cpl,2,9)Internet属性-连接CallShell(rundll32.exeshell32.dll,Control_RunDLLInetcpl.cpl,3,9)*怎样关闭一个程序你可以使用API函数FindWindo

8、w和PostMessage来寻找一个窗口并且关闭它。下面的范例演示如何关闭一个标题为Calculator的窗口。DimwinHwndAsLongDimRetValAsLongwinHwnd=FindWindow(vbNullString,Calculator)Debug.PrintwinHwndIfwinHwnd0ThenRetVal=PostMessage(winHwnd,WM_CLOSE,0&,0&)IfRetVal=0ThenMsgBoxErrorpostingmessage.EndIfElseMsgBoxTheCalculatorisnotopen.EndIfForthiscodeto

9、work,youmusthavedeclaredtheAPIfunctionsinamoduleinyourproject.Youmustputthefollowinginthedeclarationssectionofthemodule.DeclareFunctionFindWindowLibuser32Alias_FindWindowA(ByVallpClassNameAsString,_ByVallpWindowNameAsString)AsLongDeclareFunctionPostMessageLibuser32Alias_PostMessageA(ByValhwndAsLong,

10、ByValwMsgAsLong,_ByValwParamAsLong,lParamAsAny)AsLongPublicConstWM_CLOSE=&H10*如何使Form的背景图随Form大小改变单纯显示图形用Image即可,而且用Image也正好可解决你的问题设定Image的Stretch=true在加入以下的codePrivateSubForm_Resize()Image1.Move0,0,ScaleWidth,ScaleHeightEndSub或者使用以下的方式来做也可以PrivateSubForm_Paint()Me.PaintPictureMe.Picture,0,0,ScaleWi

11、dth,ScaleHeightEndSub*软件的注册可用注册表简单地保存已用的天数或次数次数限制（如次）如下：PrivateSubForm_Load()DimRemainDayAsLongRemainDay=GetSetting(MyApp,set,times,0)IfRemainDay=30ThenMsgBox试用次数已满，请注册UnloadMeEndIfMsgBox现在剩下：&30-RemainDay&试用次数，好好珍惜！RemainDay=RemainDay+1SaveSettingMyApp,set,times,RemainDayEndSub时间限制的（如天）PrivateSubFo

12、rm_Load()DimRemainDayAsLongRemainDay=GetSetting(MyApp,set,day,0)IfRemainDay=30ThenMsgBox试用期已过，请注册UnloadMeEndIfMsgBox现在剩下：&30-RemainDay&试用天数，好好珍惜！ifday(now)-remainday0thenRemainDay=RemainDay+1SaveSettingMyApp,set,times,RemainDayEndSub*MMControl控件全屏播放OptionExplicitPrivateDeclareFunctionmciSendStringLi

13、bwinmm.dll_AliasmciSendStringA(ByVallpstrCommandAs_String,ByVallpstrReturnStringAsAny,ByVal_uReturnLengthAsLong,ByValhwndCallbackAs_Long)AsLongPrivateDeclareFunctionmciSendCommandLibwinmm.dll_AliasmciSendCommandA(ByValwDeviceIDAsLong,_ByValuMessageAsLong,ByValdwParam1AsLong,_dwParam2AsMCI_OVLY_RECT_

14、PARMS)AsLongPrivateDeclareFunctionGetShortPathNameLibkernel32_AliasGetShortPathNameA(ByVallpszLongPathAs_String,ByVallpszShortPathAsString,ByVal_cchBufferAsLong)AsLongPrivateTypeRECTLeftAsLongTopAsLongRightAsLongBottomAsLongEndTypePrivateTypeMCI_OVLY_RECT_PARMSdwCallbackAsLongrcAsRECTEndTypeConstMCI

15、_OVLY_WHERE_SOURCE=&H20000ConstMCI_OVLY_WHERE_DESTINATION=&H40000ConstMCI_WHERE=&H843DimPlayAsBooleanPrivateSubForm_Load()MMControl1.Wait=TrueMMControl1.UpdateInterval=50MMControl1.hWndDisplay=Picture1.hWndPicture1.ScaleMode=3Timer1.Interval=50EndSubPrivateSubForm_Unload(CancelAsInteger)MMControl1.C

16、ommand=stopMMControl1.Command=closeEndSubPrivateSubCommand1_Click()MMControl1.Command=stopMMControl1.Command=closePlay=FalseCommonDialog1.Filter=(VB-Dateien(*.avi)|*.avi;)CommonDialog1.InitDir=App.PathCommonDialog1.ShowOpenIfCommonDialog1.filenameThenMMControl1.DeviceType=avivideoMMControl1.filename

17、=CommonDialog1.filenameMMControl1.Command=openMMControl1.Notify=TrueLabel4.Caption=MMControl1.LengthIfCheck2.Value=vbCheckedAndOption2ThenCallAdaptPictureEndIfIfOption3.ValueThenCallOption3_ClickMe.Caption=CommonDialog1.filenameEndIfEndSubPrivateSubCommand2_Click()IfNotOption3.ValueThenIfPlay=FalseA

18、ndMMControl1.filenameThenMMControl1.Command=playPlay=TrueEndIfElseCallOption3_ClickEndIfEndSubPrivateSubCommand3_Click()Play=FalseMMControl1.Command=stopEndSubPrivateSubCommand4_Click()MMControl1.Command=pauseEndSubPrivateSubMMControl1_Done(NotifyCodeAsInteger)IfPlayAndCheck1.Value=vbCheckedThenPlay

19、=FalseMMControl1.Command=stopMMControl1.Command=prevMMControl1.Command=playPlay=TrueEndIfEndSubPrivateSubMMControl1_StatusUpdate()Label2.Caption=MMControl1.PositionEndSubPrivateSubOption1_Click()Check1.Enabled=TrueCheck2.Enabled=FalseMMControl1.hWndDisplay=0EndSubPrivateSubOption2_Click()Check1.Enab

20、led=TrueCheck2.Enabled=TrueMMControl1.hWndDisplay=Picture1.hWndEndSubPrivateSubOption3_Click()注意这里DimR&,AA$Check1.Enabled=FalseCheck2.Enabled=FalseMMControl1.Command=stopPlay=FalseAA=Space$(255)R=GetShortPathName(CommonDialog1.filename,AA,Len(AA)AA=Mid$(AA,1,R)R=mciSendString(play&AA&fullscreen,0&,0

21、,0&)EndSubPrivateSubCheck2_Click()IfCheck2.Value=vbCheckedAndMMControl1.filenameThenCallAdaptPictureEndIfEndSubPrivateSubTimer1_Timer()Dimx%,AA$x=MMControl1.ModeSelectCasexCase524:AA=NotOpenCase525:AA=StopCase526:AA=PlayCase527:AA=RecordCase528:AA=SeekCase529:AA=PauseCase530:AA=ReadyEndSelectLabel6.

22、Caption=AAEndSubPrivateSubAdaptPicture()DimResult&,ParAsMCI_OVLY_RECT_PARMSPar.dwCallback=MMControl1.hWndResult=mciSendCommand(MMControl1.DeviceID,_MCI_WHERE,MCI_OVLY_WHERE_SOURCE,Par)IfResult0ThenMsgBox(Fehler)ElsePicture1.Width=(Par.rc.Right-Par.rc.Left)*15+4*15Picture1.Height=(Par.rc.Bottom-Par.r

23、c.Top)*15+4*15EndIfEndSub*通用对话框专辑（全）使用API调用Winodws各种通用对话框(CommonDiaglog)的方法（一）1.文件属性对话框TypeSHELLEXECUTEINFOcbSizeAsLongfMaskAsLonghwndAsLonglpVerbAsStringlpFileAsStringlpParametersAsStringlpDirectoryAsStringnShowAsLonghInstAppAsLonglpIDListAsLong可选参数lpClassAsString可选参数hkeyClassAsLong可选参数dwHotKeyAsLo

24、ng可选参数hIconAsLong可选参数hProcessAsLong可选参数EndTypeConstSEE_MASK_INVOKEIDLIST=&HCConstSEE_MASK_NOCLOSEPROCESS=&H40ConstSEE_MASK_FLAG_NO_UI=&H400DeclareFunctionShellExecuteEXLibshell32.dllAliasShellExecuteEx_(SEIAsSHELLEXECUTEINFO)AsLongPublicFunctionShowProperties(filenameAsString,OwnerhWndAsLong)AsLong打

25、开指定文件的属性对话框,如果返回值=32则出错DimSEIAsSHELLEXECUTEINFODimrAsLongWithSEI.cbSize=Len(SEI).fMask=SEE_MASK_NOCLOSEPROCESSOrSEE_MASK_INVOKEIDLISTOrSEE_MASK_FLAG_NO_UI.hwnd=OwnerhWnd.lpVerb=properties.lpFile=filename.lpParameters=vbNullChar.lpDirectory=vbNullChar.nShow=0.hInstApp=0.lpIDList=0EndWithr=ShellExecut

26、eEX(SEI)ShowProperties=SEI.hInstAppEndFunction新建一个工程,添加一个按钮和名为Text1的文本框把以下代码置入CommandbButton_Click中DimrAsLongDimfnameAsString从Text1中获取文件名及路径fname=(Text1)r=ShowProperties(fname,Me.hwnd)Ifr=32ThenMsgBoxError2.使用Win95的关于对话框PrivateDeclareFunctionShellAboutLibshell32.dll_AliasShellAboutA(ByValhwndAsLong,

27、ByValszAppAsString,_ByValszOtherStuffAsString,ByValhIconAsLong)AsLong示例:DimxAsLongx=shellabout(Form1.hwnd,VisualBasic6.0,_AlpStudioMouseTrackerVer1.0,Form1.icon)2.调用捕获打印机端口对话框PrivateDeclareFunctionWNetConnectionDialogLibmpr.dll_(ByValhwndAsLong,ByValdwTypeAsLong)AsLong示例:DimxAsLongx=WNetConnectionDi

28、alog(Me.hwnd,2)3.调用颜色对话框PrivateTypeChooseColorlStructSizeAsLonghwndOwnerAsLonghInstanceAsLongrgbResultAsLonglpCustColorsAsStringflagsAsLonglCustDataAsLonglpfnHookAsLonglpTemplateNameAsStringEndTypePrivateDeclareFunctionChooseColorLibcomdlg32.dllAliasChooseColorA(pChoosecolorAsChooseColor)AsLong将以下代码

29、置入某一事件中:DimccAsChooseColorDimCustColor(16)AsLongcc.lStructSize=Len(cc)cc.hwndOwner=Form1.hWndcc.hInstance=App.hInstancecc.flags=0cc.lpCustColors=String$(16*4,0)DimaDimxDimc1Dimc2Dimc3Dimc4a=ChooseColor(cc)ClsIf(a)ThenMsgBoxColorchosen:&Str$(cc.rgbResult)Forx=1ToLen(cc.lpCustColors)Step4c1=Asc(Mid$(c

30、c.lpCustColors,x,1)c2=Asc(Mid$(cc.lpCustColors,x+1,1)c3=Asc(Mid$(cc.lpCustColors,x+2,1)c4=Asc(Mid$(cc.lpCustColors,x+3,1)CustColor(x/4)=(c1)+(c2*256)+(c3*65536)+(c4*16777216)MsgBoxCustomColor&Int(x/4)&=&CustColor(x/4)NextxElseMsgBoxCancelwaspressedEndIf4.调用复制磁盘对话框PrivateDeclareFunctionSHFormatDriveL

31、ibshell32(ByValhwndAsLong,ByValDriveAsLong,ByValfmtIDAsLong,ByValoptionsAsLong)AsLongPrivateDeclareFunctionGetDriveTypeLibkernel32AliasGetDriveTypeA(ByValnDriveAsString)AsLong示例:向窗体中添加一个名为Drive1的DriveListBox,将以下代码置入某一事件中DimDriveLetter$,DriveNumber&,DriveType&DimRetVal&,RetFromMsg&DriveLetter=UCase(D

32、rive1.Drive)DriveNumber=(Asc(DriveLetter)-65)DriveType=GetDriveType(DriveLetter)IfDriveType=2ThenFloppies,etcRetVal=Shell(rundll32.exediskcopy.dll,DiskCopyRunDll_&DriveNumber&,&DriveNumber,1)NoticespaceafterElseJustincaseDiskCopyRunDllRetFromMsg=MsgBox(Onlyfloppiescan&vbCrLf&_bediskcopied!,64,DiskCo

33、pyExample)EndIf5.调用格式化软盘对话框PrivateDeclareFunctionSHFormatDriveLibshell32(ByValhwndAsLong,ByValDriveAsLong,ByValfmtIDAsLong,ByValoptionsAsLong)AsLongPrivateDeclareFunctionGetDriveTypeLibkernel32AliasGetDriveTypeA(ByValnDriveAsString)AsLong参数设置:fmtID-3.55.25-01.44M1.2M11.44M1.2M21.44M1.2M31.44M360K41.

34、44M1.2M5720K1.2M61.44M1.2M71.44M1.2M81.44M1.2M91.44M1.2M选项0快速1完全2只复制系统文件3只复制系统文件4快速5完全6只复制系统文件7只复制系统文件8快速9完全示例:要求同上DimDriveLetter$,DriveNumber&,DriveType&DimRetVal&,RetFromMsg%DriveLetter=UCase(Drive1.Drive)DriveNumber=(Asc(DriveLetter)-65)ChangelettertoNumber:A=0DriveType=GetDriveType(DriveLetter)I

35、fDriveType=2ThenFloppies,etcRetVal=SHFormatDrive(Me.hwnd,DriveNumber,0&,0&)ElseRetFromMsg=MsgBox(ThisdriveisNOTaremoveable&vbCrLf&_drive!Formatthisdrive?,276,SHFormatDriveExample)SelectCaseRetFromMsgCase6YesUnCommenttodoit.RetVal=SHFormatDrive(Me.hwnd,DriveNumber,0&,0&)Case7NoDonothingEndSelectEndIf

36、*使用API调用Winodws各种通用对话框(CommonDiaglog)的方法（二）1.选择目录/文件夹对话框将以下代码置于一模块中OptionExplicit调用方式:string=BrowseForFolders(Hwnd,TitleOfDialog)例如:String1=BrowseForFolders(Hwnd,Selecttargetfolder.)PublicTypeBrowseInfohwndOwnerAsLongpIDLRootAsLongpszDisplayNameAsLonglpszTitleAsLongulFlagsAsLonglpfnCallbackAsLonglPa

37、ramAsLongiImageAsLongEndTypePublicConstBIF_RETURNONLYFSDIRS=1PublicConstMAX_PATH=260PublicDeclareSubCoTaskMemFreeLibole32.dll(ByValhMemAsLong)PublicDeclareFunctionlstrcatLibkernel32AliaslstrcatA(ByVallpString1AsString,ByVallpString2AsString)AsLongPublicDeclareFunctionSHBrowseForFolderLibshell32(lpbi

38、AsBrowseInfo)AsLongPublicDeclareFunctionSHGetPathFromIDListLibshell32(ByValpidListAsLong,ByVallpBufferAsString)AsLongPublicFunctionBrowseForFolder(hwndOwnerAsLong,sPromptAsString)AsStringDimiNullAsIntegerDimlpIDListAsLongDimlResultAsLongDimsPathAsStringDimudtBIAsBrowseInfo初始化变量WithudtBI.hwndOwner=hw

39、ndOwner.lpszTitle=lstrcat(sPrompt,).ulFlags=BIF_RETURNONLYFSDIRSEndWith调用APIlpIDList=SHBrowseForFolder(udtBI)IflpIDListThensPath=String$(MAX_PATH,0)lResult=SHGetPathFromIDList(lpIDList,sPath)CallCoTaskMemFree(lpIDList)iNull=InStr(sPath,vbNullChar)IfiNullThensPath=Left$(sPath,iNull-1)EndIf如果选择取消,sPat

40、h=BrowseForFolder=sPathEndFunction2.调用映射网络驱动器对话框Private/PublicDeclareFunctionWNetConnectionDialogLibmpr.dll_(ByValhwndAsLong,ByValdwTypeAsLong)AsLongx%=WNetConnectionDialog(Me.hwnd,1)3.调用打开文件对话框PrivateTypeOPENFILENAMElStructSizeAsLonghwndOwnerAsLonghInstanceAsLonglpstrFilterAsStringlpstrCustomFilter

41、AsStringnMaxCustFilterAsLongnFilterIndexAsLonglpstrFileAsStringnMaxFileAsLonglpstrFileTitleAsStringnMaxFileTitleAsLonglpstrInitialDirAsStringlpstrTitleAsStringflagsAsLongnFileOffsetAsIntegernFileExtensionAsIntegerlpstrDefExtAsStringlCustDataAsLonglpfnHookAsLonglpTemplateNameAsStringEndTypePrivateDec

42、lareFunctionGetOpenFileNameLibcomdlg32.dllAliasGetOpenFileNameA(pOpenfilenameAsOPENFILENAME)AsLong将以下代码置于某一事件中DimofnAsOPENFILENAMEofn.lStructSize=Len(ofn)ofn.hwndOwner=Form1.hWndofn.hInstance=App.hInstanceofn.lpstrFilter=TextFiles(*.txt)+Chr$(0)+*.txt+Chr$(0)+RichTextFiles(*.rtf)+Chr$(0)+*.rtf+Chr$(

43、0)ofn.lpstrFile=Space$(254)ofn.nMaxFile=255ofn.lpstrFileTitle=Space$(254)ofn.nMaxFileTitle=255ofn.lpstrInitialDir=curdirofn.lpstrTitle=OurFileOpenTitleofn.flags=0Dimaa=GetOpenFileName(ofn)If(a)ThenMsgBoxFiletoOpen:+Trim$(ofn.lpstrFile)ElseMsgBoxCancelwaspressedEndIf4.调用打印对话框PrivateTypePrintDlglStruc

44、tSizeAsLonghwndOwnerAsLonghDevModeAsLonghDevNamesAsLonghdcAsLongflagsAsLongnFromPageAsIntegernToPageAsIntegernMinPageAsIntegernMaxPageAsIntegernCopiesAsIntegerhInstanceAsLonglCustDataAsLonglpfnPrintHookAsLonglpfnSetupHookAsLonglpPrintTemplateNameAsStringlpSetupTemplateNameAsStringhPrintTemplateAsLon

45、ghSetupTemplateAsLongEndTypePrivateDeclareFunctionPrintDlgLibcomdlg32.dllAliasPrintDlgA(pPrintdlgAsPrintDlg)AsLong将以下代码置于某一事件中DimtPrintDlgAsPrintDlgtPrintDlg.lStructSize=Len(tPrintDlg)tPrintDlg.hwndOwner=Me.hwndtPrintDlg.hdc=hdctPrintDlg.flags=0tPrintDlg.nFromPage=0tPrintDlg.nToPage=0tPrintDlg.nMinP

46、age=0tPrintDlg.nMaxPage=0tPrintDlg.nCopies=1tPrintDlg.hInstance=App.hInstancelpPrintTemplateName=PrintPageDimaa=PrintDlg(tPrintDlg)IfaThenlFromPage=tPrintDlg.nFromPagelToPage=tPrintDlg.nToPagelMin=tPrintDlg.nMinPagelMax=tPrintDlg.nMaxPagelCopies=tPrintDlg.nCopiesPrintMyPageCustomprintingSubroutineEndIf*用WinSock控件下载文件1增加一个Winsock控件，名称为Winsock1。2建立连接：Winsock1.RemoteHost=Winsock1.RemotePort=80Win