Deklaration: Declare Function RemoveMenu Lib "user32.dll" ( _ ByVal hMenu As Long, _ ByVal uPosition As Long, _ ByVal uFlags As Long) As Long
Const MF_BYCOMMAND = &H0 ' Der Wert stellt die Menü-ID dar. Const MF_BYPOSITION = &H400 ' Der Wert stellt die nullbasierte relative Position des Menüelements dar.
Beispiel: Private Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As Long) As Long Private Declare Function GetMenuItemCount Lib "user32.dll" (ByVal hMenu As Long) As Long Private Declare Function GetMenuItemInfo Lib "user32.dll" _ Alias "GetMenuItemInfoA" ( _ ByVal hMenu As Long, _ ByVal uItem As Long, _ ByVal fByPosition As Long, _ lpmii As MENUITEMINFO) As Long Private Declare Function GetSystemMenu Lib "user32.dll" ( _ ByVal hwnd As Long, _ ByVal bRevert As Long) As Long Private Declare Function SetMenuItemInfo Lib "user32.dll" _ Alias "SetMenuItemInfoA" ( _ ByVal hMenu As Long, _ ByVal uItem As Long, _ ByVal fByPosition As Long, _ lpmii As MENUITEMINFO) As Long Private Declare Function RemoveMenu Lib "user32.dll" ( _ ByVal hMenu As Long, _ ByVal uPosition As Long, _ ByVal uFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long 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 ' einige der MENUITEMINFO fMask-Konstanten Private Const MIIM_SUBMENU = &H4 ' die hSubMenü-Option soll gefüllt/behandelt werden Private Const MIIM_TYPE = &H10 ' die fType-Option soll gefüllt/behandelt werden ' einige der MENUITEMINFO fType-Konstanten Private Const MFT_BITMAP = &H4 ' der Menüeintrag ist ein Bitmapmenü Private Const MFT_SEPARATOR = &H800 ' der Menüeintrag ist ein Separator Private Const MFT_STRING = &H0 ' der Menüeintrag ist ein String ' einige der RemoveMenu uPosition-Konstanten Private Const MF_BYCOMMAND = &H0 ' der Wert stellt die Menü-ID dar Private Const MF_BYPOSITION = &H400 ' der Wert stellt die nullbasierte relative ' Position des Menüelements dar Private SelectedHwnd As Long ' starten des Ermittelns der Menüs unserer Form Private Sub Form_Load() SelectedHwnd = Me.hwnd SetTreeview SelectedHwnd MsgBox "Starten Sie mit der rechten Maustaste das Editieren der Menüeinträge." _ & vbCrLf & "Bitte geben Sie nur den Text und evtl. ein &-Zeichen des neuen _ Menüs ein.", vbInformation, "Bitte beachten" End Sub ' Treeview der aktuellen Fenstergröße anpassen Private Sub Form_Resize() On Error Resume Next TreeView1.Width = Me.ScaleWidth - (2 * TreeView1.Left) TreeView1.Height = Me.ScaleHeight - (2 * TreeView1.Top) End Sub ' Treeview mit den Menüs des angegebenen Fensters füllen Private Function SetTreeview(ByVal hwnd As Long) Dim Retval As Long, hSysMenu As Long, hMenuBar As Long Dim RootNode As Node, RelNode As Node ' Treeview leeren TreeView1.Nodes.Clear ' Root im Treeview erstellen Set RootNode = TreeView1.Nodes.Add(, , "Menüs des Fensters", "Menüs des Fensters") RootNode.Expanded = True ' Systemmenü-Eintrag im Treeview erstellen Set RelNode = TreeView1.Nodes.Add(RootNode, tvwChild, "Systemmenue", "Systemmenü") RelNode.Expanded = True ' Systemmenü-Einträge Ermitteln und ins Treeview übertragen hSysMenu = GetSystemMenu(hwnd, False) If hSysMenu << 0 Then GetMenuItems hSysMenu, RelNode End If ' Menüleisten-Menüeintrag im Treeview erstellen Set RelNode = TreeView1.Nodes.Add(RootNode, tvwChild, "Menüleiste", "Menüleiste") RelNode.Expanded = True ' Menüleisten-Einträge ermitteln und ins Treeview übertragen hMenuBar = GetMenu(hwnd) If hMenuBar << 0 Then GetMenuItems hMenuBar, RelNode End If End Function ' alle Untermenüs ermitteln Private Function GetMenuItems(ByVal hMenuStart As Long, ByRef RootNode As Node) Dim MenuItemCount As Long, TmpMenuInfo As MENUITEMINFO Dim RelNode As Node ' Anzahl Einträge ermitteln MenuItemCount = GetMenuItemCount(hMenuStart) ' Einträge ermitteln und hinzufügen, falls vorhanden If MenuItemCount < 0 Then For i = 0 To MenuItemCount - 1 ' Informationen des Eintrags ermitteln With TmpMenuInfo .cbSize = Len(TmpMenuInfo) .fMask = MIIM_SUBMENU Or MIIM_TYPE .cch = 256 .dwTypeData = Space(.cch) End With Retval = GetMenuItemInfo(hMenuStart, i, True, TmpMenuInfo) ' Besonderheiten auswerten, bis zum VBNullChar abschneiden und ' "VBTabs" ersetzen If CBool(TmpMenuInfo.fType And MFT_BITMAP) = True Then TmpMenuInfo.dwTypeData = "Bitmap" ElseIf CBool(TmpMenuInfo.fType And MFT_SEPARATOR) = True Then TmpMenuInfo.dwTypeData = "Trennlinie" Else TmpMenuInfo.dwTypeData = Left$(TmpMenuInfo.dwTypeData, TmpMenuInfo.cch) TmpMenuInfo.dwTypeData = Replace(TmpMenuInfo.dwTypeData, vbTab, Space(5)) End If ' Eintrag ins Treeview übertragen Set RelNode = TreeView1.Nodes.Add(RootNode, tvwChild, "(" & CStr(i) _ & ") - " & TmpMenuInfo.dwTypeData, CStr(i) & " - " & TmpMenuInfo.dwTypeData) RelNode.Tag = hMenuStart RelNode.Expanded = True ' Falls Submenüs gefunden, auch diese ermitteln If TmpMenuInfo.hSubMenu << 0 Then Call GetMenuItems(TmpMenuInfo.hSubMenu, RelNode) End If Next i End If End Function ' ändern eines Eintrags im Treeview im Menü vollziehen Private Sub TreeView1_AfterLabelEdit(Cancel As Integer, NewString As String) Dim Retval As Long, OldValue As Node, MsgRet As Long, TmpMenuInfo As MENUITEMINFO ' aktuell ausgewählten Treeview-Eintrag bestimmen Set OldValue = TreeView1.Nodes(TreeView1.SelectedItem.Index) ' prüfen, ob der alte Eintrag vom Typ String ist oder ein nicht änderbarer ' Eintrag markiert wurde, andernfalls die Funktion abbrechen If OldValue.Text = "Bitmap" Or OldValue.Text = "Trennlinie" Or OldValue.Text = _ "Systemmenü" Or OldValue.Text = "Menüleiste" Or OldValue.Text = "Menüs des _ Fensters" Then MsgBox "Dieser Menüeintrag kann nicht geändert werden" Cancel = True Exit Sub End If ' Eintrag löschen ? If NewString = "" Then MsgRet = MsgBox("Sie sind im Begriff den Menüeintrag zu entfernen, wollen _ sie fortfahren ?", vbQuestion + vbYesNo, "Achtung !!") If MsgRet = vbYes Then ' Menüeintrag entfernen RemoveMenu OldValue.Tag, CLng(Left$(OldValue.Text, InStr(1, _ OldValue.Text, " - ") - 1)), MF_BYPOSITION ' Treeview-Eintrag entfernen TreeView1.Nodes.Remove OldValue.Index Cancel = True Exit Sub Else Cancel = True Exit Sub End If ' Eintrag umbenennen ? Else MsgRet = MsgBox("Sie sind im Begriff den Menüeintrag umzubenennen, wollen _ sie fortfahren ?", vbQuestion + vbYesNo, "Achtung !!") If MsgRet = vbYes Then ' Menüeintrag umbenennen ' erst einmal die Originaldaten ermitteln With TmpMenuInfo .cbSize = Len(TmpMenuInfo) .fMask = MIIM_SUBMENU Or MIIM_TYPE Or MIIM_TYPE .cch = 256 .dwTypeData = Space(.cch) End With Retval = GetMenuItemInfo(OldValue.Tag, CLng(Left$(OldValue.Text, _ InStr(1, OldValue.Text, " - ") - 1)), True, TmpMenuInfo) ' dann Caption Text ändern und dem Menüeintrag diese Änderung zuweisen TmpMenuInfo.dwTypeData = NewString TmpMenuInfo.cch = Len(NewString) Retval = SetMenuItemInfo(OldValue.Tag, CLng(Left$(OldValue.Text, _ InStr(1, OldValue.Text, " - ") - 1)), 1, TmpMenuInfo) If Retval = 0 Then MsgBox "Der Menüeintrag konnte nicht geändert werden" Cancel = True Exit Sub End If NewString = CLng(Left$(OldValue.Text, InStr(1, OldValue.Text, " - ") _ - 1)) & " - " & NewString ' sorgt dafür, dass keine Grafikfehler auftreten, wenn in der Menüleiste ' ein Eintrag länger wird DrawMenuBar SelectedHwnd Else Cancel = True Exit Sub End If End If End Sub Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y _ As Single) If Button = vbRightButton Then TreeView1.StartLabelEdit End If End Sub Diese Seite wurde bereits 9.109 mal aufgerufen. |
sevAniGif (VB/VBA) Anzeigen von animierten GIF-Dateien Ab sofort lassen sich auch unter VB6 und VBA (Access ab Version 2000) animierte GIF-Grafiken anzeigen und abspielen, die entweder lokal auf dem System oder auf einem Webserver gespeichert sind. Buchempfehlung Tipp des Monats Dezemeber 2024 Roland Wutzke MultiSort im ListView-Control Dieses Beispiel zeigt, wie sich verschiedene Sortierfunktionen für ein ListView Control realisieren lassen. TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |