"Оживляем" меню на стартовой форме

Источник: Accessboom

В статье Создаем меню на стартовой форме я показал как можно создать и выравнивать созданные элементы меню по середине стартовой формы. Здесь же придадим ему функциональность и интерактивность.

В разделе объявления переменных формы впишем следующие переменные и константы:

Private Const intItemCount = 6 ' количество пунктов меню
Private Const mclngNothing = 0
Private Const mclng1 = 1
Private Const mclng2 = 2
Private Const mclng3 = 3
Private Const mclng4 = 4
Private Const mclng5 = 5
Private Const mclng6 = 6
Private Const mclngDetail = 200
Private Const mclngColorRed = 255
Private Const mclngColorGreen = 21760
Private fMouseMove As Boolean

Затем создаем такую процедуру:

Private Sub HoverEffect(lngHoverEffect As Long)
' Генерируем эффект при движении мышкой по пунктам меню
Dim I As Integer
' Инициализируем состояние пунктов меню
For I = 1 To intItemCount
    Me("img" & I & "Up").Visible = True
    Me("img" & I & "Down").Visible = False
    Me("lbl" & I & "Title").ForeColor = mclngColorGreen
Next

If lngHoverEffect < 200 Then
    Me("img" & lngHoverEffect & "Up").Visible = False
    Me("img" & lngHoverEffect & "Down").Visible = True
    Me("lbl" & lngHoverEffect & "Title").ForeColor = mclngColorRed
    fMouseMove = 0
Else
    ' ничего не будем делать и так все нормально
    fMouseMove = -1
End If
End Sub

Теперь заполним события перемещения мышки над картинками и над формой:

Понятно, что картинки imgNUp должны быть поверх всего набора (Формат -> На передний план)

Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not fMouseMove Then
Call HoverEffect(mclngDetail)
End If
End Sub

Private Sub img1Up_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call HoverEffect(mclng1)
End Sub
Private Sub img2Up_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call HoverEffect(mclng2)
End Sub
Private Sub img3Up_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call HoverEffect(mclng3)
End Sub
Private Sub img4Up_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call HoverEffect(mclng4)
End Sub
Private Sub img5Up_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call HoverEffect(mclng5)
End Sub
Private Sub img6Up_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call HoverEffect(mclng6)
End Sub

Теперь меню "зашевелилось", перейдем к функциональности:

Private Sub Launch(lngApp As Long)
Select Case lngApp
    Case mclng1
        DoCmd.OpenForm "frmНарушения", acNormal
    Case mclng2
        DoCmd.OpenForm "frmПечатьРеестров", acNormal
    Case mclng3
        DoCmd.OpenForm "frmПечатьОтчетов", acNormal
    Case mclng4
        DoCmd.OpenForm "frmНастройки", acNormal
    Case mclng5
        ' занимаемся архивацией
    Case mclng6

DoCmd.Quit
End Select
End Sub

И заполним события клика мышкой на картинками imgNDown - они становятся Visible в момент проведения мышкой над пунктом меню

Private Sub img1Down_Click()
Launch (mclng1)
End Sub
Private Sub img2Down_Click()
Launch (mclng2)
End Sub
Private Sub img3Down_Click()
Launch (mclng3)
End Sub
Private Sub img4Down_Click()
Launch (mclng4)
End Sub
Private Sub img5Down_Click()
Launch (mclng5)
End Sub
Private Sub img6Down_Click()
Launch (mclng6)
End Sub

Вот и всё. Теперь и в Ваших программах, надеюсь, будет красивое стартовое меню. Надоели уже эти убогие SwitchBoard'ы ;)

Ссылки по теме