DestroyMenu не очень такой уж и дестрой

Программирование на Visual Basic for Applications
Avtopic
Постоялец
Постоялец
 
Сообщения: 442
Зарегистрирован: 30.09.2005 (Пт) 17:15
Откуда: Tbilisi

DestroyMenu не очень такой уж и дестрой

Сообщение Avtopic » 06.11.2006 (Пн) 14:59

Здравствуйте!
При выборе пункта меню, созданного с помощью API, дело завершается следующими командами
Код: Выделить всё
1. I = TrackPopupMenu...

2. GetMenuCaption(hMenu, I, MF_BYCOMMAND)

3. DestroyMenu для hMenu и всех  hSubMenu.

случайно перепутал очередность второго и третьего пункта.
т.е. сперва поставил DestroyMenu... а затем GetMenuCaption...
и как не странно GetMenuCaption..., все равно возвращает правильный результат.

потом проверил и обнаружил что вся структура MENUITEMINFO пунктов меню все ровно живет.

вопрос такой, что же тогда дестройвает DestroyMenu?

GSerg
Шаман
Шаман
 
Сообщения: 14286
Зарегистрирован: 14.12.2002 (Сб) 5:25
Откуда: Магадан

Сообщение GSerg » 06.11.2006 (Пн) 15:09

Объявлено как?
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас

Avtopic
Постоялец
Постоялец
 
Сообщения: 442
Зарегистрирован: 30.09.2005 (Пт) 17:15
Откуда: Tbilisi

Сообщение Avtopic » 06.11.2006 (Пн) 15:44

Код: Выделить всё
  Public hMenu As Long

'______________________________

Public Function CreateMenu(Parent As UserForm, Optional CheckBoxPicture As StdPicture, Optional cLCheckPictureLines As Boolean = True) As Long
CreateMenu = CreatePopupMenu()
...
hMenu = CreateMenu
...
End Function


'______________________________

Public Function AppendItem(hMenu As Long, cLType As cLMenuItemType, cLwID As Long, Sub_hwnd As Long, Optional cLPict As StdPicture, Optional cLPict As StdPicture)
Dim hMenu As Long, dwFlag As Long
Dim mii As MENUITEMINFO

On Error GoTo loopErr:
MenuComplete = False

If cLType = MF_POPUP Then
    AppendMenu ByVal hMenu, ByVal cLType, Sub_hwnd, ByVal cLCaption
    Call ModifyMenu(hMenu, CLLM(CStr(SubMenuIndex)), MF_BYCOMMAND Or MF_OWNERDRAW, cLwID, MF_BYPOSITION Or MF_OWNERDRAW)
Else
    AppendMenu ByVal hMenu, ByVal cLType, ByVal cLwID, ByVal cLCaption
    mii.cbSize = Len(mii)
    mii.fMask = MIIM_TYPE Or MIIM_STATE Or MIIM_ID
    GetMenuItemInfo hMenu, cLwID, MF_BYCOMMAND, mii
    dwFlag = MF_BYCOMMAND Or MF_OWNERDRAW
    If ((mii.fType And MF_SEPARATOR) = MF_SEPARATOR) Then dwFlag = dwFlag Or MF_SEPARATOR
    If ((GetMenuState(hMenu, mii.wID, MF_BYCOMMAND) And MF_CHECKED) = MF_CHECKED) Then dwFlag = dwFlag Or MF_CHECKED
    If ((GetMenuState(hMenu, mii.wID, MF_BYCOMMAND) And MF_DISABLED) = MF_DISABLED) Then dwFlag = dwFlag Or MF_GRAYED
    Call ModifyMenu(hMenu, mii.wID, dwFlag, cLwID, MF_BYPOSITION Or MF_OWNERDRAW)
End If
....
End Function



'______________________________

Public Sub MAKE_Menu()
CreateMenu ...
AppendItem ...
AppendItem ...
AppendItem ...
End Sub

GSerg
Шаман
Шаман
 
Сообщения: 14286
Зарегистрирован: 14.12.2002 (Сб) 5:25
Откуда: Магадан

Сообщение GSerg » 06.11.2006 (Пн) 15:52

Объявлено как?
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас

Avtopic
Постоялец
Постоялец
 
Сообщения: 442
Зарегистрирован: 30.09.2005 (Пт) 17:15
Откуда: Tbilisi

Сообщение Avtopic » 06.11.2006 (Пн) 16:08

Ничего не понял.
Код: Выделить всё
Private Declare Function CreatePopupMenu Lib "User32.dll" () As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _
                         (ByVal hMenu As Long, ByVal wFlags As Long, _
                         ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" _
                         (ByVal hMenu As Long, ByVal nPosition As Long, _
                         ByVal wFlags As Long, ByVal wIDNewItem As Long, _
                         ByVal lpString As Long) As Long
Public Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" _
                         (ByVal hMenu As Long, ByVal uItem As Long, _
                         ByVal ByPosition As Long, lpMenuItemInfo As MENUITEMINFO) As Boolean
Public Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" _
                        (ByVal hMenu As Long, ByVal wIDItem As Long, _
                         ByVal lpString As String, ByVal nMaxCount As Long, _
                         ByVal wFlag As Long) As Long
Public Declare Function GetMenuState Lib "user32" _
                        (ByVal hMenu As Long, ByVal wID As Long, _
                        ByVal wFlags As Long) 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 DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long

Ничего больше не объявлено :) , прямо

Код: Выделить всё
Public Sub CreateMenu()
CreateMenu ...
AppendItem ...
AppendItem ...
AppendItem ...

wlOldProc = SetWindowLong(m_hwnd, GWL_WNDPROC, AddressOf MsgProc)

i = TrackPopupMenu(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, Pt.x, Pt.y, 0, m_hwnd, ByVal 0&)
cLCaption = GetMenuCaption(hMenu, i, MF_BYCOMMAND)
Remove_Hook ' в нем все DestroyMenu
End Sub

Avtopic
Постоялец
Постоялец
 
Сообщения: 442
Зарегистрирован: 30.09.2005 (Пт) 17:15
Откуда: Tbilisi

Сообщение Avtopic » 11.11.2006 (Сб) 10:59

SOS! Имею такую проблему:
Если вызываю меню подряд, несколько раз, правым кликом на свободное место листа, наступает такой момент:
1. кликнул, появляется меню с некоторым опозданием свойственным Windows.
2. кликнул, появляется меню с некоторым опозданием свойственным Windows.
3. кликнул, появляется меню с некоторым опозданием свойственным Windows.

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

Avtopic
Постоялец
Постоялец
 
Сообщения: 442
Зарегистрирован: 30.09.2005 (Пт) 17:15
Откуда: Tbilisi

Сообщение Avtopic » 11.11.2006 (Сб) 18:38

С утра мучаюсь, и под конец дня обнаружил, что такой же глюк имеет и Excel-овское меню,
если нажать на правую кнопку на листе, где-то, в верхнем левом углу и быстро перемещать мышь по диагонали
к правому нижнему углу, так чтобы, MousUp произошел в области меню,
то меню исполняет соответствующий пункт. :evil: :evil: :evil:


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 89

    TopList