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

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

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

Mnu

Mnu	Title
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

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

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

برداشتن منو بار

Remove window's current menu

SetMenu lHwnd,0