Помогите со всплывающей менюхой!

[holmik]

Помогите со всплывающей менюхой!
Из кода программы создаётся всплывающее многоуровневое меню из базы данных. Основное меню - категория - группа - элемент. Я могу отловить
щелчок по конечному элементу, но не знаю, как отловить его путь (группу и категорию). Подскажите, что делать! Уже несколько месяцев мучаюсь, но на том же Relib.com никто ответа не дал.

[natcap]

а может пойти самым примитивным путем???
в тег каждого элемента заноси путь...
например

Категория 1 tag=1
группа 1 tag=1-1
элем 1 tag=1-1-1
элем 2 tag=1-1-2
элем 3 tag=1-1-3
группа 2 tag=1-2
элем 1 tag=1-2-1
элем 2 tag=1-2-2
элем 3 tag=1-2-3

вот и будет путь.. строку то разобрать на путь элементарно

[holmik]

А как синтаксически пользоваться свойством Tag? Мне вот это непонятно

[natcap]

.tag=string
кавычки было лениво писать

[holmik]

Дык я вкурсе, что доступ к свойствам объекта через точку
Только куды ж её ставить?

Код: Выделить всё

Private Sub Command1_Click()
    Const maxLen As Long = 255&
    Dim cmdRect As RECT
    Dim menuX As Long, menuY As Long
    Dim menuId As Long, menuText As String
'
    ' Получаем координаты нижнего левого угла кнопки Command1:
    GetWindowRect Command1.hWnd, cmdRect
    menuX = cmdRect.Left
    menuY = cmdRect.Bottom
'
    'Показываем всплывающие меню и определяем, по какому элементу щЈлкнули:
    menuId = TrackPopupMenu(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD, menuX, menuY, 0, Me.hWnd, ByVal 0&)
    If menuId <> 0& Then
        ' был сделан щелчок по элементу с id = menuId
        menuText = Space$(maxLen)
        GetMenuString hMenu, menuId, menuText, maxLen, 0&
        menuText = Left$(menuText, InStr(1, menuText, vbNullChar) - 1)
        MsgBox "Вы выбрали пункт меню:" + vbCr + menuText, vbInformation, "Информация:"
    End If
End Sub
'
Private Sub Form_Load()
    Dim dataArr(1 To 2, 0 To 3) As String
    Dim i As Integer, j As Integer
    Dim groupMenu As Long, elementMenu As Long
'
    Command1.Caption = "Список элементов"
    Command1.Width = 2000
    Command1.Height = 500
'
    ' СоздаЈм пустое всплывающее меню
    hMenu = CreatePopupMenu()
'
    ' Заполняем меню двухуровневой иерархией ваших элементов. Для определЈнности
    ' предполагаем, что все элементы читаются из БД в двумерный строковый массив,
    ' в нулевом элементе второго индекса которого хранится имя группы элементов.
    ' Чтобы не писать здесь код работы с базой (формат которой неизвестен), просто
    ' присвоим значения элементам массива напрямую:
'
    dataArr(1, 0) = "Каши"
    dataArr(1, 1) = "Овсяная"
    dataArr(1, 2) = "Гречневая"
    dataArr(1, 3) = "Манная"
'
    dataArr(2, 0) = "Фрукты"
    dataArr(2, 1) = "Яблоки"
    dataArr(2, 2) = "Груши"
    dataArr(2, 3) = "Апельсины"
'
    ' Заполняем меню данными из массива dataArr():
    For i = LBound(dataArr, 1) To UBound(dataArr, 1)
        For j = LBound(dataArr, 2) To UBound(dataArr, 2)
            If j = 0 Then
                ' надо создать меню с именем группы:
                groupMenu = CreatePopupMenu
                InsertMenu hMenu, i - 1, MF_STRING Or MF_BYPOSITION Or MF_POPUP, groupMenu, dataArr(i, j)
            Else
                ' надо заполнить созданное меню именами элементов из группы:
                elementMenu = i * 1000& + j
                AppendMenu groupMenu, MF_STRING, ByVal elementMenu, dataArr(i, j)
            End If
        Next j
    Next i
'
End Sub


[holmik]

Люди! Помогите! Вишу с этим вопросом уже несколько месяцев! Хоть малюсенький примерчик, попробую разобраться!

[tyomitch]

Вот пример:

Код: Выделить всё

Option Explicit
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long
Private Declare Function GetMenuString Lib "user32.dll" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Private Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Private Declare Function InsertMenu Lib "user32.dll" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32.dll" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Private Const TPM_LEFTALIGN As Long = &H0&
Private Const TPM_RETURNCMD As Long = &H100&
Private Const MF_STRING As Long = &H0&
Private Const MF_BYPOSITION As Long = &H400&
Private Const MF_POPUP As Long = &H10&
Private Const MIIM_SUBMENU As Long = &H4
Dim hMenu As Long

Private Sub Command1_Click()
    Const maxLen As Long = 255&
    Dim cmdRect As RECT
    Dim menuX As Long, menuY As Long
    Dim menuId As Long, menuText As String
'
    ' Получаем координаты нижнего левого угла кнопки Command1:
    GetWindowRect Command1.hwnd, cmdRect
    menuX = cmdRect.Left
    menuY = cmdRect.Bottom
'
    'Показываем всплывающие меню и определяем, по какому элементу щ_лкнули:
    menuId = TrackPopupMenu(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD, menuX, menuY, 0, Me.hwnd, ByVal 0&)
    If menuId <> 0& Then
        ' был сделан щелчок по элементу с id = menuId
        Dim i As Long, j As Long, hSubMenu As Long, mnuPath As String
        Dim mii As MENUITEMINFO
        For i = 0 To GetMenuItemCount(hMenu) - 1
            mii.cbSize = LenB(mii)
            mii.fMask = MIIM_SUBMENU
            GetMenuItemInfo hMenu, i, True, mii
            hSubMenu = mii.hSubMenu
            For j = 0 To GetMenuItemCount(hSubMenu) - 1
                If GetMenuItemID(hSubMenu, j) = menuId Then
                    menuText = Space$(maxLen)
                    GetMenuString hMenu, hSubMenu, menuText, maxLen, 0&
                    menuText = Left$(menuText, InStr(1, menuText, vbNullChar) - 1)
                    mnuPath = menuText & "\"
                   
                    menuText = Space$(maxLen)
                    GetMenuString hMenu, menuId, menuText, maxLen, 0&
                    menuText = Left$(menuText, InStr(1, menuText, vbNullChar) - 1)
                    mnuPath = mnuPath & menuText
                   
                    MsgBox "Вы выбрали пункт меню:" + vbCr + mnuPath, vbInformation, "Информация:"
                End If
            Next
        Next
    End If
End Sub
'
Private Sub Form_Load()
    Dim dataArr(1 To 2, 0 To 3) As String
    Dim i As Integer, j As Integer
    Dim groupMenu As Long, elementMenu As Long
'
    Command1.Caption = "Список элементов"
    Command1.Width = 2000
    Command1.Height = 500
'
    ' Созда_м пустое всплывающее меню
    hMenu = CreatePopupMenu()
'
    ' Заполняем меню двухуровневой иерархией ваших элементов. Для определ_нности
    ' предполагаем, что все элементы читаются из БД в двумерный строковый массив,
    ' в нулевом элементе второго индекса которого хранится имя группы элементов.
    ' Чтобы не писать здесь код работы с базой (формат которой неизвестен), просто
    ' присвоим значения элементам массива напрямую:
'
    dataArr(1, 0) = "Каши"
    dataArr(1, 1) = "Овсяная"
    dataArr(1, 2) = "Гречневая"
    dataArr(1, 3) = "Манная"
'
    dataArr(2, 0) = "Фрукты"
    dataArr(2, 1) = "Яблоки"
    dataArr(2, 2) = "Груши"
    dataArr(2, 3) = "Апельсины"
'
    ' Заполняем меню данными из массива dataArr():
    For i = LBound(dataArr, 1) To UBound(dataArr, 1)
        For j = LBound(dataArr, 2) To UBound(dataArr, 2)
            If j = 0 Then
                ' надо создать меню с именем группы:
                groupMenu = CreatePopupMenu
                InsertMenu hMenu, i - 1, MF_STRING Or MF_BYPOSITION Or MF_POPUP, groupMenu, dataArr(i, j)
            Else
                ' надо заполнить созданное меню именами элементов из группы:
                elementMenu = i * 1000& + j
                AppendMenu groupMenu, MF_STRING, ByVal elementMenu, dataArr(i, j)
            End If
        Next j
    Next i
'
End Sub


Я старался как можно меньше отходить от твоего кода, но по-моему, это бессмысленная затея - юзать API для создания меню. Сложностей много, а выигрыша никакого.

[GSerg]

Чиииивоооооо????

http://bbs.vbstreets.ru/viewtopic.php?p=39489#39489

[tyomitch]

Чиииивоооооо????

http://bbs.vbstreets.ru/viewtopic.php?p=39489#39489

User-defined type not defined: MenuItemDrawer
User-defined type not defined: MenuClickCatcher
User-defined type not defined: PopupMenuDrawItemAction
User-defined type not defined: PopupMenuDrawItemState
и ещё, ещё, ещё...

1. Чего мне нехватает, чтобы насладиться этой изумительной красотой?
2. И где это взять?
3. И зачем это, вообще, надо? Чтоб тормозило сильнее?
Меня бесит, когда у пустяковых программ из-за изумительной красотищи многомеговые дистрибутивы. Офису это простительно - там кроме красоты ещё и огромная, уникальная функциональность. Кто-то готов с ним соревноваться в этом отношении?
Передирать офисную красотищу "шоб було" - верхоглядство и пижонство.

[GSerg]

1. Всё должно быть там, странно, перепроверю.
2. Там всё!
3. НЕ ТОРМОЗИТ (28 вскл. зн.)

Меня тоже это бесит. Дистрибутив отсутствует, никаких библ, всё в exe...
Передирать красотищу - это мы "шоб знали как", и токмо ради этого...

[GSerg]

Не проверяя старой, закачал новую версию

[tyomitch]

На случай, если я сгоряча сформулировал мысль не вполне чётко...

Необходимость использования изумительной красотищи в болльшинстве тех программ, где я её видел, очень и очень спорна. Девелоперы увлекаются красотищей и забывают, что их программа - не скринсейвер, а рабочий инструмент, где рюшечки, даже если и не тормозят, что бывает редко, - то по крайней мере отвлекают.

Ты и подобные тебе люди процируете девелоперов на такие вот глупости. Если пример чисто демонстративный, рядом с ним надо класть жирный дизклеймер: "НЕ ВЗДУМАЙТЕ юзать это в реальных программах! Поиграйте и бросьте".

Вкратце: торт с кремом - хорошо, крем с тортом - нет. Красота должна иметь меру.

[GSerg]

Я и подобные мне люди порой занимаемся вопросом ради самого изучения процесса.
Пример не чисто демонстративный.
А если кастомная отрисовка не нужна, то:

• Не использовать параметр CustomDrawer при создании пункта
• Установить SubClasserPresent = False.

И тогда это будет обычная менюшка, только объектно-ориентированная...

[tyomitch]

Я и подобные мне люди порой занимаемся вопросом ради самого изучения процесса.

Я тебе не об этом говорил. Если ты до чего-то дошёл и хочешь поделиться - безусловно, все в выигрыше.
Просто конкретно этим примером ты имхо развращаешь морально нестойких девелоперов. Они увидят, что так можно сделать, - и пожалуйста, вставят сине-зелёный градиент в свои меню. А юзеры потом будут удивляться - что это за панк прогу писал?

Ещё одна аналогия. Если ты рассылаешь исходники вирусов по почте - с целью поделиться достижениями в области программирования - кто-нибудь может воспользоваться ими не так, как тебе бы хотелось. И получится, что ты ничьи диски не форматировал, но из-за тебя они были отформатированы. И тут так же.

[GSerg]

Вообще-то я хотел показать, как это делается в принципе. Сине-зелёному градиенту в нужной мне софтине я сильно не обрадовался бы.
И вообще, я верю в морально устойчивых девелоперов... Хоть рисовалку в почти стиле офиса 97 ты не будешь ругать?

[A.A.Z.]

Народ, сорри, что влезаю, но, ИМХО, здесь оба в своём правы, tyomitch в том, что излишняя красота в мелких прогах обычно не нужна, GSerg в том, что делится своим опытом с другими.
Вообще-то говоря, вы уже давно залезли в оффтоп, как в топике про +/- .NET. Поэтому предлагаю вам остановиться во избежание ругани.

[tyomitch]

:shock:
Вообще-то я хотел показать, как это делается в принципе.

Или я плохо объясняю, или ты не можешь понять, о чём я говорю.
Ну, скажем, если бы химик-энтузиаст написал на форуме с 5000+ подписчиками, как "в принципе" приготовить взрывчатку из подручных материалов, ты бы как к этому отнёсся?
Против меню я ничего не имею, когда их употребляют к месту и с умом. Твоя реализация - ну, любопытная вещь, хотя едва ли когда-нибудь воспользуюсь сам.

Морально устойчивых девелоперов имхо меньшинство. Я, когда мне только VB попался в руки, естественно начал с того, чтобы налепить цветастых мигающих кнопок, всплывающих с соответствующим звуком меню, и т.д. Не прога, а карусель, одним словом. Тех же, кто этот этап ещё не прошёл, я очень хочу от него предостеречь.

2AAZ: я не про то, что опытом делиться не надо, а про то, что делать это надо осторожно. А ругани никакой не будет

[GSerg]

Ругани точно не будет
Моя реализация - любопытная для меня вещь, и ею я воспользуюсь...

И я могу понять, о чём ты говоришь
Но скажи мне тогда, как определить грань между "надо поделиться" и "а вдруг не созрели"?


ЗЫ: Присоединяюсь к твоим предостережениям.

[tyomitch]

Но скажи мне тогда, как определить грань между "надо поделиться" и "а вдруг не созрели"?

Если девелопер неправильным использованием кода досадит только себе (например, прога будет падать, или не компилироваться) - можно делиться.
Если девелопер неправильным использованием кода досадит юзеру своей программы - лучше не делиться.

Теперь конструктив. Чтобы картинки в меню-97 были правильного цвета, можно строчку

Код: Выделить всё

DrawState hdc, 0, 0, ByVal hPic, 0, Left + 2, Top + 2, 16, 16, DST_BITMAP Or DSS_NORMAL

заменить на

Код: Выделить всё

TransparentBlt hdc, Left + 2, Top + 2, 16, 16, Picture2.hdc, 0, 0, 16, 16, Picture2.BackColor

Совместимость: Win98+/Win2000+
Объявление:

Код: Выделить всё

Private Declare Function TransparentBlt Lib "msimg32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTransparent As Long) As Long

+ надо задать Picture2.BackColor (в твоём случае, &HC0C0C0)

[GSerg]

Ого!
Вот он, критерий, оказывается

А что касается рисунков, то вот доделаю нормальный имплемент imagelist, и на него всё переложу