در گام دو چند کار نو داریم:
- برای دکمه ها رخداد تعریف میکنیم
- باز و بسته شدن منو رو میسازیم
- یک کم به ظاهر منو میرسیم
فقط دقت کنین که در نمونه پیوست اول با کد فرم رو ساختیم بعد برای فرم کد اضافه کردیم و دستی هم به سر و روی دکمه ها کشیدیم. یعنی اگر مثل گام یک دوباره تابع ساخت فرم رو اجرا کنین کدهای اضافه شده و فرمتینگ کلیدها میپره! البته کد رو اینجا میگذارم و میتونین خودتون دوباره اون ها رو به فرم اضافه کنین.
نسبت به گام یک چند تغییر جزئی داریم که new code مشخص شده
Option Compare Database
Option Explicit
Public Const NavFrm As String = "Navigation"
Public Const twips As Integer = 567
Public L1_Count, L2_Count As Integer
Public L1_Top, L1_Left, L1_Width, L1_Height, L1_Padding As Integer
Public L2_Width, L2_Height, L2_Left, L2_Padding As Integer
Public v As Variant ' new code
Public Sub Read_Parameters()
L1_Count = 10
L2_Count = 8
L1_Top = 1 * twips
L1_Left = 1 * twips
L1_Width = 4 * twips
L1_Height = 0.7 * twips
L1_Padding = 0.3 * twips
L2_Width = 4 * twips
L2_Height = 0.7 * twips
L2_Padding = 0.1 * twips
L2_Left = L1_Left + 0.5 * twips
End Sub
Public Function Create_Navigation_Form() As Boolean
On Error Resume Next
DoCmd.DeleteObject acForm, NavFrm
On Error GoTo error_handler
Read_Parameters
Dim frm As Form
Set frm = CreateForm
Dim Temp_Name As String
Temp_Name = frm.Name
frm.AllowLayoutView = False
frm.NavigationButtons = False
frm.RecordSelectors = False
frm.Width = 20 * twips
frm.Section(0).Height = 16 * twips
Dim Btn As CommandButton
Dim i As Integer
For i = 1 To L1_Count
Set Btn = CreateControl(Temp_Name, acCommandButton, acDetail, "", "", L1_Left, L1_Top + (i - 1) * (L1_Height + L1_Padding), L1_Width, L1_Height)
Btn.Name = "L1_" + Trim(i)
Btn.CAPTION = "Level 1 - item " + Trim(i)
Btn.OnClick = "=L1_Click('" + Btn.Name + "')" ' new code
Next
For i = 1 To L2_Count
Set Btn = CreateControl(Temp_Name, acCommandButton, acDetail, "", "", L1_Left + L1_Width + 2 * twips, L1_Top + (i - 1) * (L2_Height + L2_Padding), L2_Width, L2_Height)
Btn.Name = "L2_" + Trim(i)
Btn.CAPTION = "Level 2 - item " + Trim(i)
Btn.Visible = False ' new code
Next
DoCmd.Close acForm, Temp_Name, acSaveYes
DoCmd.Rename NavFrm, acForm, Temp_Name
Create_Navigation_Form = True
Exit Function
error_handler:
Create_Navigation_Form = False
End Function
و این هم کدهای فرم navigation :
Option Compare Database
Option Explicit
Private Clicked As Integer
Private Sub Form_Load()
Read_Parameters
Clicked = 0
End Sub
Private Function L1_Click(Btn_Name As String)
Dim Btn2 As CommandButton
Dim Offset_Top As Integer
Dim i, n As Integer
n = Replace(Btn_Name, "L1_", "")
For i = 1 To L2_Count
Controls("L2_" + Trim(i)).Visible = (Clicked <> n)
Next
If Clicked = n Then
For i = 1 To L1_Count
Controls("L1_" + Trim(i)).Top = L1_Top + (i - 1) * (L1_Height + L1_Padding)
Next
Clicked = 0
Else
Offset_Top = L1_Top
For i = 2 To n
Offset_Top = Offset_Top + L1_Height + L1_Padding
Controls("L1_" + Trim(i)).Top = Offset_Top
Next
Offset_Top = Offset_Top + L1_Height + L2_Padding
For i = 1 To L2_Count
Set Btn2 = Controls("L2_" + Trim(i))
Btn2.Top = Offset_Top
Btn2.Left = L2_Left
Offset_Top = Offset_Top + L2_Height + L2_Padding
Btn2.Tag = "Level 1 - Item " + Trim(n) + vbCrLf + "Level 2 - Item " + Trim(i)
Btn2.OnClick = "=L2_Click('" + Btn2.Tag + "')"
Next
Offset_Top = Offset_Top - L2_Height - L1_Padding
For i = n + 1 To L1_Count
Offset_Top = Offset_Top + L1_Height + L1_Padding
Controls("L1_" + Trim(i)).Top = Offset_Top
Next
Clicked = n
End If
End Function
Private Function L2_Click(Arg As String)
v = MsgBox(Arg, , "Level 2 - Click")
End Function
فرمتینگ کلیدها
2.png
البته تعیین استایل دکمه ها با کد هم میسر هست
و اینهم نمونه ای از عملکرد کلیدها :
3.png
کار ما هنوز تمام نشده - تا اینجا فقط کارکرد درست دکمه ها رو ساختیم.
در گام های بعدی منو رو بتدریج کامل میکنیم جوری که هر sub_menu جداگانه ساخته میشه (از روی پارامترهای طراحی منو)