قراردادن عکس کنار گزينه های منو

[سید حمید حق پرست]

سلام چطور میتونم به گزینه های menu عکس اختصاص بدم (عکس های کوچیک کنار گزینه هارو می گم) ممنون:لبخند:

[سید حمید حق پرست]

اینم نمونه سورسی که تو گوگل سرچ کردم ولی ارور میده دوستان اگه ممکنه برسی کنید

[محسن واژدی]

سلام
کد زیر را در یک ماژول کپی کنین:

Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) 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 Const MF_BYPOSITION = &H400&

Public Sub AddMenuIcon(fForm As Form, sMenuItemTarget$, oBitmap As Picture)
Dim lMnu&, lSMnu&, i%, sMnuPosLst$()
'
'
'==================================
'left and right validating
'==================================
Do
If Left(sMenuItemTarget$, 1) = "\" Then
sMenuItemTarget$ = Mid(sMenuItemTarget$, 2)
Else
Exit Do
End If
Loop Until Not Left(sMenuItemTarget$, 1) = "\"
Do
If Right(sMenuItemTarget$, 1) = "\" Then
sMenuItemTarget$ = Left(sMenuItemTarget$, Len(sMenuItemTarget$) - 1)
Else
Exit Do
End If
Loop Until Not Right(sMenuItemTarget$, 1) = "\"
'==================================
'
'
'
lMnu& = GetMenu(fForm.hwnd)
lSMnu& = lMnu&
sMnuPosLst$ = Split(sMenuItemTarget$, "\")

For i% = LBound(sMnuPosLst$) To UBound(sMnuPosLst$) - 1
lSMnu& = GetSubMenu(lSMnu&, CLng(Val(sMnuPosLst$(i))))
Next 'i%

SetMenuItemBitmaps lSMnu&, sMnuPosLst$(UBound(sMnuPosLst$)), MF_BYPOSITION, oBitmap, oBitmap
End Sub


برای افزودن تصویر به یک آیتم آدرس را مشابه نمونه زیر وارد کنید

AddMenuIcon Me, "0\1\1", Picture1.Picture

همانطور که مشاهده میکنید آدرس آیتم مورد نظر را بصورت "0\1\1" مینویسیم، اولین عدد یعنی 0 شماره منوی اصلی و مابقی شماره آیتم های submenu است

به عنوان مثال اگر لیست منوی ما بصورت زیر باشد:


File
....New
....Open
....ListOptions
........AddNew
........Refresh

و ما بخواهیم آیکونی را برای آیتم Open اختصاص دهیم، بایستی دستور را بصورت زیر تعریف کنیم:

AddMenuIcon Me, "0\1", Picture1.Picture

که 0 شماره منوی File و 1 موقعیت مکانی آیتم Open است


یا برای اختصاص دادن آیکونی بر روی آیتم Refresh که خود زیر منوی ListOptions است:

AddMenuIcon Me, "0\1\1", Picture1.Picture



برای مابقی منوها و زیرمنوها هم به همین صورت است

موفق باشید

[سید حمید حق پرست]

ممنون از پاسخ شما
اگه واسه منو شماره 1 و زیر منو زیر منوش بخوام اینکارو بکنم خطا میده اینم کد :
AddMenuIcon Me, 1, 0, 0, Picture1.Picture

[محسن واژدی]

اگه خطای Type mismatch میدهد، چون یکی از پارامترها اضافی هست، که باید بصورت زیر اصلاح بشن:

AddMenuIcon Me, 1, 0, Picture1.Picture
یک مطلب دیگه هم که فکر میکنم بهتر باشد، دستگیره خطا را در روال AddMenuIcon غیرفعال کنیم (همون OnErrorResumeNext)

موفق باشید

[ho3ein.3ven]

اگه ممکنه یک نمونه بزارید

[سید حمید حق پرست]

سلام داداش . منظورمو متوجه نشدید

مثلا یه منو file درست میکنیم و send زیر منو file و email زیر منو send . حالا اگه بخوایم واسه منو send بخوایم ایکون بزاریم کدشو چه جوری بنویسیم

امیدوارم خوب توضیح داده باشم

[سید حمید حق پرست]

بیا اینم نمونه پروژه . تشکرو بزنی

[سید حمید حق پرست]

تورو خدا کمکم کنییییییییید

[محسن واژدی]

سلام
کد جدید را با توضیحات استفاده جایگزین پست 3 کردم

موفق باشید

[سید حمید حق پرست]

خودم پیدا کردم دوستان

[IranVB]

خیلی ممنون آقای واژدی کد خیلی مفیدی بود، خیلی کارم را آسان کرد

[alizanganeh]

آقا من میخوام واسه منوی file که اولین منو هست و open که اولین زیرمنو از منوی file ه یک آیکون بزارم
ولی نمیشه و وقتی 3 عدد میشه (0و1و1) پیغام type mismatvh میده و از سومی اشکال میگیره
چه کنم ؟

[محسن واژدی]

آقا من میخوام واسه منوی file که اولین منو هست و open که اولین زیرمنو از منوی file ه یک آیکون بزارم
ولی نمیشه و وقتی 3 عدد میشه (0و1و1) پیغام type mismatvh میده و از سومی اشکال میگیره
چه کنم ؟
سلام
چون منوی File اولین منو است، پس موقعیت مکانی آن میشود: 0
و چون گزینه Open موجود در منوی File هم در بالای منو قرار دارد پس موقعیت مکانی این هم میشود: 0
در پایان کدمان را بصورت زیر مینویسیم:

AddMenuIcon Me, "0\0", Picture1


موفق باشید

[alizanganeh]

داداش اینو میدونم
میگم یعنی نمیشه خود open یک زیر منو داشته باشه و به اونم آیکون بدیم؟

[سید حمید حق پرست]

چرا میشه :

AddMenuIcon Me, "0\0\0", Picture1

[alizanganeh]

اینو زدم ارور میده کلا
وقتی با \ مینویسیم که اشتباهه فکر میکنم به AddMenuIcon گیر میده و میگه arguman not optional
و هم بینشون , میزاریم به عدد صفر سومی گیر میده و میگه type mismatch

[محسن واژدی]

سلام
برنامه رو دیباگ کنید تا معلوم بشه مشکل از چه قسمتی هست، یا بخشی از سورس که به مشکل برخورد کردین را ضمیمه کنید تا بررسی کنیم
موفق باشید

[سید حمید حق پرست]

اینم نمونه سورس . بدون مشکل

موفق باشی

یا علی(ع)

[محسن واژدی]

همینطور اگر قبل و آخر مسیر منو "\" اضافی قرار داده باشیم خطای mismatch میدهد اگر منو هدف را به اینصورت آدرس دهی کرده اید مشکل میتواند از این مورد باشد،
کد ویرایش شده جدید که این مورد را هم اعتبار سنجی و برطرف میکند را ضمیمه پست 3 کردم، یعنی اگر حتی مسیر منو بصورت "\0\2\2\1\" هم نوشته شود مشکلی ایجاد نمیشود
موفق باشید

[سید حمید حق پرست]

اینم یه روش دیگه بدون ماژول :


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 SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Private Sub Form_Load()
Dim hMenu As Long, hSubMenu As Long
hMenu = GetMenu(Form1.hwnd)
hSubMenu = GetSubMenu(hMenu, 0)
SetMenuItemBitmaps hSubMenu, 2, MF_BYPOSITION, Image1(2).Picture, Image1(2).Picture
SetMenuItemBitmaps hSubMenu, 3, MF_BYPOSITION, Image1(5).Picture, Image1(5).Picture
SetMenuItemBitmaps hSubMenu, 4, MF_BYPOSITION, Image1(7).Picture, Image1(7).Picture
SetMenuItemBitmaps hSubMenu, 5, MF_BYPOSITION, Image1(8).Picture, Image1(8).Picture
SetMenuItemBitmaps hSubMenu, 6, MF_BYPOSITION, Image1(4).Picture, Image1(4).Picture
SetMenuItemBitmaps hSubMenu, 7, MF_BYPOSITION, Image1(6).Picture, Image1(6).Picture
SetMenuItemBitmaps hSubMenu, 8, MF_BYPOSITION, Image1(3).Picture, Image1(3).Picture
SetMenuItemBitmaps hSubMenu, 9, MF_BYPOSITION, Image1(1).Picture, Image1(1).Picture
End Sub


اینم سورس کامل

[alizanganeh]

آقا نمیشه و بازم همون ارور ها رو میده
و انی برنامه ای هم که گذاشتی که باز برای منوی اصلیه
من میخوام به زیر منو ها آیکون بدم عزیزم

[سید حمید حق پرست]

سورستو بزار اینجا تا درست کنم واست

یا علی

[محسن واژدی]

سلام
نمونه زیر را که از روی پست 3 نوشته شده است را هم بررسی کنید
موفق باشید