Программа без отображения в дисп. задач

' Module
' - - - - - -
' Код модуля
 
Option Explicit
 
Public Const GWL_WNDPROC = -4
 
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_MBUTTONDOWN = &H207
Const WM_MBUTTONUP = &H208
 
Const WM_MYUSER = 4096
 
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) 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
 
Const NIF_MESSAGE = &H1
Const NIF_ICON = &H2
Const NIF_TIP = &H4
Const NIM_ADD = &H0
Const NIM_MODIFY = &H1
Const NIM_DELETE = &H2
 
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
 
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
 
Private tNID As NOTIFYICONDATA
Public gWH As Long
Public OldWndProc As Long
 
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Select Case Msg
  Case WM_MYUSER
    If lParam = WM_LBUTTONUP Then Form1.Caption = "Отпущена левая кнопка мыши"
    If lParam = WM_RBUTTONUP Then Form1.Caption = "Отпущена правая кнопка мыши"
    If lParam = WM_MBUTTONUP Then Form1.Caption = "Отпущена средняя кнопка мыши"
    Exit Function
  End Select
 
  WindowProc = CallWindowProc(OldWndProc, hwnd, Msg, wParam, lParam)
End Function
 
Public Sub TrayAdd(ByVal fhwnd As Long, fIcon As Long, fText As String)
  With tNID
    .szTip = Left$(fText, 63) & Chr$(0)
    .uFlags = NIF_TIP + NIF_MESSAGE + NIF_ICON
    .uID = fhwnd
    .cbSize = Len(tNID)
    .hwnd = fhwnd
    .uCallbackMessage = WM_MYUSER
    .hIcon = fIcon
  End With
  Call Shell_NotifyIcon(NIM_ADD, tNID)
End Sub
 
Public Sub TrayDelete()
  tNID.cbSize = Len(tNID)
  Call Shell_NotifyIcon(NIM_DELETE, tNID)
End Sub
 
Public Sub TrayModifyText(fText As String)
  With tNID
    .uFlags = NIF_TIP
    .cbSize = Len(tNID)
    .szTip = Left$(fText, 63) & Chr$(0)
  End With
  Call Shell_NotifyIcon(NIM_MODIFY, tNID)
End Sub
 
' - - - - - - - - - - - -
' Form
' - - - - - -
' Command1 – кнопка
' Command2 – кнопка
' Command3 – кнопка
' - - - - - -
' Код формы
 
Option Explicit
 
Private Sub Command1_Click()
  TrayAdd gWH, Form1.Icon.Handle, "Форма в трее"
End Sub
 
Private Sub Command2_Click()
  TrayModifyText "Новый текст"
End Sub
 
Private Sub Command3_Click()
  TrayDelete
End Sub
 
Private Sub Form_Load()
  Command1.Caption = "Добавить значёк в трей"
  Command2.Caption = "Изменить текст всплывающей подсказки"
  Command3.Caption = "Удалить значек из трея"
  gWH = Me.hwnd
 
' Можно обойтись и без следующей строки, но тогда будет
' не просто отследить клики по нашему значку в трэе.
' Смотрите дополнительно:
' [url]http://pva-land.jino-net.ru/codesvb/037.php[/url]
  OldWndProc = SetWindowLong(gWH, GWL_WNDPROC, AddressOf WindowProc)
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Call SetWindowLong(gWH, GWL_WNDPROC, OldWndProc)
End Sub

Private Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal dwProcessId _
As Long, ByVal dwType As Long) As Long
 
Private Sub Form_Load()
Dim x
x = RegisterServiceProcess(0, 1)
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
Dim x
x = RegisterServiceProcess(0, 0)
End Sub