[API]
CopyAcceleratorTableA
CopyAcceleratorTableW
RtlMoveMemory
POINTAPI

[INCLUDE]
GetKeyNameText
MapVirtualKey
LoadResEx_Menu_SetCaption
LoadResEx_Menu_GetCaption

[CODE]
Public Sub LoadResEx_ApplyAcceleratorsToMenu(ByVal hAccel As Long, ByVal hMenu As Long)
  Dim xLong1 As Long
  Dim xChar1 As String
  Dim xChar2 As String
  Dim xType1 As POINTAPI

  If IsUnicode Then
    xLong1 = CopyAcceleratorTableW(hAccel, ByVal 0&, 0&)
    Else
    xLong1 = CopyAcceleratorTableA(hAccel, ByVal 0&, 0&)
    End If
  If Not xLong1 = 0& Then
    xChar1 = String(xLong1 * 6&, vbNullChar)
    If IsUnicode Then
      xLong1 = CopyAcceleratorTableW(hAccel, ByVal xChar1, xLong1)
      Else
      xLong1 = CopyAcceleratorTableA(hAccel, ByVal xChar1, xLong1)
      End If
    For xLong1 = 0& To xLong1 - 1&
      xChar2 = Mid(xChar1, xLong1 * 6& + 1&, 6&)
      Call RtlMoveMemory(xType1, ByVal xChar2, 8&)
      If Not ((xType1.y And &HFFFF&) = 0& Or (xType1.x And &HFFFF0000) = 0& Or (xType1.x And &HFFFF) = 0&) Then
        xChar2 = GetKeyNameText(&H1 + (MapVirtualKey((xType1.x And &HFFFF0000) \ &H10000, 0&) And &HFF&) * &H10000)
        If Len(xChar2) = 0& Then xChar2 = "#" & Hex((xType1.x And &HFFFF0000) \ &H10000)
        If xType1.x And &H4& Then xChar2 = GetKeyNameText(MapVirtualKey(16&, 0&) * &H10000) + "+" + xChar2
        If xType1.x And &H8& Then xChar2 = GetKeyNameText(MapVirtualKey(17&, 0&) * &H10000) + "+" + xChar2
        Call LoadResEx_Menu_SetCaption(hMenu, (xType1.y And &HFFFF&), LoadResEx_Menu_GetCaption(hMenu, (xType1.y And &HFFFF&)) + vbTab + xChar2)
        End If
      Next
    End If
  End Sub
