Как поместить иконку в трей

[D[u]fa]

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

Сообщение отредактировано: Andrey_Kun - 07.04.04, 16:01

[Black Star]

Цитата

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"

X может и не совпадать с событиями. Все зависит от ScaleMode. Например при ScaleMode=1 (twip) вместо 513 придет сообщение 7695.