icon im menu

19/01/2008 - 15:31 von Andreas | Report spam
Hallo Zusammen,
habe mir neulich ein Code um Ikon im Menu anzeigen zu können im Internet
runter geladen. Der Code wàhre sonnst gut wenn auch für popupmenu die Ikon
angezeigt werden.Für popupmenu funktioniert es aber nicht die Ikon werden
nicht angezeigt weil das menu für popupmenu visible = false ist.
Kann mir jemand sagen wie ich den code àndern muss damit die Icon auch im
Popupmenu angezeigt werden.

Gruss an Alle
Andreas

''''''''''''''''''''''''''''''''''''''''''''''''''deklarieren''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function GetMenu Lib "user32" (ByVal _
hwnd As Long) As Long

Private Declare Function GetSubMenu Lib "user32" (ByVal _
hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function SetMenuItemBitmaps Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long, ByVal hBitmapUnchecked As _
Long, ByVal hBitmapChecked As Long) As Long

Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal bRevert As Long) 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 _
String) As Long

Const MF_STRING = &H0&
Const MF_SEPARATOR = &H800&
Const MF_BYPOSITION = &H400&
Const MF_BYCOMMAND = &H0&

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''form
load

Dim h1&, h2&, h3$, h4$, h5$
h1 = GetMenu(Me.hwnd)
h2 = GetSubMenu(h1, 0)
h3 = GetSubMenu(h1, 0)
h4 = GetSubMenu(h1, 0)
h5 = GetSubMenu(h1, 0)
'''''''''''''''''''''''''''''''''''''''''''''''''menu datei
Call SetMenuItemBitmaps(h2, 0, MF_BYPOSITION, _
Picture2.Picture, Picture2.Picture)
'Call SetMenuItemBitmaps(h2, 1, MF_BYPOSITION, _
' Picture2.Picture, Picture2.Picture)
' Call SetMenuItemBitmaps(h2, 2, MF_BYPOSITION, _
' Picture3.Picture, Picture3.Picture)
' Call SetMenuItemBitmaps(h2, 3, MF_BYPOSITION, _
' Picture4.Picture, Picture4.Picture)

'''''''''''''''''''''''''''''''''''''''''''''''''menu extra
h2 = GetSubMenu(h1, 1)
Call SetMenuItemBitmaps(h2, 0, MF_BYPOSITION, _
Picture3.Picture, Picture3.Picture)
Call SetMenuItemBitmaps(h2, 1, MF_BYPOSITION, _
Picture4.Picture, Picture4.Picture)
'Call SetMenuItemBitmaps(h2, 2, MF_BYPOSITION, _
' Picture7.Picture, Picture7.Picture)
'Call SetMenuItemBitmaps(h2, 3, MF_BYPOSITION, _
'Picture8.Picture, Picture8.Picture)

'''''''''''''''''''''''''''''''''''''''''''''''''menu hilfe
h3 = GetSubMenu(h1, 2)
Call SetMenuItemBitmaps(h3, 0, MF_BYPOSITION, _
Picture5.Picture, Picture5.Picture)

'''''''''''''''''''''''''''''''''''''''''''''''''menu popup menu visible
= false
h4 = GetSubMenu(h1, 3)
Call SetMenuItemBitmaps(h4, 1, MF_BYPOSITION, _
Picture6.Picture, Picture6.Picture)
'Call SetMenuItemBitmaps(h4, 1, MF_BYPOSITION, _
'Picture4.Picture, Picture4.Picture)
'Call SetMenuItemBitmaps(h4, 2, MF_BYPOSITION, _
' Picture7.Picture, Picture7.Picture)
'Call SetMenuItemBitmaps(h4, 3, MF_BYPOSITION, _
'Picture8.Picture, Picture8.Picture)


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
h1 = GetSystemMenu(hwnd, False)
Call AppendMenu(h1, MF_SEPARATOR, 0, "")
Call AppendMenu(h1, MF_STRING, &H200, "B&efehl 1")
Call AppendMenu(h1, MF_STRING, &H201, "Be&fehl 2")
Call AppendMenu(h1, MF_STRING, &H202, "Bef&ehl 3")
Call AppendMenu(h1, MF_STRING, &H203, "Befe&hl 4")

Call SetMenuItemBitmaps(h1, &H200, MF_BYCOMMAND, _
Picture2.Picture, Picture2.Picture)
'Call SetMenuItemBitmaps(h1, &H201, MF_BYCOMMAND, _
' Picture2.Picture, Picture2.Picture)
' Call SetMenuItemBitmaps(h1, &H202, MF_BYCOMMAND, _
' Picture3.Picture, Picture3.Picture)
' Call SetMenuItemBitmaps(h1, &H203, MF_BYCOMMAND, _
' Picture4.Picture, Picture4.Picture)
 

Lesen sie die antworten

#1 Gert Wietzorek
19/01/2008 - 18:37 | Warnen spam
Andreas schrieb:
Hallo Zusammen,
habe mir neulich ein Code um Ikon im Menu anzeigen zu können im Internet
runter geladen. Der Code wàhre sonnst gut wenn auch für popupmenu die Ikon
angezeigt werden.Für popupmenu funktioniert es aber nicht die Ikon werden
nicht angezeigt weil das menu für popupmenu visible = false ist.
Kann mir jemand sagen wie ich den code àndern muss damit die Icon auch im
Popupmenu angezeigt werden.



Hallo Andreas,

Visual Basic erstellt für unsichtbare Menüs keine API Menüs, Du kannst
hierfür also kein Handle erhalten.

Du kannst aber ganz leicht mit API Mitteln Dein eigenes Contextmenü
situationsbedingt erstellen und anzeigen...

Es folgt ein einfaches Beispiel (Luftcode) - eine Reihe von Konstanten
wirst Du einfach löschen können, werden in diesem Beispiel nicht
gebraucht, war nur zu bequem, das jetzt selbst zu machen ;-) ...

Erstelle eine neue Klasse und fügen den nachfolgenden Code ein, dann
kannst Du das PopUpmenü mit der Methode Init erstellen, danach mit der
Methode Add beliebige Menüeintrage hinzufügen und das Popupmenu
jederzeit (wàhrend die Klasse existiert) mit der PopUpMenu Methode aufrufen:

dim MeinPopUp as PopUpClass
set MeinPopUp=new popUpClass
MeinPopUp.init
MeinPopUp.add ..
MeinPopUp.add .
result=MeinPopUp.PopUpMenu(form1.hwnd)
select case result
case 0
'Abbruch
case 1
'Position 1 etc.
end select
set meinPopUp=nothing





Option Explicit

Private m_apiID&
Private Const WM_USER = &H400
Private Declare Function InsertMenu _
Lib "user32" _
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 CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenu _
Lib "user32" (ByVal hMenu As Long, _
ByVal wFlags As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nReserved As Long, _
ByVal hWnd As Long, _
ByVal lprc As Long) As Long
Private Enum TPMConst
TPM_CENTERALIGN = &H4&
TPM_LEFTALIGN = &H0&
TPM_LEFTBUTTON = &H0&
TPM_RIGHTALIGN = &H8&
TPM_RIGHTBUTTON = &H2&

TPM_NONOTIFY = &H80&
TPM_RETURNCMD = &H100
TPM_HORIZONTAL = &H0
TPM_VERTICAL = &H40

TPM_RECURSE = &H1
TPM_HORPOSANIMATION = &H400&
TPM_HORNEGANIMATION = &H800&
TPM_VERPOSANIMATION = &H1000&
TPM_VERNEGANIMATION = &H2000&
TPM_NOANIMATION = &H4000&
End Enum
Private Enum MFConst
MF_USECHECKBITMAPS = &H200&
MF_UNHILITE = &H0&
MF_UNCHECKED = &H0&
MF_SYSMENU = &H2000&
MF_STRING = &H0&
MF_SEPARATOR = &H800&
MF_SENDMSGS = &H2000000
MF_REMOVE = &H1000&
MF_POSTMSGS = &H4000000
MF_POPUP = &H10&
MF_OWNERDRAW = &H100&
MF_MENUBREAK = &H40&
MF_MOUSESELECT = &H8000&
MF_MENUBARBREAK = &H20&
MF_MASK = &HFF000000
MF_INSERT = &H0&
MF_LINKS = &H20000000
MF_HSZ_INFO = &H1000000
MF_HILITE = &H80&
MF_HELP = &H4000&
MF_GRAYED = &H1&
MF_ERRORS = &H10000000
MF_END = &H80
MF_ENABLED = &H0&
MF_DISABLED = &H2&
MF_DELETE = &H200&
MF_CONV = &H40000000
MF_CHANGE = &H80&
MF_CHECKED = &H8&
MF_CALLBACKS = &H8000000
MF_BYPOSITION = &H400&
MF_BYCOMMAND = &H0&
MF_BITMAP = &H4&
MF_APPEND = &H100&
End Enum
Public Enum classConst
c_initError = vbObjectError + 10001
c_addError = c_initError + 1
End Enum
Private Type POINTAPI
x As Long
y As Long
End Type

Public Sub Init(ByVal id&)
m_apiID = CreatePopupMenu()
End Sub

Public Sub Add(ByVal Caption As String, _
ByVal Position As Long, _
Optional ByVal IsChecked = False, _
Optional ByVal IsEnabled As Boolean = True, _
Optional ByVal Bitm As StdPicture = Nothing)
Dim flags As Long
If m_apiID = 0 Then Err.Raise c_initError, _
"cPopup:Add", _
"Aufruf von Init erforderlich"
If Caption = "-" Then
flags = MF_SEPARATOR Or MF_BYPOSITION
InsertMenu m_apiID, Position, flags, WM_USER + Position, ByVal ""
Else
flags = flags Or (IIf(IsEnabled, MF_ENABLED, _
MF_DISABLED Or MF_GRAYED))
flags = flags Or MF_STRING Or MF_BYPOSITION
If IsChecked Then _
flags = flags Or MF_CHECKED
InsertMenu m_apiID, Position, flags, _
WM_USER + Position, ByVal Caption
If Not Bitm Is Nothing Then _
SetMenuItemBitmaps m_apiID, _
Position, MF_BYPOSITION, Bitm, Bitm
End If


End Sub
Public Function PopUpMenu(ByVal ParentHWND&) As Long
'RESULT=0 falls Abbruch, sonst Position des
'Menüelementes im Popup
Dim Pt As POINTAPI
Dim result&
Dim mcount&
If m_apiID = 0 Then Err.Raise c_initError, _
"cPopup:PopUpMenu", _
"Aufruf von Init erforderlich"

If GetMenuItemCount(m_apiID) = 0 Then Err.Raise c_addError, _
"cPopup:PopUpMenu", _
"keine Menüeintràge vorhanden"
GetCursorPos Pt
result = TrackPopupMenu(m_apiID, TPM_LEFTALIGN Or _
TPM_NONOTIFY Or TPM_RETURNCMD, _
Pt.x, Pt.y, 0, ParentHWND, 0)
If result <> 0 Then
result = result - WM_USER
End If
PopUpMenu = result
End Function

Private Sub Class_Terminate()
If m_apiID Then
DestroyMenu m_apiID
End If
End Sub




Gruß
Gert


| Antworten nur in die Newsgroup, |
| die E-Mail Adressen existieren nicht! |
| |
| answers and questions only to the newsgroup,|
| the email adresses are not valid |
| |
| http://www.gwsoftware.de |

Ähnliche fragen