| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 714 人关注过本帖, 1 人收藏
标题:托盘图标问题?
取消只看楼主 加入收藏
ymhy12345
Rank: 2
等 级:论坛游民
帖 子:83
专家分:36
注 册:2011-8-27
结帖率:72.73%
收藏(1)
 问题点数:0 回复次数:0 
托盘图标问题?
程序代码:
'主窗体代码
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 编辑 ]
搜索更多相关主题的帖子: 托盘 flash 
2013-01-04 20:46
快速回复:托盘图标问题?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.028248 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved