module1.bas

磁盘托盘程序源码,磁盘托盘程序源码1the code of system tray about 1

Attribute VB_Name = "SysTray"
Option Explicit '强制定义每个使用的变量

       Type NOTIFYICONDATA '定义结构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

        '以下为 Shell_NotifyIcon将用到的常量

        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

        'Shell_NotifyIcon的函数声明

        Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

     '处理消息将用到的结构、常量、API声明

        Type POINTAPI

         x As Long

         y As Long

        End Type

        Type Msg

         hwnd As Long

         message As Long

         wParam As Long

         lParam As Long

         time As Long

         pt As POINTAPI

        End Type

         Public Const WM_USER = &H400

    Public Const WM_RBUTTONDOWN = &H204

    Public Const WM_LBUTTONDBLCLK = &H203

        Public Const GWL_WNDPROC = -4

        Public trayflag As Boolean '定义托盘图标是否在桌面上

        Global lpPrevWndProc As Long

        Global gHW As Long

    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

    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

     '以下过程为消息循环处理

    Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

      If hw = Form1.hwnd And uMsg = WM_USER + 100 Then '检测到鼠标点动托盘图标

       Select Case lParam

          Case WM_RBUTTONDOWN '鼠标右键按下

         Form1.PopupMenu Form1.mainmenu '弹出菜单

       Case WM_LBUTTONDBLCLK '鼠标左键双击

     Form1.Show '显示窗口

       Case Else

       End Select

      Else '调用缺省窗口指针

         WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)

     End If

    End Function

    Public Sub hook() '将程序勾入消息环中

     '利用AddressOf取得消息处理函数WindowProc的指针，并将其传给SetWindowLong

     'lpPrevWndProc用来存储原窗口的指针

     lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)

    End Sub

    Public Sub Unhook()

    '将程序从消息环退出。用原窗口的指针替换WindowProc函数的指针，即关闭子类、退出消息循环

     Dim temp As Long

     temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)

    End Sub