'================================================================
'= メニューの矩形サイズを取得

'=    (GetMenuItemRect.bas)
'================================================================
#include "Windows.bi"

Type POINTAPI
    x As Long
    y As Long
End Type

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

' メニューのハンドルを取得
Declare Function Api_GetMenu& Lib "user32" Alias "GetMenu" (ByVal hWnd&)

' 指定のメニューの矩形サイズを取得
Declare Function Api_GetMenuItemRect& Lib "user32" Alias "GetMenuItemRect" (ByVal hWnd&, ByVal hMenu&, ByVal uItem&, lprcItem As RECT)

' ポップアップメニューのハンドルを取得
Declare Function Api_GetSubMenu& Lib "user32" Alias "GetSubMenu" (ByVal hMenu&, ByVal nPos&)

' マウスイベントの生成
Declare Sub Api_mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags&, ByVal dx&, ByVal dy&, ByVal cButtons&, ByVal dwExtraInfo&)

' 現在のスレッドに関するメッセージの拡張情報を取得
Declare Function Api_GetMessageExtraInfo& Lib "user32" Alias "GetMessageExtraInfo" ()

' さまざまなシステムメトリックの値とシステムの現在の構成を取得
Declare Function Api_GetSystemMetrics& Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&)

#define MOUSEEVENTF_ABSOLUTE &H8000     '絶対座標(スクリーン座標Left=0･Top=0･Right=35535･Bottom=65535)
#define MOUSEEVENTF_LEFTDOWN &H2        'マウス左ボタンDOWN
#define MOUSEEVENTF_LEFTUP &H4          'マウス左ボタンUP
#define MOUSEEVENTF_MIDDLEDOWN &H20     'マウス中ボタンDOWN
#define MOUSEEVENTF_MIDDLEUP &H40       'マウス中ボタンUP
#define MOUSEEVENTF_MOVE &H1            'マウス移動
#define MOUSEEVENTF_RIGHTDOWN &H8       'マウス右ボタンDOWN
#define MOUSEEVENTF_RIGHTUP &H10        'マウス右ボタンUP
#define SM_CXSCREEN 0                   'ディスプレイの幅
#define SM_CYSCREEN 1                   'ディスプレイ高さ
#define vbCrLf (Chr$(13) & Chr$(10))    'キャリッジリターンとラインフィード(\r\n)

Var Shared Flg As Integer

'================================================================
'=
'================================================================
Declare Sub ScreenToAbsolute(pa As POINTAPI)
Sub ScreenToAbsolute(pa As POINTAPI)
    pa.x = pa.x * (&HFFFF / Api_GetSystemMetrics(SM_CXSCREEN))
    pa.y = pa.y * (&HFFFF / Api_GetSystemMetrics(SM_CYSCREEN))
End Sub

'================================================================
'= マウスクリックシミュレート
'================================================================
Declare Sub MouseClick(pa As POINTAPI)
Sub MouseClick(pa As POINTAPI)
    Api_mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, pa.x, pa.y, 0, Api_GetMessageExtraInfo()

    'Mouse Down
    Api_mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, Api_GetMessageExtraInfo()

    'Mouse Up
    Api_mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, Api_GetMessageExtraInfo()
End Sub

'================================================================
'=
'================================================================
Declare Sub ClickMenuItem(ByVal mWnd As Long, ByVal hMenu As Long, ByVal hPos As Long)
Sub ClickMenuItem(ByVal mWnd As Long, ByVal hMenu As Long, ByVal hPos As Long)
    Var rct As RECT
    Var pa As POINTAPI
    Var Ret As Long

    Ret = Api_GetMenuItemRect(mWnd, hMenu, hPos, rct)
    If Ret = 0 Then Exit Sub

    pa.x = (rct.Left + rct.Right) / 2
    pa.y = (rct.Top + rct.Bottom) / 2

    ScreenToAbsolute pa

    MouseClick pa
    Flg = 0
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on
    Var mWnd As Long
    Var hMenu As Long
    Var hSubMenu As Long

    mWnd = GethWnd
    
    hMenu = Api_GetMenu(mWnd)            'メニューのハンドルを取得
    ClickMenuItem mWnd, hMenu, 0         'Menu1をクリック

    hSubMenu = Api_GetSubMenu(hMenu, 0)  'サブメニューのハンドルを取得
    ClickMenuItem mWnd, hSubMenu, 1      'SubMenu2をクリック

    Flg = 1
End Sub

'================================================================
'=
'================================================================
Declare Sub SubMenu2_on edecl ()
Sub SubMenu2_on()
    Var txt As String

    If Flg = 1 Then
        txt = "「Button」によりSubMenu2の" & vbCrLf & "Clickがシミュレートされました！"
    Else
        txt = "SubMenu2が直接クリックされました！"
    End If

    A% = MessageBox(GetWindowText, txt, 0, 2)
    Flg = 0
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var mWnd As Long
    Var pa As POINTAPI
    Var hMenu As Long
    Var hSubMenu As Long

    mWnd = GethWnd

    hMenu = Api_GetMenu(mWnd)              'メニューのハンドルを取得
    ClickMenuItem mWnd, hMenu, 0           '

    hSubMenu = Api_GetSubMenu(hMenu, 0)    'サブメニューのハンドルを取得
    ClickMenuItem mWnd, hSubMenu, 1        'サブメニューの1番目
    pa.x = &HFFFF / 2
    pa.y = &HFFFF / 2

    MouseClick pa
End Sub

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