vb常用代码大全.docx
- 文档编号:10949960
- 上传时间:2023-02-23
- 格式:DOCX
- 页数:40
- 大小:27.71KB
vb常用代码大全.docx
《vb常用代码大全.docx》由会员分享,可在线阅读,更多相关《vb常用代码大全.docx(40页珍藏版)》请在冰豆网上搜索。
vb常用代码大全
VB常用代码
移动无标题栏的窗体
dim m(borderstyle=none)
ouseX 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+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 GetMenuItemCount 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
End 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)
'辅助选项 属性-鼠标
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_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.exe 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 Shell("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 Long
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, "Calculator")
Debug.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 the 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) As 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
*******************************************
软件的注册
可用注册表简单地保存已用的天数或次数
'次数限制(如30次)如下:
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
'时间限制的(如30天)
Private Sub 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)-remainday>0 then RemainDay = RemainDay + 1
SaveSetting "MyApp", "set", "times", RemainDay
End Sub
*******************************************
MMControl控件全屏播放
Option Explicit
Private 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, _
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 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.UpdateInterval = 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.Filter = ("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 Option2 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 Sub
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.Command = "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.hWndDisplay = 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_Click()
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
Label6.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.Height = (Par.rc.Bottom - Par.rc.Top) * 15 + 4 * 15
End If
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
lpIDList 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" _
(SEI 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 = "properties"
.lpFile = filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With
r = ShellExecuteEX(SEI)
ShowProperties = SEI.hInstApp
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- vb 常用 代码 大全