● ポップアップメニューを表示する ●

VBで使う機会といったら、タスクトレイにアイコンを格納するときかな?

やっぱりAPIで実装すると面倒くさい。

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

'ポップアップメニューを表示する
Private Declare Function TrackPopupMenu Lib "User32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hWnd As Long, lprc As RECT) As Long

'メニューのハンドルを取得する
Private Declare Function GetMenu Lib "User32" (ByVal hWnd As Long) As Long

'サブメニューのハンドルを取得する
Private Declare Function GetSubMenu Lib "User32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

'カーソルの位置を取得する
Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long

'ウインドウサイズを取得する
Private Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT) As Long

Private Const TPM_BOTTOMALIGN = &H20& '下
Private Const TPM_CENTERALIGN = &H4& '中央下
Private Const TPM_LEFTALIGN = &H0& '右下
Private Const TPM_RIGHTALIGN = &H8& '左下
Private Const TPM_LEFTBUTTON = &H0& '左クリック追跡
Private Const TPM_RIGHTBUTTON = &H2& '右クリック追跡

'指定ウインドウをアクティブにする
Private Declare Function SetForegroundWindow Lib "User32" (ByVal hWnd As Long) As Long

'-----------------------------------------------------------------------
' 関数名 : ShowPopUpMenu
' 機能   : マウスポインタ位置にメニューを表示する
' 引数   : (in) hWnd  … 表示するメニューを持つウインドウのハンドル
'          (in) MenuPos … 最上位メニュー位置(0-Base)
' 戻り値 : 正常:1  エラー:0
'-----------------------------------------------------------------------
Public Function ShowPopUpMenu(ByVal hWnd As Long, ByVal MenuPos As Long) As Long

    Dim udtPA As POINTAPI
    Dim udtRect As RECT
    Dim MenuhWnd As Long
    Dim SubMenuhWnd As Long

    'カーソルの位置を取得
    Call GetCursorPos(udtPA)

    'ウインドウ座標取得
    Call GetWindowRect(hWnd, udtRect)

    'メニューのハンドルを取得
    MenuhWnd = GetMenu(hWnd)

    'サブメニューのハンドルを取得
    SubMenuhWnd = GetSubMenu(MenuhWnd, MenuPos)

    'ここに以下の文を入れておくと良い
    'Shell_NotifyIcon で使用する場合は必須
    'Call SetForegroundWindow(hWnd)

    'ポップアップメニュー表示
    '第2引数は定数を色々変えてお好みに…
    ShowPopUpMenu = TrackPopupMenu(SubMenuhWnd, TPM_CENTERALIGN, _
                  udtPA.X, udtPA.Y, 0&, hWnd, udtRect)
End Function

戻る