|
| |
Fortgeschrittene Programmierung| Re: Pulldown-Menüs | |  | | Autor: Martin01 | | Datum: 19.05.03 20:10 |
| '-----------------------------------------------------------------------------------------------
'Klasse: PopUp.cls
'-----------------------------------------------------------------------------------------------
'Add
' Aufruf Beispiele weiter unten.
'
' Add versucht mit Abfragen die Anweisungen richtig zu setzen.
'-----------------------------------------------------------------------------------------------
'Show
' Select .Show(Me.hWnd)
' Case 1
'...
' Select .Show(Me.hWnd, 100 ,100)
' Case 1
'...
' oder
' A = .Show(Me.hWnd)
' B = .Show(Me.hWnd, 100 ,100)
'
' Weitere Aufruf Beispiele weiter unten.
'
' zurück:
' 0 = Esc
' 1 ... Eintragsnummer
'-----------------------------------------------------------------------------------------------
'Clear
' Alle Add's - Einträge löschen -
' wenn z.B. auch ein zweites PupUp gezeigt werden soll.
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
'Einfaches PupUp
' mit einer Sammlung (!!!) und
' in einer Klasse (!!!).
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
'Wer eine noch einfachere Lösung für Laufzeit-PopUp's hat,
'soll sie weiter unten anstellen.
'-----------------------------------------------------------------------------------------------
Option Explicit
'PopUp
Private Const TPM_LEFTALIGN As Long = &H0&
Private Const TPM_NOANIMATION As Long = &H4000&
Private Const TPM_RETURNCMD As Long = &H100&
Private Const TPM_RIGHTBUTTON As Long = &H2&
Private Const MF_DISABLED As Long = &H2&
Private Const MF_GRAYED As Long = &H1&
Private Const MF_SEPARATOR As Long = &H800&
Private Const MF_STRING As Long = &H0&
Private Const MF_CHECKED As Long = &H8&
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal hWnd As Long, ByVal lptpm 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
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
'Mauszeiger
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Sammlung
Private marMenus As Collection
Private Sub Class_Initialize()
Set marMenus = New Collection
End Sub
Private Sub Class_Terminate()
Clear
Set marMenus = Nothing
End Sub
Public Sub Add( _
ByVal sMenuName As String, _
Optional ByVal bEnabled As Boolean = True, _
Optional ByVal bChecked As Boolean = False, _
_
Optional ByVal bIsSeparator As Boolean = False)
Dim lngFlag As Long
If Not bEnabled Then
lngFlag = MF_DISABLED Or MF_GRAYED '<- bEnabled
End If
If bChecked Then
lngFlag = lngFlag Or MF_CHECKED '<- evt. an bEnabled hinzufügen
End If
If bIsSeparator Then
lngFlag = MF_SEPARATOR '<- nur bIsSeparator
sMenuName = "" '<- Kein Menü Name
End If
lngFlag = lngFlag Or MF_STRING
marMenus.Add lngFlag
marMenus.Add sMenuName
End Sub
Public Function Show( _
ByVal lOwner_hWnd As Long, _
Optional ByVal x As Long = -1, _
Optional ByVal y As Long = -1) As Long
Dim i As Long
Dim iNo As Long
Dim cX As Long
Dim cY As Long
Dim Pt As POINTAPI
Dim lngRet As Long
Dim hMenu As Long
hMenu = CreatePopupMenu()
iNo = 1
With marMenus
For i = 1 To .Count Step 2
AppendMenu hMenu, _
marMenus.Item(i), _
iNo, _
marMenus.Item(i + 1)
iNo = iNo + 1
Next
End With
If x < 0 Or y < 0 Then
GetCursorPos Pt
With Pt
cX = .x
cY = .y
End With
Else
cX = Abs(x)
cY = Abs(y)
End If
lngRet = TrackPopupMenuEx(hMenu, _
TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON Or TPM_NOANIMATION, _
cX, cY, _
lOwner_hWnd, _
0)
DestroyMenu hMenu
Show = lngRet
End Function
Sub Clear()
Dim i As Long
With marMenus
For i = 1 To .Count
.Remove 1
Next i
End With
End Sub | |
 | Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
sevISDN 1.0 
Überwachung aller eingehender Anrufe!
Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Weitere InfosTipp des Monats sevZIP40 Pro DLL 
Zippen und Unzippen wie die Profis!
Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Weitere Infos
|
| |
|
Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
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.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|
Juli 2024
Sie sind aktuell nicht angemeldet.
