| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 714 人关注过本帖, 1 人收藏
标题:托盘图标问题?
只看楼主 加入收藏
ymhy12345
Rank: 2
等 级:论坛游民
帖 子:83
专家分:36
注 册:2011-8-27
结帖率:72.73%
收藏(1)
 问题点数:0 回复次数:2 
托盘图标问题?
程序代码:
'主窗体代码
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
yz1025
Rank: 8Rank: 8
等 级:蝙蝠侠
威 望:6
帖 子:485
专家分:919
注 册:2012-10-26
收藏
得分:0 
VB6内建托盘控件
EFMTIcn.ocx
不需要另外写模块

如果真要写模块
我都用这个以前抓的
程序代码:
Attribute VB_Name = "MdlTray"
'讓程式縮到啟動列模組
Option Explicit

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 NIM_MODIFY = &H1

Public Const WM_MOUSEMOVE = &H200

Public Const trayLBUTTONDOWN = 7695
Public Const trayLBUTTONUP = 7710
Public Const trayLBUTTONDBLCLK = 7725

Public Const trayRBUTTONDOWN = 7740
Public Const trayRBUTTONUP = 7755
Public Const trayRBUTTONDBLCLK = 7770

Public Const trayMOUSEMOVE = 7680

Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_LBUTTONDBLCLK = &H203

Public rc As Long

Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Dim trayStructure As NOTIFYICONDATA

Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Public Sub Pause(lngInterval As Long)
   Dim lngEnd As Long, lngNow As Long, count1 As Long
   count1 = GetTickCount()
   lngEnd = count1 + (lngInterval * 1000)
   Do
     DoEvents
     lngNow = GetTickCount()
   Loop Until lngNow >= lngEnd
End Sub

Public Function AddIcon(pic As PictureBox, tip$)
   trayStructure.szTip = tip$ & Chr$(0)
   trayStructure.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP
   trayStructure.uID = 100
   trayStructure.cbSize = Len(trayStructure)
   
   trayStructure.hwnd = pic.hwnd
   trayStructure.uCallbackMessage = WM_MOUSEMOVE
   trayStructure.hIcon = pic.Picture
   rc = Shell_NotifyIcon(NIM_ADD, trayStructure)
End Function

Public Function ChangeIcon(pic As PictureBox, tip$)
   trayStructure.szTip = tip$ & Chr$(0)
   trayStructure.uFlags = NIF_ICON + NIF_TIP
   trayStructure.hIcon = pic.Picture
   Shell_NotifyIcon NIM_MODIFY, trayStructure
End Function

Public Function DeleteIcon(pic As Control)
   trayStructure.uID = 100
   trayStructure.cbSize = Len(trayStructure)
   trayStructure.hwnd = pic.hwnd
   trayStructure.uCallbackMessage = WM_MOUSEMOVE
   rc = Shell_NotifyIcon(NIM_DELETE, trayStructure)
End Function

Public Sub NewTip(pic As Control, tip$)
    trayStructure.uFlags = NIF_TIP
    trayStructure.uID = 100
    trayStructure.cbSize = Len(trayStructure)
    trayStructure.hwnd = pic.hwnd
    trayStructure.uCallbackMessage = WM_MOUSEMOVE
    trayStructure.szTip = tip$ & Chr$(0)
    rc = Shell_NotifyIcon(NIM_MODIFY, trayStructure)
End Sub

不要投我
2013-01-09 10:29
yz1025
Rank: 8Rank: 8
等 级:蝙蝠侠
威 望:6
帖 子:485
专家分:919
注 册:2012-10-26
收藏
得分:0 
不需要用到钩子

不要投我
2013-01-09 10:31
快速回复:托盘图标问题?
数据加载中...
 
   



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

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