modAddTaskbarItem.bas

 Attribute VB_Name = "modAddTaskbarItem"
Option Explicit

Private Type CWPSTRUCT
    lParam As Long
    wParam As Long
    message As Long
    hwnd As Long
End Type

Private Type CREATESTRUCT
    lpCreateParams As Long
    hInstance As Long
    hMenu As Long
    hWndParent As Long
    cy As Long
    cx As Long
    y As Long
    x As Long
    style As Long
    lpszName As Long    ' String
    lpszClass As Long   ' String
    ExStyle As Long
End Type

Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private 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
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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 SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Const WH_CALLWNDPROC = 4

'Misc Windows messages
Private Const WM_CREATE = &H1
Private Const WM_DESTROY = &H2
Private Const WM_PARENTNOTIFY = &H210

'Window Styles
Private Const WS_OVERLAPPED = &H0&
Private Const WS_POPUP = &H80000000
Private Const WS_CHILD = &H40000000
Private Const WS_MINIMIZE = &H20000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_DISABLED = &H8000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_MAXIMIZE = &H1000000
Private Const WS_CAPTION = &HC00000                  '  WS_BORDER Or WS_DLGFRAME
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_GROUP = &H20000
Private Const WS_TABSTOP = &H10000

Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000

Private Const WS_TILED = WS_OVERLAPPED
Private Const WS_ICONIC = WS_MINIMIZE
Private Const WS_SIZEBOX = WS_THICKFRAME
Private Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Private Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW

'Common Window Styles
Private Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
Private Const WS_CHILDWINDOW = (WS_CHILD)

'Extended Window Styles
Private Const WS_EX_DLGMODALFRAME = &H1&
Private Const WS_EX_NOPARENTNOTIFY = &H4&
Private Const WS_EX_TOPMOST = &H8&
Private Const WS_EX_ACCEPTFILES = &H10&
Private Const WS_EX_TRANSPARENT = &H20&

Private Const WS_EX_APPWINDOW = &H40000
Private Const WS_EX_TOOLWINDOW = &H80&

Private Const GWL_EXSTYLE = (-20)
Private Const GWL_WNDPROC = (-4)

'VB5 & VB6 class names:
Private Const C_MDIFORMCLASS_IDE = "ThunderMDIForm"
Private Const C_MDIFORMCLASS_EXE = "ThunderRT6MDIForm"
Private Const C_MDIFORMCLASS5_IDE = "ThunderMDIForm"
Private Const C_MDIFORMCLASS5_EXE = "ThunderRT5MDIForm"
Private Const C_FORMCLASS_IDE_DC = "ThunderFormDC"
Private Const C_FORMCLASS_EXE_DC = "ThunderRT6FormDC"
Private Const C_FORMCLASS_IDE = "ThunderForm"
Private Const C_FORMCLASS_EXE = "ThunderRT6Form"
Private Const C_FORMCLASS5_IDE = "ThunderForm"
Private Const C_FORMCLASS5_EXE = "ThunderRT5Form"
Private m_hHook As Long
Private m_lHookWndProc As Long

Public Sub HookAttachAddTaskbarItem()
   m_hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook, App.hInstance, App.ThreadID)
   Debug.Assert m_hHook <> 0
End Sub

Public Sub HookDetachAddTaskbarItem()
   If m_hHook <> 0 Then
      UnhookWindowsHookEx m_hHook
      m_hHook = 0
   End If
End Sub

Private Function AppHook(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim CWP As CWPSTRUCT
Dim k As Long
Dim aClass As String
   If idHook >= 0 Then
      CopyMemory CWP, ByVal lParam, Len(CWP)
      Select Case CWP.message
      Case WM_CREATE
          aClass = Space$(128)
          k = GetClassName(CWP.hwnd, ByVal aClass, 128)
          aClass = Mid$(aClass, 1, k)
          If IsIn(aClass, C_MDIFORMCLASS_IDE, C_MDIFORMCLASS_EXE, C_MDIFORMCLASS5_IDE, _
              C_MDIFORMCLASS5_EXE, C_FORMCLASS_IDE_DC, C_FORMCLASS_EXE_DC, C_FORMCLASS_IDE, _
              C_FORMCLASS_EXE, C_FORMCLASS5_IDE, C_FORMCLASS5_EXE) Then
             m_lHookWndProc = SetWindowLong(CWP.hwnd, GWL_WNDPROC, AddressOf Form_WndProc)
          End If
      End Select
   End If
   AppHook = CallNextHookEx(m_hHook, idHook, wParam, ByVal lParam)
End Function

Private Function Form_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lSetStyleEX As Long
   'SPM - specific wnd proc for a form.  Only called once for the WM_CREATE message.
   Select Case Msg
   Case WM_CREATE
      Dim tCS As CREATESTRUCT
      CopyMemory tCS, ByVal lParam, Len(tCS)
      lSetStyleEX = GetWindowLong(hwnd, GWL_EXSTYLE)
      lSetStyleEX = lSetStyleEX Or WS_EX_APPWINDOW
      lSetStyleEX = lSetStyleEX And (Not WS_EX_TOOLWINDOW)
      tCS.ExStyle = lSetStyleEX
      CopyMemory ByVal lParam, tCS, Len(tCS)
      SetWindowLong hwnd, GWL_WNDPROC, m_lHookWndProc
      SetWindowLong hwnd, GWL_EXSTYLE, tCS.ExStyle
   End Select
   Form_WndProc = CallWindowProc(m_lHookWndProc, hwnd, Msg, wParam, lParam)
End Function

Private Function IsIn(ByVal vComp As Variant, ParamArray vTo() As Variant) As Boolean
Dim i As Long, iL As Long, iU As Long
   On Error Resume Next
   iU = UBound(vTo)
   If err.Number = 0 Then
      iL = LBound(vTo)
      For i = iL To iU
         If vComp = vTo(i) Then
            IsIn = True
            Exit Function
         End If
      Next i
   End If
End Function

Project Homepage: