رنگي کردن پشت زمينه Menu Editor

[MohammadGh2011]

با سلام خدمت تمامي دوستان و اساتيدان گرامي
چگونه ميتوانم مينويي که با چند زيرشاخه درست کردم رنگ پشت زمينه ي آن را عوض کنم؟
خودم بسيار تلاش کردم نميشه.آيا امکان دارد که بتوان چنين کاري را در VB انجام داد؟



با تشکر

[sajjad_india]

http://www.vbaccelerator.com/home/VB/Code/Controls/Menus/index.asp

[MohammadGh2011]

سلام
ممنونم من تو خوندن متن انگليسي اون سايت مشکلي ندارم ولي نميدونم از کدوم کدها بايد استفاده کنم
ميشه يه توضيح مختصر خودتون بديد.

[محسن واژدی]

سلام علیکم
از کد زیر برای تغییر دادن زمینه منو های فرم استفاده کنید:

Option Explicit

Private Const MIM_BACKGROUND As Long = &H2
Private Const MIM_APPLYTOSUBMENUS As Long = &H80000000

Private Type MENUINFO
cbSize As Long
fMask As Long
dwStyle As Long
cyMax As Long
hbrBack As Long
dwContextHelpID As Long
dwMenuData As Long
End Type

Private Declare Function DrawMenuBar 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 GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetMenuInfo Lib "user32" (ByVal hMenu As Long, MI As MENUINFO) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long


Private Sub Form_Load()
Dim MI As MENUINFO

With MI
.cbSize = Len(MI)
.fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS
.hbrBack = CreateSolidBrush(RGB(230, 253, 22))
SetMenuInfo GetSubMenu(GetMenu(Me.hWnd), 0), MI
End With

DrawMenuBar Me.hWnd

End Sub


موفق باشید

[MohammadGh2011]

سلام علیکم
از کد زیر برای تغییر دادن زمینه منو های فرم استفاده کنید:
سلام آقاي واژدي نميشه همش ارور ميده

[محسن واژدی]

سلام
چه خطایی میده، چون پیش من مشکلی نداره

[MohammadGh2011]

سلام
چه خطایی میده، چون پیش من مشکلی نداره
سلام آقاي واژدي
از کدهايي که تو فورم لود گذاشتين يکي يکي خطا ميگيره.
ببخشيد من بايد تو کدها کاري بکنم؟آخه من همين جوري کپي شون کردم هيچ دستي به کدها نزدم.


ممنون

[محسن واژدی]

اگه خطای Not defiend میدهد بیشتر مشکل از وی بی هست،
اگر ممکن است متن پیام خطا را هم ضمیمه کنید

[MohammadGh2011]

درست شد آقاي واژدي
من براي منوم زيرشاخه نگذاشته بودم.ممنونم

فقط من وقتي از يک منو بيشتر استفاده ميکنم منوي بعدي رو رنگي نميکنه فقط منوي اولي رو رنگي ميکنه!!!!!!!!!!؟

[محسن واژدی]

کد زیر را جایگزین کد قبل کنید:

Option Explicit



Private Const MIM_BACKGROUND As Long = &H2

Private Const MIM_APPLYTOSUBMENUS As Long = &H80000000



Private Type MENUINFO

cbSize As Long

fMask As Long

dwStyle As Long

cyMax As Long

hbrBack As Long

dwContextHelpID As Long

dwMenuData As Long

End Type



Private Declare Function DrawMenuBar 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 GetMenu Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function SetMenuInfo Lib "user32" (ByVal hMenu As Long, MI As MENUINFO) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Sub Form_Load()
Dim get_hnd&
Dim i&
Dim MI As MENUINFO

With MI

.cbSize = Len(MI)

.fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS

.hbrBack = CreateSolidBrush(RGB(230, 253, 22))
End With

Do
get_hnd& = GetSubMenu(GetMenu(Me.hWnd), i)

If get_hnd& > 0 Then
i = i + 1
SetMenuInfo get_hnd&, MI
End If

Loop Until get_hnd& = 0

DrawMenuBar Me.hWnd
End Sub


موفق باشید

[MohammadGh2011]

سلام
بازم چند تا از کدها رو قرمز کرده و باز نميکنه
مهم نيست از همون اولي استفاده ميکنم

باتشکر

[محسن واژدی]

سلام
ممکن است مشکل از وی بی باشد، چون اینجا مشکلی نداره، البته ویندوز بنده xp هست

موفق باشید