Public Class Form1
Public Sub ShellAndWait(ByVal ProcessPath As String)
Dim objProcess As System.Diagnostics.Process
Try
objProcess = New System.Diagnostics.Process()
objProcess.StartInfo.FileName = ProcessPath
objProcess.StartInfo.WindowStyle = ProcessWindowStyle.Normal
objProcess.Start()
objProcess.WaitForExit()
objProcess.Close()
Catch
MessageBox.Show("无法执行文件 " &ProcessPath, "错误")
End Try
End Sub
'监视程序悄好拦就可以了,若果监视别的窗体的话,用SPY++ 找到句柄,配合FindWindowEx,SendMessage根启胡据其属性做
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
ShellAndWait("Notepad.exe")
MessageBox.Show("笔记本被关袜液闭后我才会出现")
End Sub
End Class
窗体代码:Private Sub Form_Load()Do: CL.Add 0: Loop While CL.Count <100
Set DRW.PictureBox = PIC1
Set DRW.DataCollection = CL
DRW.PicBackground = vbBlack
DRW.PicForeground = vbGreen
DRW.BorderColor = vbRed
DRW.BorderSize = 0
DRW.GridColor = &H808000
DRW.GridVisible = True
LastMoment = Now
LastLogged = Now
LoggingInterval = 60
Set m_objIpHelper = New CIpHelper
Dim a As Long
For a = 1 To m_objIpHelper.Interfaces.Count
cboConnectionType.AddItem m_objIpHelper.Interfaces(a).InterfaceDescription &" "
Next
If Val(GetSetting(App.Title, "Setting", "Connection", 0)) + 1 <= cboConnectionType.ListCount Then
cboConnectionType.ListIndex = Val(GetSetting(App.Title, "Setting", "Connection", 0))
Else
cboConnectionType.ListIndex = 0
End If
End SubPrivate Sub Timer1_Timer()
If DownloadSpeedTop <>0 Then
DownloadSpeedTop = 0
UploadSpeedTop = 0
Else
Timer1.Enabled = False
End If
End SubPrivate Sub tmrUpdate_Timer()
On Error Resume Next'If DateDiff("s", LastMoment, Now) <1 Then Exit SubtmrUpdate.Enabled = False
Dim objInterface As CInterface
Set objInterface = m_objIpHelper.Interfaces(cboConnectionType.ListIndex + 1)lblType = m_objIpHelper.Interfaces(cboConnectionType.ListIndex + 1).InterfaceDescription &" "Dim BytesRecv As Long, BytesSent As Long
BytesRecv = m_objIpHelper.BytesReceived
BytesSent = m_objIpHelper.BytesSentDoEvents
Dim DS As Long, US As Long
DS = BytesRecv - LastRecvBytes
US = BytesSent - LastSentBytes
If DownloadSpeedTop <DS Then DownloadSpeedTop = DS
If UploadSpeedTop <US Then UploadSpeedTop = US
DoEventslblRecv.Caption = Format(BytesRecv / 1024, "###,###,###,###,##0 KB")
lblSent.Caption = Format(BytesSent / 1024, "###,###,###,###,##0 KB")DownloadSpeedAverage = (DownloadSpeedAverage + DS) / 2
UploadSpeedAverage = (UploadSpeedAverage + US) / 2
lblDownloadSpeedTop = "下载速率: " &Format(DownloadSpeedTop / 1024, "###,###,###,###,#0.#0 Kb/S")
lblUploadSpeedTop = "上载速率: " &Format(UploadSpeedTop / 1024, "###,###,###,###,#0.#0 Kb/S")
lblDownloadSpeedAverage = "平均下载速率: " &Format(DownloadSpeedAverage / 1024, "###,###,###,###,#0.#0 Kb/S")
lblUploadSpeedAverage = "平均上载速率: " &Format(UploadSpeedAverage / 1024, "###,###,###,###,#0.#0 Kb/S")'Me.Caption = lblDownloadSpeedTop.Caption &vbNewLine &_
lblUploadSpeedTop.Caption &vbNewLine &_
lblDownloadSpeedAverage.Caption &vbNewLine &_
lblUploadSpeedAverage.Caption
CL.Add Int(Format(DownloadSpeedAverage / 1024, "###,###,###,###,#0.#0")) + 5
DRW.DrawIf DS / 1024 <1 Then
lblDSpeed = Format(DS, "0 BS ")
Else
lblDSpeed = Format(DS / 1024, "0.#0 KBS ")
End If
If US / 1024 <1 Then
lblUSpeed = Format(US, "0 BS ")
Else
lblUSpeed = Format(US / 1024, "0.#0 KBS ")
End IfLastRecvBytes = BytesRecv
LastSentBytes = BytesSent
LastMoment = NowIf m_objIpHelper.Interfaces.Count <>cboConnectionType.ListCount Then
Dim a As Long
cboConnectionType.Clear
For a = 1 To m_objIpHelper.Interfaces.Count
cboConnectionType.AddItem m_objIpHelper.Interfaces(a).InterfaceDescription &" "
Next
If Val(GetSetting(App.Title, "Setting", "Connection", 0)) + 1 <= cboConnectionType.ListCount Then
cboConnectionType.ListIndex = Val(GetSetting(App.Title, "Setting", "Connection", 0))
Else
cboConnectionType.ListIndex = 0
End If
End If
tmrUpdate.Enabled = True
End Sub还有些类模块 你加我QQ发给你 这个字数限制了的
有什么问题?请HI我!--------------------
控件:3个命令按钮、一个图片框
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" _
Alias "capCreateCaptureWindowA" ( _
ByVal lpszWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hWndParent As Long, _
ByVal nID As Long) As Long
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_USER = &H400
Private Const WM_CAP_START = &H400
Private Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)
Private Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Private Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Private Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Private Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Private Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Preview_Handle As Long
Private Function CreateCaptureWindow( _
hWndParent As Long, _
Optional x As Long = 0, _
Optional y As Long = 0, _
Optional nWidth As Long = 320, _
Optional nHeight As Long = 240, _
Optional nCameraID As Long = 0) As Long
Preview_Handle = capCreateCaptureWindow("Video", _
WS_CHILD + WS_VISIBLE, x, y, _
nWidth, nHeight, hWndParent, 1)
SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, nCameraID, 0
SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 30, 0
SendMessage Preview_Handle, WM_CAP_SET_OVERLAY, 1, 0
SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0
CreateCaptureWindow = Preview_Handle
End Function
Private Function CapturePicture(nCaptureHandle As Long) As StdPicture
Clipboard.Clear
SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0
Set CapturePicture = Clipboard.GetData
End Function
Private Sub Disconnect(nCaptureHandle As Long, _
Optional nCameraID = 0)
SendMessage nCaptureHandle, WM_CAP_DRIVER_DISCONNECT, _
nCameraID, 0
End Sub
Dim Video_Handle As Long
Private Sub Command2_Click()
Video_Handle = CreateCaptureWindow(PicCapture.hwnd, , , Me.PicCapture.Width, Me.PicCapture.Height)
End Sub
Private Sub Command1_Click()
Dim x As StdPicture
Set x = CapturePicture(Video_Handle)
SavePicture x, App.Path &"\a.bmp"
End Sub
Private Sub Command3_Click()
Disconnect Video_Handle
End Sub
Private Sub Form_Resize()
Me.PicCapture.Width = Me.Width - 400
Me.PicCapture.Height = Me.Height - 1400
Me.PicCapture.Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
Disconnect Video_Handle
End Sub
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)