vb常用代碼大全

1、VB常用代碼移動無標題欄的窗體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: 'mouse

2、up事件down=falseform_mousemoveif down=true then   moveX=me.left-mouseX+X   moveY=me.top-mouseY+Y   me.move moveX,moveYend if*閃爍控件比如要閃爍一個label（標簽）添加一個時鐘控件 間隔請根據(jù)實際需要設(shè)置 enabled屬性設(shè)為true代碼為：label1.visible=not label1.visible*禁止使

3、用 Alt+F4 關(guān)閉窗口 Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As LongPrivate Declare Function G

4、etMenuItemCount Lib "user32" (ByVal hMenu As Long) As LongPrivate Const MF_BYPOSITION = &H400& Private Sub Form_Load()Dim hwndMenu As LongDim c As LonghwndMenu = GetSy

5、stemMenu(Me.hwnd, 0)c = GetMenuItemCount(hwndMenu)DeleteMenu hwndMenu, c - 1, MF_BYPOSITIONc = GetMenuItemCount(hwndMenu)DeleteMenu hwndMenu, c - 1, MF_BYPOSITIONEnd Sub啟動控制面板大全'打開控制面板Call Shell("rundll32.e

6、xe 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)'輔助選項

7、0;屬性-顯示Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,3", 9)'輔助選項 屬性-鼠標Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,4", 9)'輔助選項 屬性-常規(guī)Call Shell("rundll32.exe shell32.dll,Con

8、trol_RunDLL access.cpl,5", 9)'添加/刪除程序 屬性-安裝/卸載Call Shell("rundll32.exe shell32.dll,Control_RunDLL Appwiz.cpl,1", 9)'添加/刪除程序 屬性-Windows安裝程序Call Shell("rundll32.exe shell32.dll,Control_RunDLL Appwiz.cpl,2", 9)

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 

10、shell32.dll,Control_RunDLL desk.cpl,1", 9)'顯示 屬性-外觀Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,2", 9)'顯示 屬性-設(shè)置Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,3", 9)'Internet

11、 屬性-常規(guī)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 屬性-內(nèi)容Call Shell("rundll32.exe s

12、hell32.dll,Control_RunDLL Inetcpl.cpl,2", 9)'Internet 屬性-連接Call Shell("rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,3", 9)*怎樣關(guān)閉一個程序你可以使用API函數(shù)FindWindow和PostMessage來尋找一個窗口并且關(guān)閉它。下面的范例演示如何關(guān)閉一個標題為"Calculator"的窗口。Dim winHwnd 

13、;As LongDim RetVal As LongwinHwnd = FindWindow(vbNullString, "Calculator")Debug.Print winHwndIf winHwnd <> 0 ThenRetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)If RetVal = 0

14、60;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 m

15、odule in your project. You must put the following in the declarations section of the module. Declare Function FindWindow Lib "user32" Alias _"FindWindowA" (ByVal

16、0;lpClassName As String, _ByVal lpWindowName As String) As Long Declare Function PostMessage Lib "user32" Alias _"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Lo

17、ng, _ByVal wParam As Long, lParam As Any) As Long Public Const WM_CLOSE = &H10 *如何使Form的背景圖隨Form大小改變 單純顯示圖形用Image即可,而且用Image也正好可解決你的問題設(shè)定Image的Stretch=true在加入以下的codePrivate Sub Form_Resize()Image1.Move 

18、0, 0, ScaleWidth, ScaleHeightEnd Sub或者使用以下的方式來做也可以 Private Sub Form_Paint()Me.PaintPicture Me.Picture, 0, 0, ScaleWidth, ScaleHeightEnd Sub*軟件的注冊可用注冊表簡單地保存已用的天數(shù)或次數(shù)'次數(shù)限制（如次）如下：Private Sub Form_Load()Dim RemainDay 

19、;As LongRemainDay = GetSetting("MyApp", "set", "times", 0)If RemainDay = 30 Then   MsgBox "試用次數(shù)已滿，請注冊"   Unload MeEnd IfMsgBox "現(xiàn)在剩下：" & 

20、;30 - RemainDay & "試用次數(shù)，好好珍惜！"RemainDay = RemainDay + 1SaveSetting "MyApp", "set", "times", RemainDayEnd Sub'時間限制的（如天）Private Sub Form_Load()Dim RemainDay As Long

21、RemainDay = GetSetting("MyApp", "set", "day", 0)If RemainDay = 30 Then    MsgBox "試用期已過，請注冊"    Unload MeEnd IfMsgBox "現(xiàn)在剩下：" & 30&

22、#160;- RemainDay & "試用天數(shù)，好好珍惜！"if day(now)-remainday>0 then RemainDay = RemainDay + 1SaveSetting "MyApp", "set", "times", RemainDayEnd Sub *MMControl控件全屏播放Option Explic

23、itPrivate Declare Function mciSendString Lib "winmm.dll" _        Alias "mciSendStringA" (ByVal lpstrCommand As _        String, ByVal 

24、lpstrReturnString As Any, ByVal _        uReturnLength As Long, ByVal hwndCallback As _        Long) As LongPrivate Declare Function mciSendComma

25、nd Lib "winmm.dll" _        Alias "mciSendCommandA" (ByVal wDeviceID As Long, _        ByVal uMessage As Long, ByVal dwParam1 

26、;As Long, _        dwParam2 As MCI_OVLY_RECT_PARMS) As LongPrivate Declare Function GetShortPathName Lib "kernel32" _        Alias "GetShort

27、PathNameA" (ByVal lpszLongPath As _        String, ByVal lpszShortPath As String, ByVal _        cchBuffer As Long) As LongPrivate Type 

28、;RECT  Left As Long  Top As Long  Right As Long  Bottom As LongEnd TypePrivate Type MCI_OVLY_RECT_PARMS  dwCallback As Long  rc As RECTEnd TypeConst MCI_OV

29、LY_WHERE_SOURCE = &H20000Const MCI_OVLY_WHERE_DESTINATION = &H40000Const MCI_WHERE = &H843Dim Play As BooleanPrivate Sub Form_Load()  MMControl1.Wait = True  MMControl1.UpdateInterval =

30、60;50  MMControl1.hWndDisplay = Picture1.hWnd  Picture1.ScaleMode = 3  Timer1.Interval = 50End SubPrivate Sub Form_Unload(Cancel As Integer)  MMControl1.Command = "stop"  MMCo

31、ntrol1.Command = "close"End SubPrivate Sub Command1_Click()  MMControl1.Command = "stop"  MMControl1.Command = "close"  Play = False    CommonDialog1.Filter =&#

32、160;("VB-Dateien (*.avi)|*.avi;")  CommonDialog1.InitDir = App.Path  CommonDialog1.ShowOpen    If CommonDialog1.filename <> "" Then    MMControl1.DeviceType = "aviv

33、ideo"    MMControl1.filename = CommonDialog1.filename    MMControl1.Command = "open"    MMControl1.Notify = True    Label4.Caption = MMControl1.Length  

34、60; If Check2.Value = vbChecked And Option2 Then      Call AdaptPicture    End If        If Option3.Value Then Call Option3_Click  

35、0; Me.Caption = CommonDialog1.filename  End IfEnd SubPrivate Sub Command2_Click()  If Not Option3.Value Then    If Play = False And MMControl1.filename <> ""&#

36、160;Then      MMControl1.Command = "play"      Play = True    End If  Else    Call Option3_Click  End IfEnd SubPrivate Sub

37、60;Command3_Click()  Play = False  MMControl1.Command = "stop"End SubPrivate Sub Command4_Click()  MMControl1.Command = "pause"End SubPrivate Sub MMControl1_Done(NotifyCode As Inte

38、ger)  If Play And Check1.Value = vbChecked Then    Play = False    MMControl1.Command = "stop"    MMControl1.Command = "prev"    M

39、MControl1.Command = "play"    Play = True  End IfEnd SubPrivate Sub MMControl1_StatusUpdate()  Label2.Caption = MMControl1.PositionEnd SubPrivate Sub Option1_Click()  Check1.E

40、nabled = True  Check2.Enabled = False  MMControl1.hWndDisplay = 0End SubPrivate Sub Option2_Click()  Check1.Enabled = True  Check2.Enabled = True  MMControl1.hWndDisplay = Pic

41、ture1.hWndEnd SubPrivate Sub Option3_Click()注意這里  Dim R&, AA$    Check1.Enabled = False    Check2.Enabled = False    MMControl1.Command = "stop"   

42、; Play = False        AA = Space$(255)    R = GetShortPathName(CommonDialog1.filename, AA, Len(AA)    AA = Mid$(AA, 1, R)    R =&#

43、160;mciSendString("play " & AA & " fullscreen ", 0&, 0, 0&)End SubPrivate Sub Check2_Click()  If Check2.Value = vbChecked And MMControl1.filename <> 

44、;"" Then    Call AdaptPicture  End IfEnd SubPrivate Sub Timer1_Timer()  Dim x%, AA$    x = MMControl1.Mode    Select Case x    

45、60; Case 524: AA = "NotOpen"      Case 525: AA = "Stop"      Case 526: AA = "Play"      Case 527: AA 

46、;= "Record"      Case 528: AA = "Seek"      Case 529: AA = "Pause"      Case 530: AA = "Ready"  

47、;  End Select    Label6.Caption = AAEnd SubPrivate Sub AdaptPicture()  Dim Result&, Par As MCI_OVLY_RECT_PARMS        Par.dwCallback = MMControl1.hWnd 

48、   Result = mciSendCommand(MMControl1.DeviceID, _             MCI_WHERE, MCI_OVLY_WHERE_SOURCE, Par)    If Result <> 0 Then    &#

49、160; MsgBox ("Fehler")    Else      Picture1.Width = (Par.rc.Right - Par.rc.Left) * 15 + 4 * 15      Picture1.Height = (Par.rc.Bottom -

50、 Par.rc.Top) * 15 + 4 * 15    End IfEnd Sub*通用對話框?qū)］嫞ㄈ┦褂肁PI調(diào)用Winodws各種通用對話框(Common Diaglog)的方法（一）1.文件屬性對話框Type SHELLEXECUTEINFOcbSize As LongfMask As Longhwnd As LonglpVerb As StringlpF

51、ile As StringlpParameters As StringlpDirectory As StringnShow As LonghInstApp As LonglpIDList As Long '可選參數(shù)lpClass As String '可選參數(shù)hkeyClass As Long '可選參數(shù)dwHotKey As Long '可選參

52、數(shù)hIcon As Long '可選參數(shù)hProcess As Long '可選參數(shù)End TypeConst SEE_MASK_INVOKEIDLIST = &HCConst SEE_MASK_NOCLOSEPROCESS = &H40Const SEE_MASK_FLAG_NO_UI = &H400Declare Function ShellExecuteEX L

53、ib "shell32.dll" Alias "ShellExecuteEx" _(SEI As SHELLEXECUTEINFO) As LongPublic Function ShowProperties(filename As String, OwnerhWnd As Long) As Long'打開指定文件的屬性對話框,如果返回值<=32則出錯Dim SE

54、I 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 = f

55、ilename.lpParameters = vbNullChar.lpDirectory = vbNullChar.nShow = 0.hInstApp = 0.lpIDList = 0End Withr = ShellExecuteEX(SEI)ShowProperties = SEI.hInstAppEnd Function新建一個工程,添加一個按鈕和名為Text1的文本框把以下代碼置入CommandbButton_Click&#

56、160;中Dim r As LongDim fname As String'從Text1 中獲取文件名及路徑fname = (Text1)r = ShowProperties(fname, Me.hwnd)If r <= 32 Then MsgBox "Error"2.使用Win95的關(guān)于對話框Private Declare Function Shell

57、About 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&

58、#160;Longx = shellabout (Form1.hwnd, "Visual Basic 6.0", _"Alp Studio MouseTracker Ver 1.0", Form1.icon)2.調(diào)用"捕獲打印機端口"對話框Private Declare Function WNetConnectionDialog Lib "mpr.dll&q

59、uot; _(ByVal hwnd As Long, ByVal dwType As Long) As Long示例:Dim x As Longx = WNetConnectionDialog(Me.hwnd, 2)3.調(diào)用顏色對話框Private Type ChooseColorlStructSize As LonghwndOwner As LonghInstance

60、0;As LongrgbResult As LonglpCustColors As Stringflags As LonglCustData As LonglpfnHook As LonglpTemplateName As StringEnd TypePrivate Declare Function ChooseColor Lib "comdlg32.dll" Alias

61、60;"ChooseColorA" (pChoosecolor As ChooseColor) As Long將以下代碼置入某一事件中:Dim cc As ChooseColorDim CustColor(16) As Longcc.lStructSize = Len(cc)cc.hwndOwner = Form1.hWndcc.hInstance = App.hInstancecc.flags 

62、= 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 

63、;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.lpCustColors, x + 3,

64、0;1)CustColor(x / 4) = (c1) + (c2 * 256) + (c3 * 65536) + (c4 * 16777216)MsgBox "Custom Color " & Int(x / 4) & " = " & Cust

65、Color(x / 4)Next xElseMsgBox "Cancel was pressed"End If4.調(diào)用復(fù)制磁盤對話框Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmt

66、ID As Long, ByVal options As Long) As LongPrivate Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long示例:向窗體中添加一個名為Drive1的DriveL

67、istBox,將以下代碼置入某一事件中Dim DriveLetter$, DriveNumber&, DriveType&Dim RetVal&, RetFromMsg&DriveLetter = UCase(Drive1.Drive)DriveNumber = (Asc(DriveLetter) - 65)DriveType = GetDriveType(DriveLetter)If DriveType =

68、60;2 Then 'Floppies, etcRetVal = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll " _& DriveNumber & "," & DriveNumber, 1) 'Notice space afterElse ' Just in&

69、#160;case 'DiskCopyRunDllRetFromMsg = MsgBox("Only floppies can" & vbCrLf & _"be diskcopied!", 64, "DiskCopy Example")End If5.調(diào)用格式化軟盤對話框Private Declare Function SHFormatDriv

70、e Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As LongPrivate Declare Function GetDriveType Lib "kernel32

71、" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long參數(shù)設(shè)置: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 720K 1.2M6 1.44M 1.2

72、M7 1.44M 1.2M8 1.44M 1.2M9 1.44M 1.2M選項0 快速1 完全2 只復(fù)制系統(tǒng)文件 3 只復(fù)制系統(tǒng)文件 4 快速5 完全6 只復(fù)制系統(tǒng)文件 7 只復(fù)制系統(tǒng)文件 8 快速9 完全示例:要求同上Dim DriveLetter$, DriveNumber&, DriveType&Dim RetVal&,

73、0;RetFromMsg%DriveLetter = UCase(Drive1.Drive)DriveNumber = (Asc(DriveLetter) - 65) ' Change letter to Number: A=0DriveType = GetDriveType(DriveLetter)If DriveType = 2 Then 'Floppies, etcRetVa

74、l = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)ElseRetFromMsg = MsgBox("This drive is NOT a removeable" & vbCrLf & _"drive! Format this drive?", 276, "SHF

75、ormatDrive Example")Select Case RetFromMsgCase 6 'Yes' UnComment to do it.'RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)Case 7 'No' Do nothingEnd SelectEnd If*使

76、用API調(diào)用Winodws各種通用對話框(Common Diaglog)的方法（二）1.選擇目錄/文件夾對話框?qū)⒁韵麓a置于一模塊中Option Explicit調(diào)用方式: string = BrowseForFolders(Hwnd,TitleOfDialog)' 例如:String1 = BrowseForFolders(Hwnd, "Select target folder.")Public Type BrowseInfohwndO

77、wner As LongpIDLRoot As LongpszDisplayName As LonglpszTitle As LongulFlags As LonglpfnCallback As LonglParam As LongiImage As LongEnd TypePublic Const BIF_RETURNONLYFSDIRS = 1Public Const

78、60;MAX_PATH = 260Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1

79、0;As String, ByVal lpString2 As String) As LongPublic Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As LongPublic Declare Function SHGetPathFromIDList Lib &

80、quot;shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As LongPublic Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As StringDim iNull As IntegerDim lpIDLi

81、st As LongDim lResult As LongDim sPath As StringDim udtBI As BrowseInfo'初始化變量With udtBI.hwndOwner = hwndOwner.lpszTitle = lstrcat(sPrompt, "").ulFlags = BIF_RETURNONLYFSDIRSEnd With'

82、調(diào)用 APIlpIDList = SHBrowseForFolder(udtBI)If lpIDList ThensPath = String$(MAX_PATH, 0)lResult = SHGetPathFromIDList(lpIDList, sPath)Call CoTaskMemFree(lpIDList)iNull = InStr(sPath, vbNullChar)If iNull Then sPath

83、 = Left$(sPath, iNull - 1)End If'如果選擇取消, sPath = ""BrowseForFolder = sPathEnd Function2.調(diào)用"映射網(wǎng)絡(luò)驅(qū)動器"對話框Private/Public Declare Function WNetConnectionDialog Lib "mpr.dll" _(ByVal

84、 hwnd As Long, ByVal dwType As Long) As Longx% = WNetConnectionDialog(Me.hwnd, 1)3.調(diào)用"打開文件"對話框Private Type OPENFILENAMElStructSize As LonghwndOwner As LonghInstance As LonglpstrFilter A

85、s StringlpstrCustomFilter As StringnMaxCustFilter As LongnFilterIndex As LonglpstrFile As StringnMaxFile As LonglpstrFileTitle As StringnMaxFileTitle As LonglpstrInitialDir As StringlpstrTitle As Stringfla

86、gs As LongnFileOffset As IntegernFileExtension As IntegerlpstrDefExt As StringlCustData As LonglpfnHook As LonglpTemplateName As StringEnd TypePrivate Declare Function GetOpenFileName Lib "comdlg

87、32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long將以下代碼置于某一事件中Dim ofn As OPENFILENAMEofn.lStructSize = Len(ofn)ofn.hwndOwner = Form1.hWndofn.hInstance = App.hInstanceofn.lpstrFilter&#

88、160;= "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "Rich Text Files (*.rtf)" + Chr$(0) + "*.rtf" + Chr$(0)ofn.lpstrFile = Space$(254)ofn.nMaxF

89、ile = 255ofn.lpstrFileTitle = Space$(254)ofn.nMaxFileTitle = 255ofn.lpstrInitialDir = curdirofn.lpstrTitle = "Our File Open Title"ofn.flags = 0Dim aa = GetOpenFileName(ofn)If (a) ThenMsgBox&

90、#160;"File to Open: " + Trim$(ofn.lpstrFile)ElseMsgBox "Cancel was pressed"End If4.調(diào)用"打印"對話框Private Type PrintDlglStructSize As LonghwndOwner As LonghDevMode As LonghDevNames As

91、60;Longhdc As Longflags As LongnFromPage As IntegernToPage As IntegernMinPage As IntegernMaxPage As IntegernCopies As IntegerhInstance As LonglCustData As LonglpfnPrintHook As LonglpfnSetupHook A

92、s LonglpPrintTemplateName As StringlpSetupTemplateName As StringhPrintTemplate As LonghSetupTemplate As LongEnd TypePrivate Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PrintDlg) As Long'將以下代碼置于某一事件中Dim tPrintDlg As PrintDlgtPrintDlg.lStructSize = Len(tPrintDlg)tPrintDlg.hwndOwner = Me.