'Shell Constants, Enumerations, and Flags
Public Enum SHSTOCKICONID
...
  SIID_FOLDER = 3
...
  SIID_PRINTER = 16
...
  SIID_SHIELD = 77
  SIID_WARNING = 78
  SIID_INFO = 79
  SIID_ERROR = 80
...
 End Enum

'Shell Structures

Private Type SHSTOCKICONINFO
  cbSize As Long
  hIcon As Long
  iSysImageIndex As Long
  iIcon As Long
  szPath(2 * MAX_PATH - 1) As Byte ' W-version ?
End Type

'uFlags - flags that specify which information is requested
Public Const SHGSI_ICON = &H100
Public Const SHGSI_LARGEICON = &H0
Public Const SHGSI_SMALLICON = &H1

'Shell Functions
Public Declare Function SHGetStockIconInfo Lib "Shell32.dll" (ByVal siid As SHSTOCKICONID, _
 ByVal uFlags As Long, ByRef psii As SHSTOCKICONINFO) As Long

Public Function GetStockIcon(ByVal siid As SHSTOCKICONID, _
 Optional ByVal bLargeIcon As Boolean = False) As Long

  Dim ShIconInfo As SHSTOCKICONINFO
  Dim lRet As Long
  
  ShIconInfo.cbSize = LenB(ShIconInfo)
  
  If bLargeIcon Then
    lRet = SHGetStockIconInfo(siid, SHGSI_ICON Or SHGSI_LARGEICON, ShIconInfo)
  Else
    lRet = SHGetStockIconInfo(siid, SHGSI_ICON Or SHGSI_SMALLICON, ShIconInfo)
  End If
  
  If lRet = S_OK Then GetStockIcon = ShIconInfo.hIcon

End Function

Public Function HBITMAP_fromStockIcon(ByVal siid As SHSTOCKICONID) As Long
  'возвращает alpha-blended bitmap соотв. системной иконке из SHSTOCKICONID - для меню на Vista и выше
  Dim lngIcon As Long
  Dim hdc As Long
  Dim hMemDC As Long
  Dim hMemBmp As Long
  Dim hResultBmp As Long
  Dim hOrgBMP As Long
  Dim bmiDst As BITMAPINFO2
  Dim pBits As Long
  
  lngIcon = GetStockIcon(siid, False)
  hdc = GetDC(0)
  hMemDC = CreateCompatibleDC(hdc)
  
  With bmiDst.bmiHeader
    .biSize = LenB(bmiDst.bmiHeader)
    .biWidth = 16
    .biHeight = 16
    .biPlanes = 1
    .biBitCount = 32
    .biCompression = BI_RGB
  End With
  hMemBmp = CreateDIBSection(0, bmiDst, DIB_RGB_COLORS, pBits, 0, 0)
  
  'hMemBmp = CreateCompatibleBitmap(hdc, 16, 16)
  hResultBmp = 0
  hOrgBMP = SelectObject(hMemDC, hMemBmp)
  DrawIconEx hMemDC, 0, 0, lngIcon, 16, 16, 0, 0, DI_NORMAL
  hResultBmp = hMemBmp
  hMemBmp = 0
  SelectObject hMemDC, hOrgBMP
  DeleteDC hMemDC
  ReleaseDC 0, hdc
  DestroyIcon lngIcon
  HBITMAP_fromStockIcon = hResultBmp
End Function

  h_MENU_Bitmap(0) = HBITMAP_fromStockIcon(SIID_SHIELD)
  h_MENU_Bitmap(1) = HBITMAP_fromStockIcon(SIID_FOLDER)
  h_MENU_Bitmap(2) = HBITMAP_fromStockIcon(SIID_HELP)
  
  Dim hMenu As Long
  hMenu = GetSubMenu(GetMenu(Me.hwnd), 0)
  
  SetMenuItemBitmaps hMenu, 0, MF_BYPOSITION, h_MENU_Bitmap(0), h_MENU_Bitmap(0) 'Security shield. Use for UAC prompts only.
  SetMenuItemBitmaps hMenu, 2, MF_BYPOSITION, h_MENU_Bitmap(1), h_MENU_Bitmap(1)
  SetMenuItemBitmaps hMenu, 3, MF_BYPOSITION, h_MENU_Bitmap(2), h_MENU_Bitmap(2)

   SendMessage CommandActivate.hwnd, BCM_SETSHIELD, 0&, ByVal 1&

Public Sub SetStockIcon( _
      ByVal hwnd As Long, _
      ByVal siid As SHSTOCKICONID, _
      Optional ByVal bSetAsAppIcon As Boolean = True, _
      Optional ByRef hIconLarge As Long, _
      Optional ByRef hIconSmall As Long)
        
  'устаналивает иконку формы (и приложения) соотв. системной иконке из SHSTOCKICONID
  '16x16 + 32х32 для отображении в Alt+TAB на >=Виста, а также на панели задач >=Win7(?)
  'если по честному, то хэндлы hMeIconLarge и hMeIconSmall надо возвращать, чтоб их потом удалить
  'удалять хэндлы сразу нельзя, пока иконки используются
        
  Dim lhWndTop As Long
  Dim lhWnd As Long
      
  If (bSetAsAppIcon) Then
    ' Find VB's hidden parent window:
    lhWnd = hwnd
    lhWndTop = lhWnd
    Do While Not (lhWnd = 0)
      lhWnd = GetWindow(lhWnd, GW_OWNER)
      If Not (lhWnd = 0) Then
        lhWndTop = lhWnd
      End If
    Loop
  End If
   
  'to retrieve the large version of the icon,
  'as specified by the SM_CXICON and SM_CYICON system metrics
  hIconLarge = GetStockIcon(siid, True)
  If (bSetAsAppIcon) Then
    SendMessageLong lhWndTop, WM_SETICON, ICON_BIG, hIconLarge
  End If
  SendMessageLong hwnd, WM_SETICON, ICON_BIG, hIconLarge
  
  'to retrieve the small version of the icon,
  'as specified by the SM_CXSMICON and SM_CYSMICON system metrics
  hIconSmall = GetStockIcon(siid, False)
  If (bSetAsAppIcon) Then
    SendMessageLong lhWndTop, WM_SETICON, ICON_SMALL, hIconSmall
  End If
  SendMessageLong hwnd, WM_SETICON, ICON_SMALL, hIconSmall
  
  
End Sub

Private Sub Form_Load()
  If sys_WinVista Then
...
    'иконка формы
    'возвращаем hMeIconLarge и hMeIconSmall, чтоб их потом удалить
    SetStockIcon Me.hwnd, SIID_HELP, False, hMeIconLarge, hMeIconSmall
...
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If sys_WinVista Then
    If hMeIconLarge <> 0 Then DestroyIcon hMeIconLarge
    If hMeIconSmall <> 0 Then DestroyIcon hMeIconSmall
  End If
End Sub