Knifflige Sache : UserForm-Menü mit Icon
11.08.2005 15:36:46
Frank
ich versuche meinem UserForm ein "professionelles" Ausehen zu geben,
also muss ein Menü her und auf diesem rechts Icon, genaus wie in den Excel Memüs!
Meine Struktur :
Public 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
hbmpItem As Long 'erst ab Win2000
End Type
meine Klassen -
Sub :
Public
Sub CreateSubMenu(ByVal MenuID As Long, _
ByVal MenuCaption As String, _
ByVal HasSubMenu As Boolean, _
ByVal Position As Long, _
Optional PaintSeparator As Boolean = False, _
Optional BitMapHandle As Long = 0)
MnuError = 0
If (hUFMenu = 0 And hPopUpMenu = 0) Or Len(MenuCaption) = 0 Then Exit Sub
With mnuItemInfo
.cbSize = Len(mnuItemInfo)
.fMask = MIIM_TYPE Or MIIM_SUBMENU Or MIIM_ID 'Or MIIM_BITMAP
.fType = MF_STRING
If PaintSeparator Then
.fType = MF_SEPARATOR
End If
.wID = MenuID
.hSubMenu = 0
If PaintSeparator Then GoTo InsertMe
If BitMapHandle = 0 Then GoTo NoBitmap
.hbmpItem = BitMapHandle
NoBitmap:
If HasSubMenu Then .hSubMenu = hPopUpMenu
.dwTypeData = MenuCaption
.cch = Len(.dwTypeData)
InsertMe:
End With
InsertMenuItem hPopUpMenu, Position, True, mnuItemInfo
MnuError = -1
End Sub
ermitteln der Bitmap handles!!
Public
Function SetMenuItemBitMap(ByVal PicLocation As String, _
ByVal PicPosition As Long) As Long
Dim hPic As Long
Dim hSubMenu As Long
If hUFMenu = 0 Then Exit Function
hPic = user32.LoadImage(UFHandle, _
PicLocation, _
IMAGE_BITMAP, _
16, _
16, _
LR_LOADFROMFILE)
SetMenuItemBitMap = hPic
End Function
in dem Formular wir gehabt ...
1. UserForm Handle ermittlen ... FindWindow(.....
2. Menü erzeugen!
3. bei bedarf SubMenü erzeugen!
Menüs werden erzeugt aber keine Icon rechts neben den Einträgen!
Hat jemand über das Problem schon nachgedacht und eine Lösung?
Hab mal gegoogelt und folgenden Link gefunden :
http://64.233.183.104/search?q=cache:vJ0OBe8dxkIJ:www.ttvnol.com/f_147/193561/trang-17.ttvn+Public+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+hbmpItem+As+Long+dwItemData+As+Long+dwTypeData+As+String+cch+As+Long+End+Type&hl=de
aber der Code ist starker Tobak! ausserdem möchte ich keine ASM.....
Gruss Frank