В статье Создаем меню на стартовой форме я показал как можно создать и выравнивать созданные элементы меню по середине стартовой формы. Здесь же придадим ему функциональность и интерактивность.
В разделе объявления переменных формы впишем следующие переменные и константы:
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'ы ;)