【VBA×WindowsAPI】DestroyMenu関数の使い方

1. DestroyMenu関数

DestroyMenu関数

DestroyMenu関数は指定したメニューを破棄し、メモリを解放するための関数です。
WindowsAPIではCreateMenu関数やCreatePopupMenu関数を呼び出すことで、メモリ上にメニューを作成することができます。このとき、作成したメニューを破棄して占有していたメモリ領域を解放するための関数がDestroyMenu関数です。WindowsAPIには似た名称のDeleteMenu関数という関数が存在しますが、この関数は指定の”メニュー項目”を削除するための関数であり、メニューそのものを削除すものではありません。

使用方法

DestroyMenu関数を使用するにはあらかじめ関数の宣言しておく必要があります。
※宣言をしないと関数は使えずにエラーとなるので書き忘れに注意しましょう。

使用しているWindowsが32bitか64bitかによって宣言時に書く文言が違います。
環境に合わせて以下のいずれかをコードの一番初め(Option Explicitの次の行あたり)に書いておくことで、そのモジュール内で各関数を使うことができるようになります。

64bit

Declare PtrSafe Function DestroyMenu Lib “user32” (ByVal hMenu As LongPtr) As Long

32bit

Declare Function DestroyMenu Lib “user32” (ByVal hMenu As Long) As Long

上記のどちらを書けばいいかわからない場合は以下のコードをコピペして、モジュールの最上部に書いておきましょう。この構文を書いておくことで自動的に使うことのできる方の構文が使用されます。
VBE上では使えない方の構文が赤色で表示される場合がありますが、実行に影響はありません。

#If VBA7 Then
    Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long
#Else
    Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
#End If

#If VBA7 Then

Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long

#Else

Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long

#End If

　
各関数の宣言文は「Private/Public」を付けて各関数の有効範囲を指定することもできます。

・Private Declare PtrSafe Function～ ：モジュール内でのみ呼び出し有効
・Public Declare PtrSafe Function～　：モジュール外で呼び出し有効

構文

DestroyMenu関数の構文は下記のように書きます。

DestroyMenu関数

lRet = DestroyMenu(hMenu)

引数

hMenu (64bit:LongPtr型 / 32bit:Long型)

破棄するメニューのハンドルを入力します。

戻り値

lRet (Long型)

戻り値は関数が成功すると「0以外」、失敗すると「0」が返ります。

サンプルコード

以下はDestroyMenu関数とCreatePopupMenu関数、FindWindow関数、AppendMenu関数、GetCursorPos関数、TrackPopupMenu関数を使って、UserForm上で右クリックをしたらコンテキストメニューを表示するサンプルコードです。

下記コードをUserFormのコードにコピーペーストしてからUserFormを表示すれば、Initializeイベントでメニューがメモリ上に作成され、右クリックをするとそのメニューを表示することができます。

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long
Private Declare PtrSafe Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal wIDNewItem As LongPtr, ByVal lpNewItem As Any) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function TrackPopupMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As LongPtr, lprc As Long) As Long

Private Const MF_STRING     As Long = &H0   '文字列設定ﾌﾗｸﾞ
Private Const TPM_RETURNCMD As Long = &H100 '戻り値を選択された項目のIDとする

'ｶｰｿﾙ座標取得用構造体
Private Type POINTAPI
    X As Long
    Y As Long
End Type

Dim hWndForm    As LongPtr  'UserFormｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ
Dim hMenu       As LongPtr  'ﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰﾊﾝﾄﾞﾙ

'------------------------------------------------------------------
'   UserForm起動時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Initialize()
    
    'UserFormｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ取得
    hWndForm = FindWindow("ThunderDFrame", Me.Caption)

    'ﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰ作成
    hMenu = CreatePopupMenu()
    
    'ﾒﾆｭｰ項目に文字列追加
    Call AppendMenu(hMenu, MF_STRING, 1, "文字列設定1")
    Call AppendMenu(hMenu, MF_STRING, 2, "文字列設定2")
    Call AppendMenu(hMenu, MF_STRING, 3, "文字列設定3")
  
End Sub
'------------------------------------------------------------------
'   UserForm終了時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Terminate()
    
    'ﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰ解放
    Call DestroyMenu(hMenu)
    
End Sub

'------------------------------------------------------------------
'   UserFormﾏｳｽｱｯﾌﾟｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
    '右ｸﾘｯｸ時
    If Button = 2 Then

        Dim tPos As POINTAPI
        Dim lRet As Long

        '現在のｶｰｿﾙ位置の座標取得
        Call GetCursorPos(tPos)

        'ｶｰｿﾙ位置にﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰを表示
        lRet = TrackPopupMenu(hMenu, TPM_RETURNCMD, tPos.X, tPos.Y, 0, hWndForm, 0)
        If lRet <> 0 Then
            Call MsgBox("「ID：" & lRet & "」の項目が選択されました", vbInformation)
        End If

    End If

End Sub

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr

Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long

Private Declare PtrSafe Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal wIDNewItem As LongPtr, ByVal lpNewItem As Any) As Long

Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare PtrSafe Function TrackPopupMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As LongPtr, lprc As Long) As Long

Private Const MF_STRING As Long = &H0 '文字列設定ﾌﾗｸﾞ

Private Const TPM_RETURNCMD As Long = &H100 '戻り値を選択された項目のIDとする

'ｶｰｿﾙ座標取得用構造体

Private Type POINTAPI

X As Long

Y As Long

End Type

Dim hWndForm As LongPtr 'UserFormｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ

Dim hMenu As LongPtr 'ﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰﾊﾝﾄﾞﾙ

'------------------------------------------------------------------

' UserForm起動時ｲﾍﾞﾝﾄ

'------------------------------------------------------------------