'================================================================
'= メニュー項目を挿入
'=    (InsertMenuItem.bas)
'================================================================
#include "Windows.bi"

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type
 
Type MENUITEMINFO
    cbSize        As Long    '構造体のバイト数
    fMask         As Long    '取得する情報を指定する定数の組み合わせ
    fType         As Long    'メニュー項目のタイプを指定する定数の組み合わせ
    fState        As Long    'メニューの状態を指定する定数の組み合わせ
    wID           As Long    'ユーザー定義のメニュー項目のID
    hSubMenu      As Long    '指定のメニュー項目と関連するサブメニューのハンドル
    hbmpChecked   As Long    'チェックマーク用のビットマップのハンドル
    hbmpUnChecked As Long    '未チェック時のときのビットマップハンドル
    dwItemData    As Long    'メニュー項目と関連するユーザー定義の値
    dwTypeData    As Long    'メニュー項目のタイプ(fMaskにMIIM_Typeを指定したときのみ有効)
    cch           As Long    'メニュー項目のテキストのバイト数
End Type
 
' ポップアップメニューを作成
Declare Function Api_CreatePopupMenu& Lib "user32" Alias "CreatePopupMenu" ()

' 指定されたメニューを破棄
Declare Function Api_DestroyMenu& Lib "user32" Alias "DestroyMenu" (ByVal hMenu&)

' メニュー内の指定された位置に、新しいメニュー項目を挿入
Declare Function Api_InsertMenuItem& Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu&, ByVal uItem&, ByVal fByPosition&, lpmii As MENUITEMINFO)

' 指定の位置にポップアップメニューを表示
Declare Function Api_TrackPopupMenu& Lib "user32" Alias "TrackPopupMenu" (ByVal hMenu&, ByVal uFlags&, ByVal x&, ByVal y&, ByVal nReserved&, ByVal hWnd&, ByVal prcRect&)

' ウィンドウの座標をスクリーン座標系で取得
Declare Function Api_GetWindowRect& Lib "user32" Alias "GetWindowRect" (ByVal hWnd&, lpRect As RECT)

#define MIIM_CHECKMARKS &H8             'hbmpChecked、hbmpUncheckedメンバをセット
#define MIIM_DATA &H20                  'dwItemDataメンバをセット
#define MIIM_ID &H2                     'wIDメンバをセット
#define MIIM_STATE &H1                  'fStateメンバをセット
#define MIIM_SUBMENU &H4                'hSubMenuメンバをセット
#define MIIM_TYPE &H10                  'fTypeメンバをセット

#define MFT_BITMAP &H4                  'ビットマップを使ってメニュー項目を表示
#define MFT_MENUBARBREAK &H20           'メニュー項目を新しい列に置く(ドロップダウンメニュー、サブメニュー、ショートカットメニューの時は区切・
#define MFT_MENUBREAK &H40              'メニュー項目を新しい列に置く(区切り線は入らない)
#define MFT_OWNERDRAW &H100             'オーナードローをする時指定
#define MFT_RADIOCHECK &H200            'hbmpCheckedメンバがNULLの時ラジオボタンを使ってチェックされる
#define MFT_RIGHTJUSTIFY &H4000         'メニュー項目が右揃え
#define MFT_RIGHTORDER &H2000           'アラビア語とかヘブライ語の時指定(Win9x･2000)
#define MFT_SEPARATOR &H800             '区切り線(dwTypeDataとcchメンバは無視)
#define MFT_STRING &H0                  'メニュー項目に文字列を使う

#define MFS_CHECKED &H8                 'メニュー項目にチェックをつける
#define MFS_DEFAULT &H1000              'メニュー項目がデフォルトであることを指定
#define MFS_DISABLED &H2                'メニュー項目を選択不可にする
#define MFS_ENABLED &H0                 'メニュー項目を選択可能にする
#define MFS_GRAYED &H1                  'メニュー項目を灰色にして選択不可にする
#define MFS_HILITE &H80                 'メニュー項目をハイライトにする
#define MFS_UNCHECKED &H0               'メニュー項目からチェックをはずす
#define MFS_UNHILITE &H0                'メニュー項目のハイライトをやめる

#define TPM_BOTTOMALIGN &H20            'ショートカットメニューの下端を、y パラメータが指定する座標に合わせる
#define TPM_CENTERALIGN &H4             'ショートカットメニューの中心を、x パラメータが指定する座標に合わせる
#define TPM_HORNEGANIMATION &H800       '左から右へ向かってメニューのアニメーション表示
#define TPM_HORPOSANIMATION &H400       '右から左へ向かってメニューのアニメーション表示
#define TPM_LEFTALIGN &H0               'ショートカットメニューの左端を、xパラメータが指定する座標に合わせる
#define TPM_LEFTBUTTON &H0              'マウスの左ボタンでポップアップメニューからの選択が行えるようにする
#define TPM_NONOTIFY &H80               'ユーザーがメニュー項目をクリックしたとき、通知メッセージを送らない
#define TPM_RETURNCMD &H100             '関数の戻り値として、ユーザーが選択したメニュー項目のIDを返す
#define TPM_RIGHTALIGN &H8              'ショートカットメニューの右端を、x パラメータが指定する座標に合わせる
#define TPM_RIGHTBUTTON &H2             'マウスの右ボタンでポップアップメニューからの選択が行えるようにする
#define TPM_TOPALIGN &H0                'ショートカットメニューの上端を、yパラメータが指定する座標に合わせる
#define TPM_VCENTERALIGN &H10           'ショートカットメニューの中心を、yパラメータが指定する座標に合わせる
#define TPM_VERNEGANIMATION &H2000      '下から上へ向かってメニューのアニメーション表示
#define TPM_VERPOSANIMATION &H1000      '上から下へ向かってメニューのアニメーション表示
 
Var Shared hPopupMenu As Long
Var Shared mii(1) As MENUITEMINFO

Var Shared Button1 As Object

Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var Ret As Long
   
    hPopupMenu = Api_CreatePopupMenu()

    'メニュー１の内容
    mii(0).cbSize = Len(mii(0))
    mii(0).dwTypeData = StrAdr("&File" & Chr$(0))
    mii(0).cch = Len(mii(0).dwTypeData)
    mii(0).fMask = MIIM_TYPE Or MIIM_ID
    mii(0).fState = MFS_DEFAULT Or MFS_HILITE
    mii(0).fType = MFT_STRING
    mii(0).wID = 1

    Ret = Api_InsertMenuItem(hPopupMenu, 0, 0, mii(0))
    If Ret = 0 Then
        A% = MessageBox("", "「MenuFile」は挿入できません！", 0, 2)
    End If

    'メニュー２の内容
    mii(1).cbSize = Len(mii(1))
    mii(1).dwTypeData = StrAdr("&Edit" & Chr$(0))
    mii(1).cch = Len(mii(1).dwTypeData)
    mii(1).fMask = MIIM_TYPE Or MIIM_ID
    mii(1).fState = MFS_DEFAULT Or MFS_HILITE
    mii(1).fType = MFT_STRING
    mii(1).wID = 2

    Ret = Api_InsertMenuItem(hPopupMenu, 0, 0, mii(1))
    If Ret = 0 Then
        A% = MessageBox("", "「MenuEdit」は挿入できません！", 0, 2)
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var rct As RECT
    Var Flag As Long
    Var Ret As Long

    'Button1のスクリーン座標
    Ret = Api_GetWindowRect(Button1.GethWnd, rct)

    Flag = TPM_LEFTBUTTON Or TPM_TOPALIGN Or TPM_NONOTIFY Or TPM_RETURNCMD

    '指定の位置にポップアップメニューを表示
    Ret = Api_TrackPopupMenu(hPopupMenu, Flag, rct.Right, rct.Bottom, 0, GethWnd, 0)

    Select Case Ret
        Case 0
            A% = MessageBox("", "キャンセルされました！", 0, 2)
        Case 1
            A% = MessageBox("", "File が選択されました！", 0, 2)
        Case 2
            A% = MessageBox("", "Edit が選択されました！", 0, 2)
    End Select           
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    Ret = Api_DestroyMenu(hPopupMenu)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End