طراحی فرم منو اصلی پویا در اکسس (Dynamic Form)

[mazoolagh]

چه تغییراتی نسبت به گام پیش داریم؟

• تمام عملیات ساخت فرم رو حذف کردیم چون دیگه نیازی بهش نداریم بنابراین ماجول پابلیک utilities نسبت به قبل سبکتر شده.
• در برابر تمام روتین های مربوط به actionها رو در این ماجول میاریم. اینجا فقط برای یک action و بعنوان راهنما و نمونه اینکار رو کردیم.
• در فرم navigation اطلاعات منو رو در رخداد onload از جدول menuitems میخونیم و برای هر آیتم از این دیتا استفاده میکنیم. کامنت برای کدها گذاشتم تا شناخت روش کار کد راحتتر باشه.

کد ماجول utilities

Option Compare Database

Option Explicit

Public Const twips As Integer = 567

Public v As Variant

Public Function F50()

v = MsgBox("procedure F50")

End Function

کدهای فرم navigation

Option Compare Database

Option Explicit

Private Const L1_Max As Integer = 10

Private Const L2_Max As Integer = 8

Private Clicked As Integer          ' shows which Level 1 item clicked

Private Menu_L1() As Variant        ' array to hold Level 1 captions and actions

Private Menu_L2(L1_Max) As Variant  ' array to hold Level 2 captions and actions

Private L1_Count As Integer         ' number of defined items in Level 1

Private i As Integer

Private L1_H, L2_H, L1_Padding, L2_Padding, L2_Left As Integer

Private Sub Form_Load()

L1_H = L1_2.Top - L1_1.Top

L1_Padding = L1_H - L1_1.Height

L2_H = L2_2.Top - L2_1.Top

L2_Padding = L2_H - L2_1.Height

L2_Left = L1_1.Left + 0.5 * twips   ' right indent for Level 2 buttons : 0.5 cm

Read_Menu   ' load menu data into corresponding arrays

For i = 1 To L1_Count

    L1(i).CAPTION = L1_Caption(i)

    L1(i).Visible = True

    L1(i).OnClick = "=L1_Click(" + Trim(i) + ")"

Next

For i = L1_Count + 1 To L1_Max  ' hide unused Level 1 items

    L1(i).Visible = False

Next

For i = 1 To L2_Max

    L2(i).Left = L2_Left        ' reposition Level 2 items

Next

Collapse    ' collapse menu

End Sub

Private Function L1_Click(L1_item As Integer)

If L2_Count(L1_item) = 0 Then   ' no Level 2 items

    Collapse

    Eval (L1_Action(L1_item))  ' run action

Else

    If Clicked = L1_item Then   ' toggle state

        Collapse

    Else

        Expand (L1_item)

    End If

End If

End Function

Private Function L2_Count(L1_item As Integer) As Integer

L2_Count = 0

On Error Resume Next

L2_Count = UBound(Menu_L2(L1_item), 2) + 1

End Function

Public Function Read_Menu()

Dim rs As Recordset

Dim MenuQry As QueryDef

Set MenuQry = CurrentDb.QueryDefs("Menu")

MenuQry.Parameters("@ParentID") = -1    ' Level 1 items have no parent

Set rs = MenuQry.OpenRecordset

Menu_L1 = rs.GetRows(L1_Max)    ' loads Level 1 items into array

L1_Count = UBound(Menu_L1, 2) + 1

For i = 1 To L1_Count   ' loop through Level 1

    MenuQry.Parameters("@ParentID") = i

    Set rs = MenuQry.OpenRecordset

    If rs.RecordCount > 0 Then

        Menu_L2(i) = rs.GetRows(L2_Max) ' load Level 2 items for Level 1 item i

    End If

Next

rs.Close

Set rs = Nothing

End Function

Private Function Collapse()

For i = 1 To L2_Max

    L2(i).Visible = False   ' hive Level 2 items

Next

    

For i = 2 To L1_Max

    L1(i).Top = L1(i - 1).Top + L1_H

Next

Clicked = 0 ' nothing selected

End Function

Private Function Expand(n As Integer)   ' n = clicked button index

Clicked = n

Dim k As Integer

k = L2_Count(n)

Dim L2TH As Integer ' Level 2 total height

If k = 0 Then

    L2TH = 0

Else

    L2TH = k * L2_H + L2_Padding

End If

For i = 2 To L1_Count   ' start from item 2 - item 1 top is always fixed

    If i = n + 1 Then

        L1(i).Top = L1(n).Top + L1_1.Height + L2TH

    Else

        L1(i).Top = L1(i - 1).Top + L1_H

    End If

Next

Dim X As Integer

X = L1(n).Top + L1_1.Height + L2_Padding

For i = 1 To k      ' reposition Level 2 items

    With L2(i)

        .Visible = True

        .CAPTION = L2_Caption(n, i)

        .Top = X + (i - 1) * L2_H

        .OnClick = "=" + L2_Action(n, i)

    End With

Next

For i = k + 1 To L2_Max

    L2(i).Visible = False

Next

End Function

Private Function L1(n As Integer) As CommandButton

Set L1 = Controls("L1_" + Trim(n))

End Function

Private Function L2(n As Integer) As CommandButton

Set L2 = Controls("L2_" + Trim(n))

End Function

Private Function L1_Caption(n As Integer) As Variant

L1_Caption = Menu_L1(0, n - 1)

End Function

Private Function L1_Action(n As Integer) As Variant

L1_Action = Menu_L1(1, n - 1)

End Function

Private Function L2_Caption(n1 As Integer, n2 As Integer) As Variant

L2_Caption = Menu_L2(n1)(0, n2 - 1)

End Function

Private Function L2_Action(n1 As Integer, n2 As Integer) As Variant

L2_Action = Menu_L2(n1)(1, n2 - 1)

End Function