vb常用代码-.pdf

《vb常用代码-.pdf》由会员分享，可在线阅读，更多相关《vb常用代码-.pdf（14页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。

1、-1-移动无标题栏的窗体(borderstyle=none)dim mouseX as integer dim mouseY as integer dim moveX as integer dim moveY as integer dim down as boolean form_mousedown:mousedown 事件down=true mouseX=x mouseY=y form_mouseup:mouseup 事件down=false form_mousemove if down=true then moveX=me.left-mouseX+X moveY=me.top-mouseY

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

3、nt Lib user32(ByVal hMenu As Long)As Long Private Const MF_BYPOSITION=&H400&Private Sub Form_Load()Dim hwndMenu As Long Dim c As Long hwndMenu=GetSystemMenu(Me.hwnd,0)c=GetMenuItemCount(hwndMenu)DeleteMenu hwndMenu,c-1,MF_BYPOSITION c=GetMenuItemCount(hwndMenu)DeleteMenu hwndMenu,c-1,MF_BYPOSITION E

4、nd 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 access.cpl,3,9)辅

5、助选项属性-鼠标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 shell32.dll,Control_Ru

6、nDLL 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.exe shell32.dll,Control_

7、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)VB 常用代码-2-Internet 属性-安全Call Shell(rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,1,9)Internet 属性-内容Call Shell(rundll32.ex

8、e 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 Long Dim RetVal As Long winHwnd=FindWindow(vbNullString,Calculator)De

9、bug.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 The Calculator is not open.End If For this code to work,you must have declared the API functions in a module in your project.You must put the following in th

10、e declarations section of the module.Declare Function FindWindow Lib user32 Alias _ FindWindowA(ByVal lpClassName As String,_ ByVal lpWindowName As String)As Long Declare Function PostMessage Lib user32 Alias _ PostMessageA(ByVal hwnd As Long,ByVal wMsg As Long,_ ByVal wParam As Long,lParam As Any)A

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

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

13、Form_Load()Dim RemainDay As Long RemainDay=GetSetting(MyApp,set,day,0)If RemainDay=30 Then MsgBox 试用期已过，请注册 Unload Me End If MsgBox 现在剩下：&30-RemainDay&试用天数，好好珍惜！if day(now)-remainday0 then RemainDay=RemainDay+1 SaveSetting MyApp,set,times,RemainDay End Sub *MMControl控件全屏播放-3-Option Explicit Private

14、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 Long Private Declare Function mciSendCommand Lib winmm.dll _ Alias mciSendCommandA(ByVal wDeviceID As Long,_

15、 ByVal uMessage As Long,ByVal dwParam1 As Long,_ dwParam2 As MCI_OVLY_RECT_PARMS)As Long Private Declare Function GetShortPathName Lib kernel32 _ Alias GetShortPathNameA(ByVal lpszLongPath As _ String,ByVal lpszShortPath As String,ByVal _ cchBuffer As Long)As Long Private Type RECT Left As Long Top

16、As Long Right As Long Bottom As Long End Type Private Type MCI_OVLY_RECT_PARMS dwCallback As Long rc As RECT End Type Const MCI_OVLY_WHERE_SOURCE=&H20000 Const MCI_OVLY_WHERE_DESTINATION=&H40000 Const MCI_WHERE=&H843 Dim Play As Boolean Private Sub Form_Load()MMControl1.Wait=True MMControl1.UpdateIn

17、terval=50 MMControl1.hWndDisplay=Picture1.hWnd Picture1.ScaleMode=3 Timer1.Interval=50 End Sub Private Sub Form_Unload(Cancel As Integer)MMControl1.Command=stop MMControl1.Command=close End Sub Private Sub Command1_Click()MMControl1.Command=stop MMControl1.Command=close Play=False CommonDialog1.Filt

18、er=(VB-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 Op

19、tion2 Then Call AdaptPicture End If If Option3.Value Then Call Option3_Click Me.Caption=CommonDialog1.filename End If End Sub Private 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 If End S

20、ub-4-Private Sub Command3_Click()Play=False MMControl1.Command=stop End Sub Private Sub Command4_Click()MMControl1.Command=pause End Sub Private Sub MMControl1_Done(NotifyCode As Integer)If Play And Check1.Value=vbChecked Then Play=False MMControl1.Command=stop MMControl1.Command=prev MMControl1.Com

21、mand=play Play=True End If End Sub Private Sub MMControl1_StatusUpdate()Label2.Caption=MMControl1.Position End Sub Private Sub Option1_Click()Check1.Enabled=True Check2.Enabled=False MMControl1.hWndDisplay=0 End Sub Private Sub Option2_Click()Check1.Enabled=True Check2.Enabled=True MMControl1.hWndDi

22、splay=Picture1.hWnd End Sub Private 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 Sub Private Sub Check2_C

23、lick()If Check2.Value=vbChecked And MMControl1.filename Then Call AdaptPicture End If End Sub Private 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 L

24、abel6.Caption=AA End Sub Private 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.Heig

25、ht=(Par.rc.Bottom-Par.rc.Top)*15+4*15 End If-5-End Sub*通用对话框专辑（全）使用 API 调用 Winodws 各种通用对话框(Common Diaglog)的方法（一）1.文件属性对话框Type SHELLEXECUTEINFO cbSize As Long fMask As Long hwnd As Long lpVerb As String lpFile As String lpParameters As String lpDirectory As String nShow As Long hInstApp As Long lpIDL

26、ist As Long 可选参数lpClass As String 可选参数hkeyClass As Long 可选参数dwHotKey As Long 可选参数hIcon As Long 可选参数hProcess As Long 可选参数End Type Const SEE_MASK_INVOKEIDLIST=&HC Const SEE_MASK_NOCLOSEPROCESS=&H40 Const SEE_MASK_FLAG_NO_UI=&H400 Declare Function ShellExecuteEX Lib shell32.dll Alias ShellExecuteEx _(S

27、EI As SHELLEXECUTEINFO)As Long Public Function ShowProperties(filename As String,OwnerhWnd As Long)As Long 打开指定文件的属性对话框,如果返回值=32 则出错Dim SEI As SHELLEXECUTEINFO Dim r As Long With SEI.cbSize=Len(SEI).fMask=SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI.hwnd=OwnerhWnd.lpVerb=p

28、roperties.lpFile=filename.lpParameters=vbNullChar.lpDirectory=vbNullChar.nShow=0.hInstApp=0.lpIDList=0 End With r=ShellExecuteEX(SEI)ShowProperties=SEI.hInstApp End Function 新建一个工程,添加一个按钮和名为Text1 的文本框把以下代码置入CommandbButton_Click 中Dim r As Long Dim fname As String 从 Text1 中获取文件名及路径fname=(Text1)r=ShowP

29、roperties(fname,Me.hwnd)If r 部件中加载 Microsoft Winsock Control 6.0 控件Text1.text=Winsock1.localip*将程序从任务列表中隐藏将你的程序从Windows 的系统任务列表中隐藏(即CTRL+ALT+DEL出来的框)复制以下代码到一模块中Declarations Public Declare Function GetCurrentProcessId Lib kernel32()As Long Public Declare Function GetCurrentProcess Lib kernel32()As Lo

30、ng Public Declare Function RegisterServiceProcess Lib kernel32(ByVal dwProcessID As Long,ByVal dwType As Long)As Long Public Const RSP_SIMPLE_SERVICE=1 Public Const RSP_UNREGISTER_SERVICE=0 下面代码为隐藏Public Sub MakeMeService()Dim pid As Long Dim reserv As Long pid=GetCurrentProcessId()regserv=RegisterS

31、erviceProcess(pid,RSP_SIMPLE_SERVICE)End Sub 恢复隐藏Public UnMakeMeService()Dim pid As Long Dim reserv As Long pid=GetCurrentProcessId()regserv=RegisterServiceProcess(pid,RSP_UNREGISTER_SERVICE)End Sub *如何在窗体中平铺图片？本文介绍怎样用一个图片（例如BMP）平铺在窗口并完全覆盖它。我们常常有需要使用一幅小图去覆盖一个窗口或者窗口的一部分。这正是设计那些小图的目的。它们以原来的尺寸作为背景排列在要覆

32、盖的窗口上，这种技术就叫“平铺”。VB 没有提供平铺图片到窗口的标准功能。要做到这点，我们必须使用WINDOWS API和一些图形技术。操作步骤：1、建立一个新工程项目，缺省建立窗体FORM1 2、添加一个新模体3、粘贴下面代码到新模体Option Explicit Declare Function BitBlt Lib gdi32(ByVal hDestDC As Long,ByVal x As Long,_ ByVal y As Long,ByVal nWidth As Long,ByVal nHeight As Long,ByVal hSrcDC As Long,_ ByVal xSrc

33、 As Long,ByVal ySrc As Long,ByVal dwRop As Long)As Long Declare Function GetDC Lib user32(ByVal hwnd As Long)As Long Public RetValue As Long-13-Public Sub TileWindow(WindowObject As Object,p As PictureBox)Dim j As Integer,i As Integer Dim x As Integer Dim WhDC As Long This object can be any VB stand

34、ard object with an hWnd property WhDC=GetDC(WindowObject.hwnd)For j=0 To WindowObject.Height Step p.ScaleHeight For i=0 To WindowObject.Width Step p.ScaleWidth x=BitBlt(WhDC,i,j,p.ScaleWidth,p.ScaleHeight,p.hDC,0,0,vbSrcCopy)Next Next End Sub 4、添加一个图片框控件（PICUTRE1），设置其SCALEMODE 属性=3-PIXEL，AUTOREDRAW属

35、性=TURE，AUTOSIZE属性=TURE。在 PICTURE 属性中选择一幅图。5、添加以下代码到FORM1 的 PAINT 事件：Private Sub Form_Paint()TileWindow Me,Picture1 End Sub 6、保存工程项目7、运行程序。当显示出窗体后，可以看到图片“平铺”到整个窗体。注意：尽管这种方法显示能够在任何支持hWnd属性的控件上平铺图片，但仍必须留意哪些控件支持 PAINT 方法*制作拖盘Public Const MAX_TOOLTIP As Integer=64 Public Const NIF_ICON=&H2 Public Const N

36、IF_MESSAGE=&H1 Public Const NIF_TIP=&H4 Public Const NIM_ADD=&H0 Public Const NIM_DELETE=&H2 Public Const WM_MOUSEMOVE=&H200 Public Const WM_LBUTTONDOWN=&H201 Public Const WM_LBUTTONUP=&H202 Public Const WM_LBUTTONDBLCLK=&H203 Public Const WM_RBUTTONDOWN=&H204 Public Const WM_RBUTTONUP=&H205 Public

37、Const WM_RBUTTONDBLCLK=&H206 Public Const SW_RESTORE=9 Public Const SW_HIDE=0 Public nfIconData As NOTIFYICONDATA Public Type NOTIFYICONDATA cbSize As Long hWnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String*MAX_TOOLTIP End Type Public Declare Function Show

38、Window Lib user32(ByVal hWnd As Long,ByVal nCmdShow As Long)As Long Public Declare Function Shell_NotifyIcon Lib shell32.dll Alias Shell_NotifyIconA(ByVal dwMessage As Long,lpData As NOTIFYICONDATA)As Long 以下在 form_load 里初始化With nfIconData .hWnd=Me.hWnd .uID=Me.Icon .uFlags=NIF_ICON Or NIF_MESSAGE O

39、r NIF_TIP .uCallbackMessage=WM_MOUSEMOVE .hIcon=Me.Icon.Handle 定义鼠标移动到托盘上时显示的Tip .szTip=App.Title&V&App.Major&.&App.Minor&.&App.Revision&Build:0825&vbNullChar .cbSize=Len(nfIconData)End With Call Shell_NotifyIcon(NIM_ADD,nfIconData)以下在 mousemove Dim lMsg As Single lMsg=x/Screen.TwipsPerPixelX Select

40、 Case lMsg Case WM_LBUTTONUP MsgBox 请用鼠标右键点击图-14-标!,vbInformation,天倚之音 单击左键，显示窗体 ShowWindow Me.hWnd,SW_RESTORE 下面两句的目的是把窗口显示在窗口最顶层 Me.Show Me.SetFocus Case WM_RBUTTONUP PopupMenu frmmnu.mnulstsong 如果是在系统Tray 图标上点右键，则弹出菜单mnulstsong Case WM_MOUSEMOVE Case WM_LBUTTONDOWN Case WM_LBUTTONDBLCLK Case WM_R

41、BUTTONDOWN Case WM_RBUTTONDBLCLK Case Else End Select 以下在窗体关闭（程序结束时）保证托盘图标消失Call Shell_NotifyIcon(NIM_DELETE,nfIconData)拖盘相关调用*一个 API 一行代码实现 XP 风格控件声明Private Declare Sub InitCommonControls Lib comctl32.dll()Private Sub Form_Initialize()InitCommonControls End Sub 比如生成的可执行文件名为：test.exe 在该文件同一目录下新建立一个文

42、本文件文本文件里输入以下内容 Your application description here.最后将这个文本文件改名为：test.exe.manifest 现在大家在打开test.exe 发现窗体上的空件都变成XP 风格的了*改变文件的属性语法SetAttr pathname,attributes pathname 必要参数。用来指定一个文件名的字符串表达式，可能包含目录或文件夹、以及驱动器。Attributes 必要参数。常数或数值表达式，其总和用来表示文件的属性。attributes 参数设置可为：常数值描述vbNormal 0 常规（缺省值）VbReadOnly 1 只读。vbHidden 2 隐藏。vbSystem 4 系统文件vbArchive 32 上次备份以后，文件已经改变举例：setattr c:123.txt,VbReadOnly+vbHidden 将 123 这个文本文件设置成只读和隐藏属性