Přidání ikony do systémového řádku

1. Do sekce (general) do deklarací vložte následující deklarace:
   
   'Typ potřebný pro API funkci
   Private 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
   'Konstanty pro API funkci
   Private Const NIM_ADD = &H0
   Private Const NIM_MODIFY = &H1
   Private Const NIM_DELETE = &H2
   Private Const WM_MOUSEMOVE = &H200
   Private Const NIF_MESSAGE = &H1
   Private Const NIF_ICON = &H2
   Private Const NIF_TIP = &H4
   Private Const WM_LBUTTONDBLCLK = &H203
   Private Const WM_LBUTTONDOWN = &H201
   Private Const WM_LBUTTONUP = &H202
   Private Const WM_RBUTTONDBLCLK = &H206
   Private Const WM_RBUTTONDOWN = &H204
   Private Const WM_RBUTTONUP = &H205
   'Deklarace API funkce
   Private Declare Function Shell_NotifyIcon Lib "shell32" Alias
   "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As
   NOTIFYICONDATA) As Boolean
   'Každá deklarace musí být na samostatném řádku
   'Definice proměnné
   Dim t As NOTIFYICONDATA

2. Ve formuláři definujte menu, které se bude jmenovat mnuBar a jeho submenu s nadpisem Konec a jménem mnuBar_Quit
3. Na událost mnuBar_Quit_Click vložte příkaz Unload Me
4. Do formuláře připojte prvek PictureBox, který pojmenujte PicHook.
5. Formuláři specifikujte ikonu, která se běžně zobrazuje v titulku okna.

6. Na událost Load formuláře vložte následující kód:
   
   Private Sub Form_Load()
   
      t.cbSize = Len(t)
      t.hWnd = pichook.hWnd
      t.uId = 1&
      t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
      t.ucallbackMessage = WM_MOUSEMOVE
      t.hIcon = Me.Icon
      t.szTip = "Ukázka ikony v systémovém řádku ..." & Chr$(0)
      Shell_NotifyIcon NIM_ADD, t
      Me.Hide
      App.TaskVisible = False
   
   End Sub

7. Na událost QueryUnload připojte následující kód:
   
   Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   
      t.cbSize = Len(t)
      t.hWnd = pichook.hWnd
      t.uId = 1&
      Shell_NotifyIcon NIM_DELETE, t
   
   End Sub

8. Na událost MouseMove prvku PicHook vložte následující kód:
   
   Private Sub pichook_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
      Static rec As Boolean, msg As Long
   
      msg = X / Screen.TwipsPerPixelX
      If rec = False Then
         rec = True
         Select Case msg
               Case WM_LBUTTONDBLCLK:
                   MsgBox "Double click !"
               Case WM_LBUTTONDOWN:
               Case WM_LBUTTONUP:
               Case WM_RBUTTONDBLCLK:
               Case WM_RBUTTONDOWN:
               Case WM_RBUTTONUP:
                   Me.PopupMenu mnuBar
       End Select
       rec = False
   End If
   
   End Sub
   

9. Spusťte aplikaci. Klepnutí na ikonu v systémovém řádku pravým tlačítkem myši vyvolá menu

Zpět