Без заголовка
19-01-2007 14:05
к комментариям - к полной версии
- понравилось!
Код для управления строчным меню:
Dim MenuMainList(1 To 7) As String
Dim menuMainTag As Boolean
Dim numPopMenu As Integer ' номер кликнутого меню
Private Sub Form_Load()
Call LoadIni
End Sub
Private Sub imgMenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'курсор над формой, погасить все меню
Dim i As Integer
For i = 1 To 7
MenuMainLineLt(i).Visible = False
MenuMainLineUp(i).Visible = False
MenuMainLineRt(i).Visible = False
MenuMainLineDn(i).Visible = False
MenuMainLineSD(i).Visible = False
MenuMainLineSR(i).Visible = False
Next
End Sub
Private Sub imgTopHead_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.WindowState <> 0 Then Exit Sub
ReleaseCapture
SendMessage Me.hWnd, &H112, &HF012, 0
Call RedrawMe
End Sub
Private Sub RedrawMe()
Dim i As Integer, k As Integer
'код для позицирования заголовка углов формы и границ
'см предыдущие трейды
'Меню
imgMenu.Move imgFrameLt.Width, imgTopHead.Height, Me.Width - imgFrameLt.Width - imgFrameRt.Width, 800
'Все остальное
For i = 1 To 7 'По числу элементов меню
MenuMainCapt(i).Caption = MenuMainList(i)
MenuMainCaptS(i).Caption = MenuMainList(i)
MenuMainCapt(i).Move 60, 30
MenuMainCaptS(i).Move 75, 45
MenuMainLineLt(i).X1 = MenuMainCapt(i).Left - 60
MenuMainLineLt(i).X2 = MenuMainCapt(i).Left - 60
MenuMainLineLt(i).Y1 = MenuMainCapt(i).Top - 30
MenuMainLineLt(i).Y2 = MenuMainCapt(i).Top + MenuMainCapt(i).Height + 30
MenuMainLineUp(i).X1 = MenuMainCapt(i).Left - 60
MenuMainLineUp(i).X2 = MenuMainCapt(i).Left + MenuMainCapt(i).Width + 60
MenuMainLineUp(i).Y1 = MenuMainCapt(i).Top - 30
MenuMainLineUp(i).Y2 = MenuMainCapt(i).Top - 30
MenuMainLineRt(i).X1 = MenuMainCapt(i).Left + MenuMainCapt(i).Width + 60
MenuMainLineRt(i).X2 = MenuMainCapt(i).Left + MenuMainCapt(i).Width + 60
MenuMainLineRt(i).Y1 = MenuMainCapt(i).Top - 30
MenuMainLineRt(i).Y2 = MenuMainCapt(i).Top + MenuMainCapt(i).Height + 30
MenuMainLineDn(i).X1 = MenuMainCapt(i).Left - 60
MenuMainLineDn(i).X2 = MenuMainCapt(i).Left + MenuMainCapt(i).Width + 60
MenuMainLineDn(i).Y1 = MenuMainCapt(i).Top + MenuMainCapt(i).Height + 30
MenuMainLineDn(i).Y2 = MenuMainCapt(i).Top + MenuMainCapt(i).Height + 30
MenuMainLineSD(i).X1 = MenuMainLineDn(i).X1 + 60
MenuMainLineSD(i).X2 = MenuMainLineDn(i).X2 + 60
MenuMainLineSD(i).Y1 = MenuMainLineDn(i).Y1 + 60
MenuMainLineSD(i).Y2 = MenuMainLineDn(i).Y1 + 60
MenuMainLineSR(i).X1 = MenuMainLineRt(i).X1 + 60
MenuMainLineSR(i).X2 = MenuMainLineRt(i).X2 + 60
MenuMainLineSR(i).Y1 = MenuMainLineRt(i).Y1 + 60
MenuMainLineSR(i).Y2 = MenuMainLineRt(i).Y2 + 60
If i = 1 Then
MenuMainItem(1).Move 120, imgTopHead.Height + 30, MenuMainLineSR(i).X2 + 15, MenuMainLineSD(i).Y2 + 15
Else
MenuMainItem(i).Move MenuMainItem(i - 1).Left + MenuMainItem(i - 1).Width + 60, MenuMainItem(i - 1).Top, MenuMainLineSR(i).X2 + 15, MenuMainLineSD(i).Y2 + 15
End If
MenuMainItem(i).Visible = True
Next
'линия под меню
MenuMainLineBk(1).X1 = 60
MenuMainLineBk(1).X2 = Me.ScaleWidth - 60
MenuMainLineBk(1).Y1 = MenuMainItem(1).Height + 2 * Screen.TwipsPerPixelY
MenuMainLineBk(1).Y2 = MenuMainLineBk(1).Y1
MenuMainLineBk(2).X1 = 60
MenuMainLineBk(2).X2 = Me.ScaleWidth - 60
MenuMainLineBk(2).Y1 = MenuMainLineBk(1).Y1 + Screen.TwipsPerPixelY
MenuMainLineBk(2).Y2 = MenuMainLineBk(2).Y1
End Sub
Private Sub LoadIni()
'Здесь мы инициализируем меню, значения можно загружать с ini-файла, это даст возможность работать с несколькими языками
MenuMainList(1) = "Left"
MenuMainList(2) = "Main"
MenuMainList(3) = "User"
MenuMainList(4) = "Tools"
MenuMainList(5) = "Setup"
MenuMainList(6) = "Help"
MenuMainList(7) = "Right"
'Инициализация других параметров
End Sub
'главное строчное меню
Private Sub MenuMainCapt_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'При перемещении курсора над меню подсвечиваем кнопки
Dim i As Integer
For i = 1 To 7 'Указываем реальное число пуктов строчного меню
MenuMainLineLt(i).Visible = False
MenuMainLineUp(i).Visible = False
MenuMainLineRt(i).Visible = False
MenuMainLineDn(i).Visible = False
MenuMainCapt(i).ForeColor = &H80000012
MenuMainCaptS(i).ForeColor = &H8000000E
MenuMainLineSD(i).Visible = False
MenuMainLineSR(i).Visible = False
Next
If menuMainTag Then
'утопленая кнопка и видимое выпадающее меню
MenuMainLineLt(Index).BorderColor = &H80000008
MenuMainLineUp(Index).BorderColor = &H80000008
MenuMainLineRt(Index).BorderColor = &H8000000E
MenuMainLineDn(Index).BorderColor = &H8000000E
MenuMainCapt(Index).ForeColor = &H8000000E
MenuMainCaptS(Index).ForeColor = &H80000012
Else
'поднятая кнопка и погашеное выпадающее меню
MenuMainLineLt(Index).BorderColor = &H8000000E
MenuMainLineUp(Index).BorderColor = &H8000000E
MenuMainLineRt(Index).BorderColor = &H80000008
MenuMainLineDn(Index).BorderColor = &H80000008
MenuMainCapt(Index).ForeColor = &H80000012
MenuMainCaptS(Index).ForeColor = &H8000000E
MenuMainLineSD(Index).Visible = True
MenuMainLineSR(Index).Visible = True
End If
MenuMainLineLt(Index).Visible = True
MenuMainLineUp(Index).Visible = True
MenuMainLineRt(Index).Visible = True
MenuMainLineDn(Index).Visible = True
End Sub
Private Sub MenuMainCapt_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'Нажали на элемент меню, кнопка утоплена
MenuMainLineLt(Index).BorderColor = &H80000008
MenuMainLineUp(Index).BorderColor = &H80000008
MenuMainLineRt(Index).BorderColor = &H8000000E
MenuMainLineDn(Index).BorderColor = &H8000000E
MenuMainCapt(Index).ForeColor = RGB(0, 0, 255)
MenuMainCaptS(Index).ForeColor = &H80000012
'MenuMainLineLt(Index).Visible = True
'MenuMainLineUp(Index).Visible = True
'MenuMainLineRt(Index).Visible = True
'MenuMainLineDn(Index).Visible = True
MenuMainLineSD(Index).Visible = False
MenuMainLineSR(Index).Visible = False
End Sub
Private Sub MenuMainCapt_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'Кнпоку мыши отпустили - кнопка не нажата
If Index = numPopMenu Then
If menuMainTag Then
MenuMainCapt(Index).ForeColor = &H80000012
MenuMainCaptS(Index).ForeColor = &H8000000E
MenuMainLineLt(Index).Visible = False
MenuMainLineUp(Index).Visible = False
MenuMainLineRt(Index).Visible = False
MenuMainLineDn(Index).Visible = False
Call MenuMain_Hide(Index)
Else
MenuMainLineLt(Index).BorderColor = &H80000008
MenuMainLineUp(Index).BorderColor = &H80000008
MenuMainLineRt(Index).BorderColor = &H8000000E
MenuMainLineDn(Index).BorderColor = &H8000000E
MenuMainCapt(Index).ForeColor = &H8000000E
MenuMainCaptS(Index).ForeColor = &H80000012
MenuMainLineLt(Index).Visible = True
MenuMainLineUp(Index).Visible = True
MenuMainLineRt(Index).Visible = True
MenuMainLineDn(Index).Visible = True
Call MenuMain_Show(Index)
End If
menuMainTag = Not (menuMainTag)
Else
MenuMainLineLt(Index).BorderColor = &H80000008
MenuMainLineUp(Index).BorderColor = &H80000008
MenuMainLineRt(Index).BorderColor = &H8000000E
MenuMainLineDn(Index).BorderColor = &H8000000E
MenuMainCapt(Index).ForeColor = &H8000000E
MenuMainCaptS(Index).ForeColor = &H80000012
MenuMainLineLt(Index).Visible = True
MenuMainLineUp(Index).Visible = True
MenuMainLineRt(Index).Visible = True
MenuMainLineDn(Index).Visible = True
menuMainTag = True
Call MenuMain_Show(Index)
End If
MenuMainLineSD(Index).Visible = False
MenuMainLineSR(Index).Visible = False
End Sub
Private Sub MenuMain_Hide(Index As Integer)
numPopMenu = 0
PopMenu.Hide
End Sub
Private Sub MenuMain_Show(Index As Integer)
'Клик на пункте меню, Высвечиваем PopMenu
Dim sizePopMenuW As Integer, sizePopMenuH As Integer
numPopMenu = Index
PopMenu.Move Me.Left + MenuMainItem(Index).Left, Me.Top + imgMenu.Top + MenuMainLineBk(2).Y1 + 4 * Screen.TwipsPerPixelX
PopMenu.Show
End Sub
вверх^
к полной версии
понравилось!
в evernote
Код для управления строчным меню:
Dim MenuMainList(1 To 7) As String
Dim menuMainTag As Boolean
Dim numPopMenu As Integer ' номер кликнутого меню
Private Sub Form_Load()
Call LoadIni
End Sub
Private Sub imgMenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'курсор над формой, погасить все меню
Dim i As Integer
For i = 1 To 7
MenuMainLineLt(i).Visible = False
MenuMainLineUp(i).Visible = False
MenuMainLineRt(i).Visible = False
MenuMainLineDn(i).Visible = False
MenuMainLineSD(i).Visible = False
MenuMainLineSR(i).Visible = False
Next
End Sub
Private Sub imgTopHead_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.WindowState <> 0 Then Exit Sub
ReleaseCapture
SendMessage Me.hWnd, &H112, &HF012, 0
Call RedrawMe
End Sub
Private Sub RedrawMe()
Dim i As Integer, k As Integer
'код для позицирования заголовка углов формы и границ
'см предыдущие трейды
'Меню
imgMenu.Move imgFrameLt.Width, imgTopHead.Height, Me.Width - imgFrameLt.Width - imgFrameRt.Width, 800
'Все остальное
For i = 1 To 7 'По числу элементов меню
MenuMainCapt(i).Caption = MenuMainList(i)
MenuMainCaptS(i).Caption = MenuMainList(i)
MenuMainCapt(i).Move 60, 30
MenuMainCaptS(i).Move 75, 45
MenuMainLineLt(i).X1 = MenuMainCapt(i).Left - 60
MenuMainLineLt(i).X2 = MenuMainCapt(i).Left - 60
MenuMainLineLt(i).Y1 = MenuMainCapt(i).Top - 30
MenuMainLineLt(i).Y2 = MenuMainCapt(i).Top + MenuMainCapt(i).Height + 30
MenuMainLineUp(i).X1 = MenuMainCapt(i).Left - 60
MenuMainLineUp(i).X2 = MenuMainCapt(i).Left + MenuMainCapt(i).Width + 60
MenuMainLineUp(i).Y1 = MenuMainCapt(i).Top - 30
MenuMainLineUp(i).Y2 = MenuMainCapt(i).Top - 30
MenuMainLineRt(i).X1 = MenuMainCapt(i).Left + MenuMainCapt(i).Width + 60
MenuMainLineRt(i).X2 = MenuMainCapt(i).Left + MenuMainCapt(i).Width + 60
MenuMainLineRt(i).Y1 = MenuMainCapt(i).Top - 30
MenuMainLineRt(i).Y2 = MenuMainCapt(i).Top + MenuMainCapt(i).Height + 30
MenuMainLineDn(i).X1 = MenuMainCapt(i).Left - 60
MenuMainLineDn(i).X2 = MenuMainCapt(i).Left + MenuMainCapt(i).Width + 60
MenuMainLineDn(i).Y1 = MenuMainCapt(i).Top + MenuMainCapt(i).Height + 30
MenuMainLineDn(i).Y2 = MenuMainCapt(i).Top + MenuMainCapt(i).Height + 30
MenuMainLineSD(i).X1 = MenuMainLineDn(i).X1 + 60
MenuMainLineSD(i).X2 = MenuMainLineDn(i).X2 + 60
MenuMainLineSD(i).Y1 = MenuMainLineDn(i).Y1 + 60
MenuMainLineSD(i).Y2 = MenuMainLineDn(i).Y1 + 60
MenuMainLineSR(i).X1 = MenuMainLineRt(i).X1 + 60
MenuMainLineSR(i).X2 = MenuMainLineRt(i).X2 + 60
MenuMainLineSR(i).Y1 = MenuMainLineRt(i).Y1 + 60
MenuMainLineSR(i).Y2 = MenuMainLineRt(i).Y2 + 60
If i = 1 Then
MenuMainItem(1).Move 120, imgTopHead.Height + 30, MenuMainLineSR(i).X2 + 15, MenuMainLineSD(i).Y2 + 15
Else
MenuMainItem(i).Move MenuMainItem(i - 1).Left + MenuMainItem(i - 1).Width + 60, MenuMainItem(i - 1).Top, MenuMainLineSR(i).X2 + 15, MenuMainLineSD(i).Y2 + 15
End If
MenuMainItem(i).Visible = True
Next
'линия под меню
MenuMainLineBk(1).X1 = 60
MenuMainLineBk(1).X2 = Me.ScaleWidth - 60
MenuMainLineBk(1).Y1 = MenuMainItem(1).Height + 2 * Screen.TwipsPerPixelY
MenuMainLineBk(1).Y2 = MenuMainLineBk(1).Y1
MenuMainLineBk(2).X1 = 60
MenuMainLineBk(2).X2 = Me.ScaleWidth - 60
MenuMainLineBk(2).Y1 = MenuMainLineBk(1).Y1 + Screen.TwipsPerPixelY
MenuMainLineBk(2).Y2 = MenuMainLineBk(2).Y1
End Sub
Private Sub LoadIni()
'Здесь мы инициализируем меню, значения можно загружать с ini-файла, это даст возможность работать с несколькими языками
MenuMainList(1) = "Left"
MenuMainList(2) = "Main"
MenuMainList(3) = "User"
MenuMainList(4) = "Tools"
MenuMainList(5) = "Setup"
MenuMainList(6) = "Help"
MenuMainList(7) = "Right"
'Инициализация других параметров
End Sub
'главное строчное меню
Private Sub MenuMainCapt_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'При перемещении курсора над меню подсвечиваем кнопки
Dim i As Integer
For i = 1 To 7 'Указываем реальное число пуктов строчного меню
MenuMainLineLt(i).Visible = False
MenuMainLineUp(i).Visible = False
MenuMainLineRt(i).Visible = False
MenuMainLineDn(i).Visible = False
MenuMainCapt(i).ForeColor = &H80000012
MenuMainCaptS(i).ForeColor = &H8000000E
MenuMainLineSD(i).Visible = False
MenuMainLineSR(i).Visible = False
Next
If menuMainTag Then
'утопленая кнопка и видимое выпадающее меню
MenuMainLineLt(Index).BorderColor = &H80000008
MenuMainLineUp(Index).BorderColor = &H80000008
MenuMainLineRt(Index).BorderColor = &H8000000E
MenuMainLineDn(Index).BorderColor = &H8000000E
MenuMainCapt(Index).ForeColor = &H8000000E
MenuMainCaptS(Index).ForeColor = &H80000012
Else
'поднятая кнопка и погашеное выпадающее меню
MenuMainLineLt(Index).BorderColor = &H8000000E
MenuMainLineUp(Index).BorderColor = &H8000000E
MenuMainLineRt(Index).BorderColor = &H80000008
MenuMainLineDn(Index).BorderColor = &H80000008
MenuMainCapt(Index).ForeColor = &H80000012
MenuMainCaptS(Index).ForeColor = &H8000000E
MenuMainLineSD(Index).Visible = True
MenuMainLineSR(Index).Visible = True
End If
MenuMainLineLt(Index).Visible = True
MenuMainLineUp(Index).Visible = True
MenuMainLineRt(Index).Visible = True
MenuMainLineDn(Index).Visible = True
End Sub
Private Sub MenuMainCapt_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'Нажали на элемент меню, кнопка утоплена
MenuMainLineLt(Index).BorderColor = &H80000008
MenuMainLineUp(Index).BorderColor = &H80000008
MenuMainLineRt(Index).BorderColor = &H8000000E
MenuMainLineDn(Index).BorderColor = &H8000000E
MenuMainCapt(Index).ForeColor = RGB(0, 0, 255)
MenuMainCaptS(Index).ForeColor = &H80000012
'MenuMainLineLt(Index).Visible = True
'MenuMainLineUp(Index).Visible = True
'MenuMainLineRt(Index).Visible = True
'MenuMainLineDn(Index).Visible = True
MenuMainLineSD(Index).Visible = False
MenuMainLineSR(Index).Visible = False
End Sub
Private Sub MenuMainCapt_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'Кнпоку мыши отпустили - кнопка не нажата
If Index = numPopMenu Then
If menuMainTag Then
MenuMainCapt(Index).ForeColor = &H80000012
MenuMainCaptS(Index).ForeColor = &H8000000E
MenuMainLineLt(Index).Visible = False
MenuMainLineUp(Index).Visible = False
MenuMainLineRt(Index).Visible = False
MenuMainLineDn(Index).Visible = False
Call MenuMain_Hide(Index)
Else
MenuMainLineLt(Index).BorderColor = &H80000008
MenuMainLineUp(Index).BorderColor = &H80000008
MenuMainLineRt(Index).BorderColor = &H8000000E
MenuMainLineDn(Index).BorderColor = &H8000000E
MenuMainCapt(Index).ForeColor = &H8000000E
MenuMainCaptS(Index).ForeColor = &H80000012
MenuMainLineLt(Index).Visible = True
MenuMainLineUp(Index).Visible = True
MenuMainLineRt(Index).Visible = True
MenuMainLineDn(Index).Visible = True
Call MenuMain_Show(Index)
End If
menuMainTag = Not (menuMainTag)
Else
MenuMainLineLt(Index).BorderColor = &H80000008
MenuMainLineUp(Index).BorderColor = &H80000008
MenuMainLineRt(Index).BorderColor = &H8000000E
MenuMainLineDn(Index).BorderColor = &H8000000E
MenuMainCapt(Index).ForeColor = &H8000000E
MenuMainCaptS(Index).ForeColor = &H80000012
MenuMainLineLt(Index).Visible = True
MenuMainLineUp(Index).Visible = True
MenuMainLineRt(Index).Visible = True
MenuMainLineDn(Index).Visible = True
menuMainTag = True
Call MenuMain_Show(Index)
End If
MenuMainLineSD(Index).Visible = False
MenuMainLineSR(Index).Visible = False
End Sub
Private Sub MenuMain_Hide(Index As Integer)
numPopMenu = 0
PopMenu.Hide
End Sub
Private Sub MenuMain_Show(Index As Integer)
'Клик на пункте меню, Высвечиваем PopMenu
Dim sizePopMenuW As Integer, sizePopMenuH As Integer
numPopMenu = Index
PopMenu.Move Me.Left + MenuMainItem(Index).Left, Me.Top + imgMenu.Top + MenuMainLineBk(2).Y1 + 4 * Screen.TwipsPerPixelX
PopMenu.Show
End Sub
Вы сейчас не можете прокомментировать это сообщение.
Дневник Без заголовка | _Программирование_ - Дневник _Программирование_ |
Лента друзей _Программирование_
/ Полная версия
Добавить в друзья
Страницы:
раньше»