System Tray Icon

[jjb1986]

Hi guys,

I am new here but always stumble across the site to find solutions.

My question is, would it be possible to add a custom icon to a user form and have it show in the taskbar, but also the user tray?

This is the code I am using which I found (which works great, but does not put icon in task bar - and when minimized to system tray only uses the excel icon):

Userform:

Option Explicit
Private Sub CommandButton1_Click()
 Dim Me_hWnd As Long, Me_Icon As Long, Me_Icon_Handle As Long, IconPath As String
 Me_hWnd = FindWindowd("ThunderDFrame", UserForm1.Caption)
 IconPath = Application.Path & Application.PathSeparator & "excel.exe"
 Me_Icon_Handle = ExtractIcond(0, IconPath, 0)
 Hook Me_hWnd
 AddIconToTray Me_hWnd, 0, Me_Icon_Handle, "Double Click to re-open userform"
 Me.Hide
End Sub

Private Sub CommandButton2_Click()
 Application.Visible = True
 Unload Me
End Sub

Private Sub UserForm_Activate()
 RemoveIconFromTray
 Unhook
End Sub

Private Sub UserForm_Initialize()
Application.Visible = False
 CommandButton1.Caption = "Minimize to tray"
 CommandButton2.Caption = "Close this form"
   
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Visible = True
End Sub

Module:

Option Explicit
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" ( _
  ByVal dwMessage As Long, lpData As NOTIFYICONDATA) 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
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName _
  As String, ByVal lpWindowName As String) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst _
  As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBL = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_ACTIVATEAPP = &H1C
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 MAX_TOOLTIP As Integer = 64
Public Const GWL_WNDPROC = (-4)

Type NOTIFYICONDATA
 cbSize As Long
 hwnd As Long
 uID As Long
 uFlags As Long
 uCallbackMessage As Long
 hIcon As Long
 szTip As String * MAX_TOOLTIP
End Type

Public nfIconData As NOTIFYICONDATA

Private FHandle As Long
Private WndProc As Long
Private Hooking As Boolean

Public Sub Hook(Lwnd As Long)
 If Hooking = False Then
  FHandle = Lwnd
  WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
  Hooking = True
 End If
End Sub

Public Sub Unhook()
 If Hooking = True Then
  SetWindowLong FHandle, GWL_WNDPROC, WndProc
  Hooking = False
 End If
End Sub

Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam _
  As Long, ByVal lParam As Long) As Long
 If Hooking Then
  If lParam = WM_LBUTTONDBL Then
   UserForm1.Show 1
   WindowProc = True
'   Unhook
   Exit Function
  End If
  WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
 End If
End Function
 
Public Sub RemoveIconFromTray()
 Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub

Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, _
  Tip As String)
 With nfIconData
  .hwnd = MeHwnd
  .uID = MeIcon
  .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
  .uCallbackMessage = WM_RBUTTONUP
  .hIcon = MeIconHandle
  .szTip = Tip & Chr$(0)
  .cbSize = Len(nfIconData)
 End With
 Shell_NotifyIcon NIM_ADD, nfIconData
End Sub

Function FindWindowd(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 FindWindowd = FindWindow(lpClassName, lpWindowName)
End Function

Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal _
nIconIndex As Long) As Long
ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
End Function

Sub ShowUserForm()
Application.Visible = False
UserForm1.Show 1
End Sub

 

[zweifuss]

The Excel Icon is what I would expect.
Use LoadImageA to load icon files.

Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" _
    (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal dwImagetype As Long, _
     ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As LongPtr

Usage:

Const LR_LOADFROMFILE = &H10
Const IMAGE_ICON = &H1
hIconSmall = LoadImage(0, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)

You should check the return of ExtractIconA for the error values 1 and Null and LoadImageA for Null.
Release unused icon handles with DestroyIcon.

Changing the taskbar icon is tricky. You need a suitable small and a big bitmap/handle and send those to the window with the WM_SETICON message.
This may help: Changing Window Icon (cpearson.com)