托盘图标问题？
程序代码：'主窗体代码
Option Explicit
Dim myData1 As NOTIFYICONDATA
Dim bFull As Boolean
Dim lSize(3) As Long
'程序启动了，flash右击，托盘，气泡，都能正常显示，就是鼠标点击托盘图标左键弹起和右键弹菜单都没反应啊，哪里出错了，请各位老师指点一下，
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
If Me.WindowState = 1 Then
Me.WindowState = 0
Me.Show
Else
Me.WindowState = 1
Me.Hide
End If
Case WM_RBUTTONUP
SetForegroundWindow Me.hwnd
Me.PopupMenu mnuPop
End Select
End Sub
Private Sub Form_Load()
Call sd
InstallHook
End Sub
Sub sd()
With myData1
.cbSize = Len(myData1)
.hwnd = Me.hwnd
.uId = 0
.uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE Or NIF_INFO Or NIF_STATE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
.szTip = "测试" & vbNullChar
.dwState = 0
.dwStateMask = 0
.szInfo = "测试" & vbNullChar
.szInfoTitle = "你好" & vbNullChar
.dwInfoFlags = NIIF_INFO
.uTimeoutOrVersion = 10000
End With
Shell_NotifyIcon NIM_ADD, myData1
End Sub
Private Sub Form_Resize()
On Error Resume Next
Flash.Width = Me.ScaleWidth
Flash.Height = Me.ScaleHeight
Flash.Top = 0
Flash.Left = 0
End Sub
Public Sub mnuFullScr_Click()
Dim lStyle As Long
If WindowState = 2 Then WindowState = 0
bFull = Not bFull
lStyle = GetWindowLong(hwnd, GWL_STYLE)
If bFull Then
lStyle = lStyle - (lStyle And WS_FULLSCR)
SetWindowLong Me.hwnd, GWL_STYLE, lStyle
lSize(0) = Top: lSize(1) = Left: lSize(2) = Width: lSize(3) = Height
Move 0, 0, Screen.Width, Screen.Height
Else
lStyle = lStyle Or WS_FULLSCR
SetWindowLong Me.hwnd, GWL_STYLE, lStyle
Move lSize(0), lSize(1), lSize(2), lSize(3)
End If
End Sub
Private Sub tmrAutoClose_Timer()
If GetForegroundWindow() <> hwnd And bFull Then mnuFullScr_Click
End Sub
'模块代码
Option Explicit
Dim hWndProc As Long
Dim hSwfProc As Long
Public hFlash As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const NIM_ADD = &H0 '在任务栏中增加一个图标
Public Const NIM_DELETE = &H2 '删除任务栏中的一个图标
Public Const NIM_MODIFY = &H1 '修改任务栏中个图标信息
Public Const WM_MOUSEMOVE = &H200 '在图标上移动鼠标
Public Const WM_LBUTTONDOWN = &H201 '鼠标左键按下
Public Const WM_LBUTTONUP = &H202 '鼠标左键释放
Public Const HWND_TOPMOST = -1
Public Const SWP_SHOWWINDOW = &H40
Public Const WM_RBUTTONUP = &H205
Public Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long ' 唯一的标识符
uFlags As Long ' Flags
uCallBackMessage As Long ' 处理消息的窗口接收的消息
hIcon As Long ' 托盘图标句柄
szTip As String * 128 ' Tooltip 提示文本
dwState As Long ' 托盘图标状态
dwStateMask As Long ' 状态掩码
szInfo As String * 256 ' 气球提示文本
uTimeoutOrVersion As Long ' 气球提示消失时间或版本
szInfoTitle As String * 64 ' 气球提示标题
dwInfoFlags As Long ' 气球提示图标
End Type
Public Const NIIF_INFO = &H1
Public Const NIF_INFO = &H10
Public Const NIF_STATE = &H8
Public Const NIF_MESSAGE = &H1 'NIF_MESSAGE 表示发送控制消息；
Public Const NIF_ICON = &H2 'NIF_ICON表示显示控制栏中的图标；
Public Const NIF_TIP = &H4 'NIF_TIP表示任务栏中的图标有动态提示。
Public restoreTime As Date
Public Const GWL_WNDPROC = (-4)
Public Const GWL_STYLE = (-16)
Public Const WM_DROPFILES = &H233
Public Const WM_NCLBUTTONDBLCLK = &H203
Public Const WM_CLOSE = &H10
Public Const WM_RBUTTONDOWN = &H204
Public Const WS_CAPTION = &HC00000
Public Const WS_SYSMENU = &H80000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_DLGFRAME = &H400000
Public Const WS_BORDER = &H800000
Public Const WS_THICKFRAME = &H40000
Public Const WS_FULLSCR = WS_DLGFRAME Or WS_BORDER Or WS_THICKFRAME Or WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Public Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Function InstallHook()
With frmMain
hFlash = FindWindowEx(.hwnd, 0&, "MacromediaFlashPlayerActiveX", vbNullString)
hWndProc = SetWindowLong(.hwnd, GWL_WNDPROC, AddressOf WndProc)
hSwfProc = SetWindowLong(hFlash, GWL_WNDPROC, AddressOf SwfProc)
End With
End Function
Private Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_DROPFILES Then
Dim strFilename As String * 511
Call DragQueryFile(wParam, 0, strFilename, 511)
Call DragQueryFile(wParam, 2, strFilename, 511)
End If
WndProc = CallWindowProc(hWndProc, hwnd, uMsg, wParam, lParam)
End Function
Private Function SwfProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_NCLBUTTONDBLCLK
frmMain.mnuFullScr_Click
Case WM_RBUTTONDOWN
frmMain.PopupMenu frmMain.mnuPop
Case Else
SwfProc = CallWindowProc(hSwfProc, hwnd, uMsg, wParam, lParam)
End Select
End Function
[ 本帖最后由 ymhy12345 于 2013-1-4 21:12 编辑 ]
