Как поместить иконку в трей -> Форум на Исходниках.RU [Powered by Invision Power Board]

<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>

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

Private Const NIM_ADD = &H0

Private Const NIM_MODIFY = &H1

Private Const NIM_DELETE = &H2

Private Const NIF_MESSAGE = &H1

Private Const NIF_ICON = &H2

Private Const NIF_TIP = &H4

Private Const WM_MOUSEMOVE = &H200

Private Const WM_LBUTTONDOWN = &H201

Private Const WM_LBUTTONUP = &H202

Private Const WM_LBUTTONDBLCLK = &H203

Private Const WM_RBUTTONDOWN = &H204

Private Const WM_RBUTTONUP = &H205

Private Const WM_RBUTTONDBLCLK = &H206

Private Const WM_MBUTTONDOWN = &H207

Private Const WM_MBUTTONUP = &H208

Private Const WM_MBUTTONDBLCLK = &H209

Private Type TNotifyIconData

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 Nid As TNotifyIconData

' *** Tray Icon ***

Private Function TrayAddIcon(ByVal mForm As Form) As TNotifyIconData

TrayAddIcon.cbSize = Len(Nid)

TrayAddIcon.hIcon = mForm.Icon

TrayAddIcon.hWnd = mForm.hWnd

TrayAddIcon.szTip = mForm.Caption & vbNullChar

TrayAddIcon.ucallbackMessage = 512

TrayAddIcon.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP

TrayAddIcon.uId = 1

Call Shell_NotifyIcon(NIM_ADD, TrayAddIcon)

End Function

Private Sub TrayRemoveIcon(IconData As TNotifyIconData)

Call Shell_NotifyIcon(NIM_DELETE, IconData)

End Sub

Private Sub TrayModifyIcon(IconData As TNotifyIconData)

Call Shell_NotifyIcon(NIM_MODIFY, IconData)

End Sub

' ********************************************************************************

Private Sub Form_Load()

Nid = TrayAddIcon(Me)

End Sub

Private Sub Form_Unload(Cancel As Integer)

Call TrayRemoveIcon(Nid)

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Y <> 0 Then Exit Sub

If X = WM_LBUTTONDOWN Then Me.Caption = "Down left"

If X = WM_LBUTTONUP Then Me.Caption = "Up left"

If X = WM_LBUTTONDBLCLK Then Me.Caption = "DblClick left"

If X = WM_RBUTTONDOWN Then Me.Caption = "Down right"

If X = WM_RBUTTONUP Then Me.Caption = "Up right"

If X = WM_RBUTTONDBLCLK Then Me.Caption = "DblClick right"

If X = WM_MBUTTONDOWN Then Me.Caption = "Down middle"

If X = WM_MBUTTONUP Then Me.Caption = "Up middle"

If X = WM_MBUTTONDBLCLK Then Me.Caption = "DblClick middle"

End Sub