Visual Basic API FAQs

[The Hobo]

System Tray and Title Bar Button
This (really long) code is something I wrote awhile ago to demonstrate how to 1) add a button to the title bar, and 2) minimize the form to the system tray.

'form code:
Option Explicit
 
Private Sub Form_Load()
  Init
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  RemoveIcon
  Terminate
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim msg As Long
 
  msg = x / Screen.TwipsPerPixelX
  Select Case msg
    'Case WM_LBUTTONDOWN
 
    'Case WM_LBUTTONUP
 
    Case WM_LBUTTONDBLCLK
      Me.Visible = True
      Me.WindowState = 0
    'Case WM_RBUTTONDOWN
            
    'Case WM_RBUTTONUP
 
    'Case WM_RBUTTONDBLCLK
  
  End Select
 
End Sub
 
Public Sub ButtonPressed()
  AddIcon Me, "test"
End Sub
 
'module code:
Option Explicit
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
  lpRect As Rect) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, _
  ByVal hWndNewParent As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
  ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx _
  As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias _
  "SetWindowsHookExA" (ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal _
  dwThreadId&) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
  (ByVal hHook&) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias _
  "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, _
  ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, _
  ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal _
  hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, _
  lpParam As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
  ByVal nCmdShow As Long) As Long
 
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias _
  "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) _
  As Boolean
 
 
Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type CWPSTRUCT
    lParam As Long
    wParam As Long
    Message As Long
    hwnd As Long
End Type
 
Public 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 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
 
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
 
Private NID As NOTIFYICONDATA
 
Const WM_MOVE = &H3
Const WM_SETCURSOR = &H20
Const WM_NCPAINT = &H85
Const WM_COMMAND = &H111
 
Const SWP_FRAMECHANGED = &H20
Const GWL_EXSTYLE = -20
 
Private WHook&
Private ButtonHwnd As Long
 
Public Sub Init()
    'Create the button that is going to be placed in the Titlebar
    ButtonHwnd& = CreateWindowEx(0&, "Button", "-", &H40000000, 50, 50, 14, 14, frmMain.hwnd, 0&, App.hInstance, 0&)
    'Show the button cause it´s invisible
    Call ShowWindow(ButtonHwnd&, 1)
    'Initialize the window hooking for the button
    WHook = SetWindowsHookEx(4, AddressOf HookProc, 0, App.ThreadID)
    Call SetWindowLong(ButtonHwnd&, GWL_EXSTYLE, &H80)
    Call SetParent(ButtonHwnd&, GetParent(frmMain.hwnd))
End Sub
 
Public Sub Terminate()
    'Terminate the window hooking
    Call UnhookWindowsHookEx(WHook)
    Call SetParent(ButtonHwnd&, frmMain.hwnd)
End Sub
 
Public Function HookProc&(ByVal nCode&, ByVal wParam&, Inf As CWPSTRUCT)
    Dim FormRect As Rect
    Static LastParam&
    If Inf.hwnd = GetParent(ButtonHwnd&) Then
        If Inf.Message = WM_COMMAND Then
            Select Case LastParam
                'If the LastParam is cmdInTitlebar call the Click-Procedure
                'of the button
                Case ButtonHwnd&: frmMain.ButtonPressed
            End Select
        ElseIf Inf.Message = WM_SETCURSOR Then
            LastParam = Inf.wParam
        End If
        ElseIf Inf.hwnd = frmMain.hwnd Then
        If Inf.Message = WM_NCPAINT Or Inf.Message = WM_MOVE Then
            'Get the size of the Form
            Call GetWindowRect(frmMain.hwnd, FormRect)
            'Place the button int the Titlebar
            Call SetWindowPos(ButtonHwnd&, 0, FormRect.Right - 75, FormRect.Top + 6, 17, 14, SWP_FRAMECHANGED)
        End If
    End If
End Function
 
Public Sub AddIcon(TheForm As Form, strT As String)
    NID.cbSize = Len(NID)
    NID.hwnd = TheForm.hwnd
    NID.uid = vbNull
    NID.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    NID.uCallBackMessage = WM_MOUSEMOVE
    NID.hIcon = TheForm.Icon
    NID.szTip = strT & vbNullChar
    Shell_NotifyIcon NIM_ADD, NID
    
    TheForm.WindowState = vbMinimized
    TheForm.Hide
End Sub
 
Public Sub RemoveIcon()
  Shell_NotifyIcon NIM_DELETE, NID
End Sub

Enjoy!