اين هم کد اجرا کردن منو يک پنجره. به دو صورت
کد:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long '
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_COMMAND = &H111
Sub RunMenu(lngwindow As Long, strmenutext As String)
Dim intLoop As Integer, intSubLoop As Integer, intSub2Loop As Integer, intSub3Loop As Integer, intSub4Loop As Integer
Dim lngmenu(1 To 5) As Long, lngcount(1 To 5) As Long, lngSubMenuID(1 To 4) As Long, strcaption(1 To 4) As String
lngmenu(1) = GetMenu(lngwindow&)
lngcount(1) = GetMenuItemCount(lngmenu(1))
For intLoop% = 0 To lngcount(1) - 1
DoEvents
lngmenu(2) = GetSubMenu(lngmenu(1), intLoop%)
lngcount(2) = GetMenuItemCount(lngmenu(2))
For intSubLoop% = 0 To lngcount(2) - 1
DoEvents
lngSubMenuID(1) = GetMenuItemID(lngmenu(2), intSubLoop%)
strcaption(1) = String(75, " ")
Call GetMenuString(lngmenu(2), lngSubMenuID(1), strcaption(1), 75, 1)
If InStr(LCase(strcaption(1)), LCase(strmenutext$)) Then
Call SendMessage(lngwindow&, WM_COMMAND, lngSubMenuID(1), 0)
Exit Sub
End If
lngmenu(3) = GetSubMenu(lngmenu(2), intSubLoop%)
lngcount(3) = GetMenuItemCount(lngmenu(3))
If lngcount(3) > 0 Then
For intSub2Loop% = 0 To lngcount(3) - 1
DoEvents
lngSubMenuID(2) = GetMenuItemID(lngmenu(3), intSub2Loop%)
strcaption(2) = String(75, " ")
Call GetMenuString(lngmenu(3), lngSubMenuID(2), strcaption(2), 75, 1)
If InStr(LCase(strcaption(2)), LCase(strmenutext$)) Then
Call SendMessage(lngwindow&, WM_COMMAND, lngSubMenuID(2), 0)
Exit Sub
End If
lngmenu(4) = GetSubMenu(lngmenu(3), intSub2Loop%)
lngcount(4) = GetMenuItemCount(lngmenu(4))
If lngcount(4) > 0 Then
For intSub3Loop% = 0 To lngcount(4) - 1
DoEvents
lngSubMenuID(3) = GetMenuItemID(lngmenu(4), intSub3Loop%)
strcaption(3) = String(75, " ")
Call GetMenuString(lngmenu(4), lngSubMenuID(3), strcaption(3), 75, 1)
If InStr(LCase(strcaption(3)), LCase(strmenutext$)) Then
Call SendMessage(lngwindow&, WM_COMMAND, lngSubMenuID(3), 0)
Exit Sub
End If
lngmenu(5) = GetSubMenu(lngmenu(4), intSub3Loop%)
lngcount(5) = GetMenuItemCount(lngmenu(5))
If lngcount(5) > 0 Then
For intSub4Loop% = 0 To lngcount(5) - 1
DoEvents
lngSubMenuID(4) = GetMenuItemID(lngmenu(5), intSub4Loop%)
strcaption(4) = String(75, " ")
Call GetMenuString(lngmenu(5), lngSubMenuID(4), strcaption(4), 75, 1)
If InStr(LCase(strcaption(4)), LCase(strmenutext$)) Then
Call SendMessage(lngwindow&, WM_COMMAND, lngSubMenuID(4), 0)
Exit Sub
End If
Next intSub4Loop%
End If
Next intSub3Loop%
End If
Next intSub2Loop%
End If
Next intSubLoop%
Next intLoop%
End Sub
Private Sub Command1_Click()
Dim R As Long
R = FindWindow("YahooBuddyMain", vbNullString)
RunMenu R, "Send an Instant &Message..."
End Sub
اين هم روش دوم که ساده تره
کد:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_COMMAND = &H111
Private Sub Command1_Click()
Dim R As Long
R = FindWindow("YahooBuddyMain", vbNullString)
SendMessage R, WM_COMMAND, GetMenuItemID(GetSubMenu(GetMenu(R), 2), 1), 0
End Sub
findwindow = اين تابع برای پيدا کردن هندل يک پنجره هست.
IpClassName: نام کلاس پنجره
IpWindowName: کپشن پنجره
برای پيدا کردن هندل پنجره وارد کردن يکی از اينها کافيه.
getmenu = اين تابع تمام آيتم های يک منوبار يک پنجره را پيدا ميکند.
hwnd: هندل پنجره مورد نظر
getmenuitemid = اين تابع برای پيدا کردن آی دی آيتم يک منو هست.
hmenu: يک اشاره کار از منو مورد نظر
npos: شماره آيتم منو مورد نظر
getsubmenu: اين تابع برای به دست آوردن يک اشاره گر از زير منوی موجود در يک منوی ديگر هست.
hmenu: اشاره کار منو مورد نظر
npos: شماره آيتم زير منو
sendmessage: اين تابع برای فرستادن دستور هست.
فرق روش اول و دوم اينه که در روش اول بايد اسم زير منو مورد نظر رو بديد و شماره منو را به دست مياره (اين روش رو من ننوشتم)
ولی در روش اول شماره منو و زير منو را بايد وارد کنيد.
نقل قول: تابع getmenu فقط يك پارامتر به عنوان ورودي ميگيره اما شما دو تا ورودي داري بهش ميدي !!!
من امتحان كردم خطا مي گيره !؟
من اشتباهن نام RunMenu رو GetMenu گزاشتم
يک بار ورودی ميگيره نه دو بار يکيش تعريف هست