کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

به اشتراک گذاری اطلاعات کسب شده در اکسس از سایت آفیس و سایت های تخصصی خارجی
کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

به اشتراک گذاری اطلاعات کسب شده در اکسس از سایت آفیس و سایت های تخصصی خارجی

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



در فرم یک در بالای فرم در نمای دیزاین ۳ لیبل طراحی شده  از M0 تا M2 بعنوان منو ، هفت لیبل دیگر بطور زیرهم بعنوان ساب از S0 تا S7 ایجاد شده و کنار آنها دوباره هفت لیبل دیگر بعنوان ساب ساب از SS0 تا SS7 قرارداده شده ، در انتهای لیبل های بعنوان ساب  ( S0 تا S7 ) دوباره 7 لیبل از Z0 تاZ7 ایجاد شده برای قرار دادن فلشها در کپشن آنها پس جمعا    ( 1X3+3X7 )


ترتیب فیلدها ازراست به چپ است اینجا برعکس افتاده 

Mnu
MnuTitle
M0ایران
M1اکسس
M2پروفسور




در فیلد Type زمانیکه DropDown مشخص شود زمان فشرده شدن هر کدام از لیبل هایی که زیر لیبل های بالایی قرار می گیرند  در تابع SubClk گفته شده اگر این کلمه بود ( با تابع DlookUp ) ، لیبل های دیگری که بعنوان SS درنظر گرفته شده در زیر آن لیبل ساب قرار گیرند و اگر فیلد Type خالی بود لیبل های با پیشوند SS که از 0 تا 7 است در کنار آن لیبل های ساب و کمی پایین تر با استفاده از پراپرتی Visible مشاهده خواهند شد.

Sub
Mnu Sub Title Type
M0 S0 Access
M1 S0 VBA
M1 S1 Menu
M2 S0 AccessVba
M2 S1 .
M2 S2 BlogSky DropDown
M2 S3 .
M2 S4 Com




SubSub
Mnu Sub SubSub Title
M0 S0 SS0 MNU0SUB0SUB0
M0 S0 SS1 MNU0SUB0SUB1
M0 S0 SS2 MNU0SUB0SUB2
M0 S0 SS3 MNU0SUB0SUB3
M0 S0 SS4 MNU0SUB0SUB4
M1 S1 SS0 MNU1SUB1SUB0
M1 S1 SS1 MNU1SUB1SUB1
M2 S0 SS0 MNU2SUB0SUB0
M2 S0 SS1 MNU2SUB0SUB1
M2 S0 SS2 MNU2SUB0SUB2
M2 S0 SS3 MNU2SUB0SUB3
M2 S0 SS4 MNU2SUB0SUB4
M2 S0 SS5 MNU2SUB0SUB5
M2 S0 SS6 MNU2SUB0SUB6
M2 S1 SS0 MNU2SUB1SUB0
M2 S2 SS0 MNU2SUB2SUB0
M2 S2 SS1 MNU2SUB2SUB1
M2 S3 SS0 MNU2SUB3SUB0
M2 S3 SS1 MNU2SUB3SUB1
M2 S3 SS2 MNU2SUB3SUB2
M2 S3 SS3 MNU2SUB3SUB3


استفاده از یونیکد برای فلش ها : 

(Chrw(9658

(Chrw(9650

(Chrw(9660


از دوتابع   MnuClk و SubClk استفاده شده که تابع اول برای زمانیست که روی لیبل های بالایی ( بعنوان منو ) رویداد کلیک باصطلاح فایر شود و لیبل های پایینی مشاهده شوند یا نشوند ( ذخیره 1 در پراپرتی Tag کنترل منو زمانیکه که لیبل فشرده شد   ) و دومی برای انجام رویداد کلیک لیبل هایی که در پایین  لیبل های بالایی قرار می گیرند ، برای تغییر رنگ لیبل های ساب هم  از تابع SubMouseMove استفاده شده.



شرح تابع SubClk ، تابعی که زمان فشرده شدن یکی از هفت لیبل های بانام S0 تا S7 باید وظیفه ای را انجام دهد یا باز کردن فرم و گزارش خاصی و یا هر عمل دیگری و یا خودش زیر منوهایی در دل خودش داردکه باید در زیر یا کنار آن Visible شوند : 


نکته : زمان فشرده شدن لیبل های بالایی ( M0 تا M2 ) باید نام لیبل فشرده شده ( تابع MnuClk ) را در متغیری ذخیره کرد چرا ؟ بخاطر اینکه باید در عبارت پایینی که توضیح داده شده استفاده کرد ( یعنی باید در جدول Sub و منوی فشرده شده طبق فیلد Mnu پیدا کند که فیلد Type حاوی رشته ی DropDown است یا خیر!!! )


در شروع تابع می بایست در نظر گرفت اگر سابی فشرده شد که طبق منوی فشرده شده در فیلد Type آن DropDown بود به چه نحو عمل شود که زمان لوپ زدن در SS0 تا SS7  بفهمانیم باید لیبل های ساب زیر ساب فشرده شده به پائین تر منتقل شده تا لیبل های SS0 تا SS7 جای خالی آنها قرار گیرند برای اینکار از تابع DlookUp استفاده می کنیم 


PP متغیریست که عدد انتهای لیبل ساب فشرده شده ( با پیشوند S  ) را در خود ذخیره میکند و در پائین بردن لیبل های ساب بعد از لیبل ساب فشرده شده بما کمک خواهد کرد.


("","PP=Replace(C.Name,"S

تابع زیرطبق گفته بالا چک میکند که فیلد Type در جدول Sub طبق منوی فشرده شده و برابر بودنش با فیلد Mnu معادل DropDown است یا Null  متغیر Mn در اول رویه تعریف شده و در تابع MnuClk مقدار میگیرد چون برای LookUp به نام منو نیاز داریم 

"  if DlookUp("Type","Sub","Mnu='" & Mn  & "'")="DropDown Then

متغیر Drop نوع Boolean یا میتواند عددی باشد Integer 

Drop=True

End If


در بعد از لوپ می بایست در یک متغیر لیبل فشرده شده را ذخیره کرد و در قبل از لوپ نوشت تا درصورتیکه لیبل فشرده شده   مخالف مقدار آن متغیر بود Z برابر یک شود 


 در اینجا می توانید از دو متغیر SubCount و SubSubCount استفاده کنید


( "'" & SubCount=Dcount("Sub","Sub","Mnu='" & C.Name


 از SubSubCount برای شمارش تعداد لیبل هایی  ( SS0 تا SS 7 طبق جدول SubSub و لیبلی  که [ بعنوان منو ]  کلیک   و در Mn ذخیره شده ) که باید ویزیبل شوند استفاده میشود حال نحوه ی استفاده چطور است ؟ 


توضیح : 


در لوپی که در SS ها زده میشود (  با استفاده از For ... Next ) از 0 تا 7  باید گفته شود اگر Drop برابر Yes شود  لیبل های سابی که بزرگتر از کنترل ساب فشرده شده بود به بعد از تعداد SubSub های شمرده شده در جدول SubSub برود بطور مثال اگر منوی 2 پنج Sub ( شروع از S0 تا S4 )  داشت زمان فشرده شدن لیبل با نام  S2 ( از منوی با نام M2 ) بقیه ی آنها یعنی S3 و S4 به تعداد کانت  فیلد SubSub در همین جدول پائین برود باضافه ی ارتفاع کنترل فشرده شده .  درضمن باید بفکر این هم باشید که اگر همان کنترل S2 که عمل کرده دوباره فشرده شود کنترل های S3 و S4 به همان موقعیت قبل برگردد و پراپرتی Visible کنترل ها ی SS0 تا SS7 نیز برابر صفر شود ،  پس باید متغیری نوشت از نوع Static یا در Tempvars ذخیره کرد


در اینجا باید DlookUp بنویسید که پراپرتی ویزیبل SS ها طبق جدول SubSub مخالف عددی غیر از صفر شوند تا قابل مشاهده شوند 


If Drop=Yes Then 

باید روی  لیبل های بعد از لیبل فشرده شده اعمال شود بخاطر همین باضافه یک کردیم 

PP=PP+1 

اگر لیبل فشرده شده ( در اینجا فرضا عدد PP دو است و باضافه ی یک شده ) کمتر از SubCount که 5 است شد و برای یکبار هم فشرده شد (""= Z)  پراپرتی Top کنترل 3 میشود مقدار پراپرتی Top کنترل 3 باضافه ارتفاع کنترل فشرده شده در تعداد SS ها که در زیر S2 باید قرار گیرند 


if PP<SubCount And  Z=1 Then 

Controls("S" & PP).Top=Controls("S" & PP).Top+c.Height*SubSubCount


حال در اینجا باید ذکر کرد طبق If بالا Z=1 شد یعنی لیبل S2 دوباره فشرده شد لیبل های S3 و S4 به موقعیت اول برگردند فرضا از پراپرتی Tag این لیبل ها استفاده کنید و در تابع MnuClk در لوپ زده شده اعلام کنید که Tag کل لیبل های S بشود مقدار پراپرتی Top آنها. در ضمن پراپرتی ویزیبل لیبل با پیشوند SS باید صفر شود.


End If 

و در اینجا لفت ها را تعیین میکنید


در غیر اینصورت اگر Drop برابر Yes نبود مقدار Top و Left لیبل های SS تنطیم میشود که در پهلوی لیبل S  دار قرار گیرند 



پیشوند لیبل منو M

پیشوند لیبل ساب که در زیر لیبل منو قرار میگیرد S

پیشوند لیبل سابی که در کنارلیبل ساب یا زیر آن قرار می گیرد SS

پیشوند لیبلی که در کپشن آن فلش های بالا پایین و راست  قرار می گیرد Z





ساخت منو با لیبل در فرم اکسس


دو جدول ساخته شد یکی شامل دو فیلد Mnu و Title برای رکورد کردن  نامگذاری منوها و عنوان آنها ، در شکل زیر لیبل از سمت راست به چپ با نام های M0 تا M2  می باشند.



جدول Sub با فیلدهای Mnu ، Sub ، Title که نام های منو  ساب منو و عنوان ساب منو در آن رکورد میشوند، نامگذاری لیبل های زیر منو طبق تصویر از S0 تا S7 است.




دستور کار : 

1-تعریف متغیر M در بالاترین رویه برای ذخیره کنترل فشرده شده 

2-تعریف متغیر MnuBkColor در بالاترین رویه برای ذخیره کردن BackColor کنترل لیبل منو که  System Menu Bar تنظیم شده 

3-زمان لود شدن فرم مقدار متغیر MnuBkColor برابر با پراپرتی BackColor یکی از لیبل ها شود فرضا   M0.BackColor

در هرکدام از رویدادهای کلیک لیبل های شکل یک بعنوان منو یک تابع نوشته شده به ترتیب زیر :

 

1-در تابع اگر کنترل فشرده شده مخالف M  و M نال نبود سپس  پراپرتی BackColor مقداری که در M ذخیره شده بشود  

2-تنظیم پراپرتی BackColor کنترل فشرده شده به (RGB(160,200,160

3-برابر کردن M با کنترل فشرده شده 

4-بخاطر اینکه زمان فشرده شده روی منو اگر قبلا فشرده نشده پراپرتی Tag آن تغییر یابد ( برای نمایش یا ویزیبل شدن sub ها و یا ویزیبل نشدنشان ) نوشت  اگر پراپرتی Tag کنترل فشرده شده برابر "" شود به 1 تغییریابد در غیر اینصورت دوباره Tag یک شود

5-لوپ در کنترل های Sub با For.....Next از 0 تا 7 مثل    For i=0 To 7

6-در اینجا مقادیر پراپرتی Tag کنترل فشرده شد ( منو ) کاربرد دارد که اگر یک باشدمی بایست لیبل های Sub   طبق جدول  نامشان ویزیبل شوند وبقیه که در لود فرم نوشتیم کلا Visible=No همان No باشند 

_  & " Me.Controls("s" & i).Visible = IIf(DLookup("Sub", "Sub", "mnu='" & c.Name & "' and

(Sub='" & Controls("s" & i).Name & "'") <> "", True, False"

 _&  " Me.Controls("s" & i).Caption = Nz(DLookup("Title", "Sub", "mnu='" & c.Name & "' and

"'" &  Sub="'" & Controls("s" & i).Name

Me.Controls("s" & i).Left = c.Left

(Me.Controls("s" & i).BackColor = RGB(160, 200, 160

در غیر اینصورت پراپرتی Visible کل لیبل های Sub به No تنظیم شوند که هاید شوند و پراپرتی BackColor کنترل فشرده شده ( منو ) نیز به MnuBkColor تنظیم شود 

کالر لیبل های سابی ( منظور لیبل های عمودی ) که به آبی تغییر پیدا می کنند از رویداد MouseMove آنها استفاده شده و در اینجا هم نیاز به ذخیره کردن نام ساب در یک متغیر است برای مقایسه کردن و تغییر رنگ به جدید و برگرداندن به رنگ قبلی 


دور لیبل های بالا بعنوان منو با کنترل لاین که در نوار Design فرم است  کشیده شده 










Button Menu




docs.appendmenua


(SubclassWindow(hWnd

Somewhere in WM_INITDIALOG handler 

(btnMenu =GetDlgItem(IDC_BTN_ABOUT

("btnMenu.AddMenuItem(IDC_MNU_ONE,"Windows
("btnMenu.AddMenuItem(IDC_MNU_TWO,"Template
(btnMenu.AddMenuItem(IDC_MNU_THREE,"",MF_SEPARATOR
("btnMenu.AddMenuItem(IDC_MNU_FOUR,"Library

نمایش BITMAP نزدیک به منوآیتم ( سایت آفیس NEXT MENU ITEM )

 این ویژگی ( Feature ) تست نشده و فقط طبق سند آفیس و جذاب بودنش در این صفحه درج شده .


To add a new bitmap item to a menu, use the MF_BITMAP flag with the InsertMenu or AppendMenu
 function.


MF_BITMAP=&H4 
'Uses a bitmap as the menu item. The lpNewItem parameter contains a handle to the bitmap.


InsertMenuA hMenu,uPosition:6,uFlags:MF_BYPOSITION+MF_BITMAP, 
uIDNewItem:6,lpNewItem:Handle To Bitmap




DrawMenuBar hSysMenu/hMenu/hSubMenu

setmenuitembitmaps hSysMenu, 5, &H400, loadimage(image_Bitamp), loadimage(image_Bitamp



MENUBARINFO



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

Type MENUBARINFO
     cbSize As Long
     rcBar As rect
     hMenu As Long
     hwndMenu As Long
     fBarFocused As Boolean
     fFocused As Boolean
End Type

Public Const OBJID_MENU As Long = &HFFFFFFFD
Pubic Const OBJID_SYSMENU As Long = &HFFFFFFFF


Dim mbi as MENUBARINFO
mbi.cbSize=LenB(mbi)
GetMenuBarInfo Me.hWnd,OBJID_MENU, lMenuNumber, mbi

Where "lMenuNumber" is 1 for the first (e.g. "File"), 2 for the second (e.g. "Edit"), etc.

rcBar.Left

کپی تکست استرینگ آیتم منو داخل بافر مشخص شده










موارد ستاره دار مهم هستند که اگر Fail دهد جواب صفر است  و اگر cchMax صفر در نظر گرفته شود تابع طول استرینگ  را بر خواهد گرداند درصورتیکه که Fail ندهد یعنی مقدار برگشتی صفر نشود


***cchMax : 

If nMaxCount is 0, the function returns the length of the menu string


***Return Value


If the function succeeds, the return value specifies the number of characters copied to the buffer, not including the terminating null character.

If the function fails, the return value is zero.

If the specified item is not of type MIIM_STRING or MFT_STRING, then the return value is zero




Dim mii As MENUITEMINFOA

(mii.cbSize=Len(mii
mii.fmask=&H40  ' MIIM_STRING
mii.ftype=&H0      ' MFT_STRING
""=mii.dwTypedata
mii.cchMax=0

GetMenuItemInfo hMenu,0,True,mii
(mii.cbSize=Len(mii'
mii.fmask=&H40'
mii.fType=&H0'
(mii.dwTypedata=String$(cchMax,vbNullChar
mm.cchMax=mii.cchMax+1

GetMenuItemInfo hMenu,0,True,mii

و  در آخر گرفتن کپشن با Mid



GetMenuStringA(hMenu,uIDItem,lpString, cchMax,flags)

If the specified item is not of type MIIM_STRING or
. MFT_STRING, then the return value is zero

lpString

Type: LPTSTR

The buffer that receives the null-terminated string. If the string is as long or longer than lpString, the string is truncated and the terminating null character is added. If lpStringis NULL, the function returns the length of the
 .menu string



 Note  The GetMenuString function has been****
superseded. Use the GetMenuItemInfo function to retrieve the menu item text

خالی کردن حافظه مشخص شده



GlobalFree function globalfree globalalloc

Frees the specified global memory object and invalidates its handle

(pSD=GlobalAlloc(GHND,Len(MyString)+1
(GlobalFree(pSD

Dim pSD As LongPtr
$MyString
"MyString="MyClose
(pSD=GlobalAlloc(GHND,Len(MyString)+1
Dim mii As MENUITEMINFOA
With mii
       (cbSize = Len(mii
      .fMask = &H40 Or &H100 '       miim_string Or miim_ftype
      .fTyp=MFT_STRING
       "dwtypedata =pSD    ' "MyClose
       cch = Len(MyString) + 1
      End With
  
SetMenuItemInfoA hSysMenu, SC_CLOSE, 0,mii
GlobalFree pSD



Private Sub Form_Load()
    Dim s As String
    '
    s = ChrW(&HCD38) & ChrW(&HC988) & ChrW(&HBD38) & ChrW(&H7EBA)
    ModifyMenuW GetMenu(Me.hwnd), 0, MF_BYPOSITION, 0, ByVal StrPtr(s)
End Sub

ثابت های Bitmap آیتم منو در MenuIteminfoA

 D:  Means Disabled


HBMMENU_SYSTEM = 1
HBMMENU_MBAR_RESTORE = 2
HBMMENU_MBAR_MINIMIZE = 3
HBMMENU_MBAR_CLOSE = 5

HBMMENU_MBAR_CLOSE_D = 6

 HBMMENU_MBAR_MINIMIZE_D = 7
HBMMENU_POPUP_CLOSE = 8
HBMMENU_POPUP_RESTORE = 9
HBMMENU_POPUP_MAXIMIZE = 10
HBMMENU_POPUP_MINIMIZE = 11

MF_GRAYED=&H1  : MF_DISABLED=&H2 : MF_BYPOSITION=&H40
Dim Hicon As IntPtr = img.GetHbitmap
        'remove first item
        RemoveMenu(iMenu, 0, MF_BYPOSITION)
        DrawMenuBar(iMenu)
        'add new item
        InsertMenu(iMenu, 0, MF_BYPOSITION, 0, "Restore")
        DrawMenuBar(iMenu)
        SetMenuItemBitmaps(iMenu, 0, MF_GRAYED Or MF_BITMAP, Hicon, Hicon)
        'disable
        EnableMenuItem(iMenu, 0, MF_BYPOSITION + MF_DISABLED + MF_GRAYED)
        DrawMenuBar(iMenu)9



استخراج آیکون از فایل DLL یا EXE



ExtractIconExA(lpszFile,nIconIndex, HICON *phiconLarge, HICON *phiconSmall, UINT
( nIcons


nIconIndex : 

If this value is –1 and phiconLarge and phiconSmall are both NULL, the function returns the total number of icons in the specified file


Declare PtrSafe Function DrawIcon Lib "user32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long, ByVal hIcon As LongPtr) As Long


Declare PtrSafe Function DestroyIcon Lib "user32" (ByVal hIcon As LongPtr) As Long


Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongPtr 

نمایش Bitmap کنار منو ( پیوند BitMap مشخص شده به آیتم منو )

Type: HBITMAP

A handle to the bitmap to be displayed, or it can be one of the values in the following table. It is used when the MIIM_BITMAP flag is set in the fMask member


uflags: MF_BYCOMMAND

hBitmap:LoadBitmap,LoadIcon,LoadImage







Dim mim As MENUITEMINFOA

(mim.cbSize = Len(mim

   mim.fMask = MIIM_BITMAP

mim.hbmpitem=1

SetMenuItemInfoA hSysMenu, 6, 1, mim


Use the GetSystemMetrics function with the CXMENUCHECK and CYMENUCHECK values to retrieve the bitmap dimensions.


تصویر بالا با استفاده از تابع زیر ( foo هندلی برای Bitmap ) و   loadimagea ( در آرگومان Type حتما IMAGE_BITMAP  استفاده شود ) بدست آمده  ضمنا  Bitmap ها در Shell32  در اینترنت وجود دارد و می توانید در سیستم خود لود نمایید و مانند زیر استفاده کنید .


windows_7_shell32_dll.shtml


SetMenuItemBitmaps hMenu, 1,MF_BYPOSITION, foo, foo


گرفتن استرینگ آیتم های SystemMenu


در تصویر بالا تعداد آیتم ها عدد 6 است 


szItem As String*100
((szItem=String$(100,Chr(0
(hSysMenu=GetSystemMenu(hwnd
(hSysMenuItmCount=GetMenuItemCount(hSysMenu,0
For i=0 To hSysMenuItmCount
(ItemId=GetMenuItemId(hSysMenu,i
(Length=GetMenuString(hSysMenu,i,szItem,Len(szItem)+1,MF_BYPOSITION
(txt=Left$(szItem,Length
Debug.Print txt,ItemId,i
Next

درباره ی تابع GetMenuString 

If the function succeeds, the return value specifies the number of characters copied to the buffer, not including the terminating null character.

If the function fails, the return value is zero.

If the specified item is not of type MIIM_STRING or MFT_STRING, then the return value is zero.

Remarks

The nMaxCount parameter must be one larger than the number of characters in the text string to accommodate the terminating null character.

If nMaxCount is 0, the function returns the length of the menu string.



درباره تابع  GetMenuItemCount 


Return Value

Type: int

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

If the function succeeds, the return value specifies the number of items in the menu.

If the function fails, the return value is -1


درباره  تابع  GetMenuItemId


Return Value

Type: UINT

مقدار برگشتی شناسه ی آیتم منوی مشخص شده خواهد بود اگر شناسه ی آیتم منو نال یا شامل ساب منو باشد عدد برگشتی 1- است که اثبات و تست شده.  

The return value is the identifier of the specified menu item. If the menu item identifier is NULL or if the specified item opens a submenu, the return value is -1.


درباره تابع ModifyMenu



(idItem=GetMenuItemID(hmenu, uItemPos

ModifyMenu hmenu,idItem,MF_BYCOMMAND+MF_STRING,idItem, szItem


Return Value

Type: BOOL

اگر تابع ( عملکرد ) موفقیت آمیز باشد مقدار برگشتی عددی غیرصفر است خواه مثبت یا منفی  و در صورت عدم موفقیت صفر را برخواهد گرداند.

If the function succeeds, the return value is nonzero

If the function fails, the return value is zero

MENUINFO گرفتن اطلاعات منوبار



Public Const MIM_BACKGROUND As Long = &H2
Public Const MIM_APPLYTOSUBMENUS As Long
&H80000000=
Pubkic Type MENUINFO
cbSize As Long
hbrBack As Long
fMask As Long
dwStyle As Long
cyMax As Long
End Type



.fMask=MIM_BACKGROUND
.hbrBack=CreateSolidBrush(vbYellow)
SetMenuInfo GetMenu(Me.hwnd),mi
.fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS
.hbrBack=CreateSolidBrush(vbCyan)
SetMenuInfo GetSubMenu(GetMenu(Me.hwnd),0),mi
.hbrBack=CreateSolidBrush(vbGreen)
SetMenuInfo GetSubMenu(GetMenu(Me.hwnd),1),mi
.hbrBack=CreateSolidBrush(vbRed)
SetMenuInfo GetSubMenu(GetMenu(Me.hwnd),2),mi









tagMENUITEMINFOA { UINT cbSize; UINT fMask; UINT fType; UINT fState; UINT wID; HMENU hSubMenu; HBITMAP hbmpChecked; HBITMAP hbmpUnchecked; ULONG_PTR dwItemData; LPSTR dwTypeData; UINT cch; HBITMAP hbmpItem;


fMask

MIIM_FTYPE
0x00000100
Retrieves or sets thefType member.
MIIM_ID
0x00000002
Retrieves or sets thewID member.
MIIM_STATE
0x00000001
Retrieves or sets thefState member.
MIIM_STRING
0x00000040
Retrieves or sets thedwTypeDatamember.



fType


MFT_RIGHTJUSTIFY
0x00004000L
Right-justifies the menu item and any subsequent items. This value is valid only if the menu item is in a menu bar.
MFT_RIGHTORDER
0x00002000L
Specifies that menus cascade right-to-left (the default is left-to-right). This is used to support right-to-left languages, such as Arabic and Hebrew.
MFT_SEPARATOR
0x00000800L
Specifies that the menu item is a separator. A menu item separator appears as a horizontal dividing line. ThedwTypeData andcch members are ignored. This value is valid only in a drop-down menu, submenu, or shortcut menu.
MFT_STRING
0x00000000L
Displays the menu item using a text string. ThedwTypeDatamember is the pointer to a null-terminated string, and the cchmember is the length of the string.

MFT_STRING is replaced by MIIM_STRING.



Public Sub SetMenuBackground()
MenuHandle = GetSystemMenu(form.Handle,0)
Dim brush
Brush=CreateSolidBrush(RGB(200,100,200))
Dim mi As MenuInfo
mi.cbSize=Len(MenuInfo)
mi.fMask=&H2
mi.hbrBack=brush
SetMenuInfo(MenuHandle,mi)
End Sub




Private Sub Form_Load()
Dim ret As Long
Dim hMenu As Long
Dim hBrush As Long
Dim lbBrushInfo As LOGBRUSH
Dim miMenuInfo As tagMENUINFO
lbBrushInfo.lbStyle=BS_SOLID
lbBrushInfo.lbColor=RGB(155, 100, 200)
lbBrushInfo.lbHatch = 0
hBrush=CreateBrushIndirect(lbBrushInfo)
hMenu = GetMenu(Me.hwnd)
miMenuInfo.cbSize = Len(miMenuInfo)
ret=GetMenuInfo(hMenu, miMenuInfo) ' 0 means failure
miMenuInfo.fMask =MIM_BACKGROUND
'MIM_APPLYTOSUBMENUS  use this to apply to submenus as well
miMenuInfo.hbrBack=hBrush
ret=SetMenuInfo(hMenu,miMenuInfo) '0 means failure
End Sub

پیام WM_INITMENU برای چک مارک منو آیم



The following example has three menu items and moves the check mark of the menu item each time the menu is opened.



Public Function WndProc (HWND hWnd, UINT iMessage

( WPARAM wParam, LPARAM lParam,

 HDC hdc

PAINTSTRUCT ps

 static int count = 0

 Mes="Checks menu items in order every time the menu is

" opened

 Select Case iMessage

 case WM_INITMENU

  CheckMenuItem (HMENU) wParam

(IDM_MENU1,MF_BYCOMMAND | MF_UNCHECKED , 

,CheckMenuItem (HMENU) wParam, IDM_MENU2,m

( MF_BYCOMMAND | MF_UNCHECKED

CheckMenuItem ((HMENU) wParam, IDM_MENU3, MF_BYCOMMAND | MF_UNCHECKED)

count = (count +1)% 3

CheckMenuItem (HMENU) wParam, IDM_MENU1 + count, MF_BYCOMMAND | MF_CHECKED)

Wndproc=False

case WM_PAINT

(hdc = BeginPaint (hWnd, ps

(TextOut hdc, 10, 10, Mes,len(Mes

  (EndPaint (hWnd,ps

 WndProc=False

case WM_DESTROY

 PostQuitMessage (0

 WndProc=False

Case Else

(Wndproc=DefWindowProc (hWnd, iMessage, wParm,lParam

End Select

Exit Function




Handle Menu در VB


Private Const windowsMenuClassName As String= "#32768

(externalMenu=FindWindowEx(GetDesktopWindow,0,windowsMenuClassName,VbNullString
(PostMessage(externalMenu,WM_CLOSE, 0,0
End If 
End Sub

()Private Sub Timer1_Timer


Dim hMenuWnd As Long
(hMenuWnd = FindWindow ("# 32768", vbNullString
If hMenuWnd <> 0 Then
(( Me.Caption = CStr (SendMessage
(hMenuWnd, MN_GETHMENU, 0, 0
End If
End Sub