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（標簽）添加一個時鐘控件間隔請根據(jù)實際需要設置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)輔助選項屬性-常規(guī)CallShell(run

5、dll32.exeshell32.dll,Control_RunDLLaccess.cpl,5,9)添加/刪除程序?qū)傩?安裝/卸載CallShell(rundll32.exeshell32.dll,Control_RunDLLAppwiz.cpl,1,9)添加/刪除程序?qū)傩?Windows安裝程序CallShell(rundll32.exeshell32.dll,Control_RunDLLAppwiz.cpl,2,9)添加/刪除程序?qū)傩?啟動盤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屬性-常規(guī)CallShell(rundll32.exes

7、hell32.dll,Control_RunDLLInetcpl.cpl,0,9)Internet屬性-安全CallShell(rundll32.exeshell32.dll,Control_RunDLLInetcpl.cpl,1,9)Internet屬性-內(nèi)容CallShell(rundll32.exeshell32.dll,Control_RunDLLInetcpl.cpl,2,9)Internet屬性-連接CallShell(rundll32.exeshell32.dll,Control_RunDLLInetcpl.cpl,3,9)*怎樣關閉一個程序你可以使用API函數(shù)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*軟件的注冊可用注冊表簡單地保存已用的天數(shù)或次數(shù)次數(shù)限制（如次）如下：PrivateSubForm_Load()DimRemainDayAsLongRemainDay=GetSetting(MyApp,set,times,0)IfRemainDay=30ThenMsgBox試用次數(shù)已滿，請注冊UnloadMeEndIfMsgBox現(xiàn)在剩下：&30-RemainDay&試用次數(shù)，好好珍惜！RemainDay=RemainDay+1SaveSettingMyApp,set,times,RemainDayEndSub時間限制的（如天）PrivateSubFo

12、rm_Load()DimRemainDayAsLongRemainDay=GetSetting(MyApp,set,day,0)IfRemainDay=30ThenMsgBox試用期已過，請注冊UnloadMeEndIfMsgBox現(xiàn)在剩下：&30-RemainDay&試用天數(shù)，好好珍惜！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*通用對話框?qū)］嫞ㄈ┦褂肁PI調(diào)用Winodws各種通用對話框(CommonDiaglog)的方法（一）1.文件屬性對話框TypeSHELLEXECUTEINFOcbSizeAsLongfMaskAsLonghwndAsLonglpVerbAsStringlpFileAsStringlpParametersAsStringlpDirectoryAsStringnShowAsLonghInstAppAsLonglpIDListAsLong可選參數(shù)lpClassAsString可選參數(shù)hkeyClassAsLong可選參數(shù)dwHotKeyAsLo

24、ng可選參數(shù)hIconAsLong可選參數(shù)hProcessAsLong可選參數(shù)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.調(diào)用捕獲打印機端口對話框PrivateDeclareFunctionWNetConnectionDialogLibmpr.dll_(ByValhwndAsLong,ByValdwTypeAsLong)AsLong示例:DimxAsLongx=WNetConnectionDi

28、alog(Me.hwnd,2)3.調(diào)用顏色對話框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.調(diào)用復制磁盤對話框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.調(diào)用格式化軟盤對話框PrivateDeclareFunctionSHFormatDriveLibshell32(ByValhwndAsLong,ByValDriveAsLong,ByValfmtIDAsLong,ByValoptionsAsLong)AsLongPrivateDeclareFunctionGetDriveTypeLibkernel32AliasGetDriveTypeA(ByValnDriveAsString)AsLong參數(shù)設置: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只復制系統(tǒng)文件3只復制系統(tǒng)文件4快速5完全6只復制系統(tǒng)文件7只復制系統(tǒng)文件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調(diào)用Winodws各種通用對話框(CommonDiaglog)的方法（二）1.選擇目錄/文件夾對話框?qū)⒁韵麓a置于一模塊中OptionExplicit調(diào)用方式: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調(diào)用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.調(diào)用映射網(wǎng)絡驅(qū)動器對話框Private/PublicDeclareFunctionWNetConnectionDialogLibmpr.dll_(ByValhwndAsLong,ByValdwTypeAsLong)AsLongx%=WNetConnectionDialog(Me.hwnd,1)3.調(diào)用打開文件對話框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.調(diào)用打印對話框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