Autor Thema: Dynamische Aktionen Lotus Notes 8.01  (Gelesen 19861 mal)

Offline Fedaykin

  • Aktives Mitglied
  • ***
  • Beiträge: 229
  • Geschlecht: Männlich
  • Ya Hya Chouhada!
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #20 am: 04.06.09 - 13:47:54 »
Hallo Toni

Habe unter 8.5 mit Deinem Code rumgespielt und dabei festgestellt, dass er in einer Dialogbox noch funktioniert. Kam darauf, da beim Debuggen auch aufgepoppt ist. Hilft leider nicht wirklich, aber dachte schreib es Dir trotzdem.

Gruss
Remo
Ich sage Euch: "Man muss noch Chaos in sich haben, um einen tanzenden Stern gebären zu können."

Offline ata

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 5.092
  • Geschlecht: Männlich
  • drenaiondrufflos
    • Anton Tauscher Privat
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #21 am: 04.06.09 - 19:14:39 »
Hallo Remo,

hab ich gleich nachvollzogen, aber wie du schon gesagt hast - hilft nicht wirklich  :'( :'( :'(

Toni
Grüßle Toni :)

Offline ata

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 5.092
  • Geschlecht: Männlich
  • drenaiondrufflos
    • Anton Tauscher Privat
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #22 am: 25.11.09 - 08:09:19 »
Hallole @All,

... ein Grund zur Freude - die dynamischen Aktionen funktionieren nun auch unter 8.51 Eclipse-Client - das heißt das GetActiveWindow() muß gegen GetFocus() ausgetauscht werden - und schon tut es - viel Spaß damit...

Toni  ;D ;D ;D ;D ;D
Grüßle Toni :)

Offline eknori

  • @Notes Preisträger
  • Moderator
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 11.710
  • Geschlecht: Männlich
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #23 am: 25.11.09 - 08:21:29 »
Jetzt wo du es schreibst, fällt mir ein, was ich noch ausprobieren wollte.

Für die, die es nachmachen wollen:

Einfach die bestehende Declaration

Code
Declare Function GetActiveWindow Lib "user32" Alias "GetActiveWindow " () As Long

ändern in

Code
Declare Function GetActiveWindow Lib "user32" Alias "GetFocus " () As Long

Auf LDD gab es unlängst eine Diskussion zu diesem Thema http://www-10.lotus.com/ldd/nd85forum.nsf/DateAllThreadedWeb/3f84aa508f63f4268525766c00074f54?OpenDocument
« Letzte Änderung: 25.11.09 - 08:23:33 von eknori »
Egal wie tief man die Messlatte für den menschlichen Verstand auch ansetzt: jeden Tag kommt jemand und marschiert erhobenen Hauptes drunter her!

Offline ata

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 5.092
  • Geschlecht: Männlich
  • drenaiondrufflos
    • Anton Tauscher Privat
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #24 am: 25.11.09 - 08:31:15 »
... auf den Beitrag war ich auch gestossen worden - nu' kann ich wieder ruhiger schlafen  ;) ;) ;)
Grüßle Toni :)

Offline Fedaykin

  • Aktives Mitglied
  • ***
  • Beiträge: 229
  • Geschlecht: Männlich
  • Ya Hya Chouhada!
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #25 am: 04.12.09 - 10:34:19 »
Hallo zusammen

Habe gestern die neuen Beiträge entdeckt, keine Ahnung wieso ich keine Benachrichtigung bekommen habe.
Kann nur sagen klappt nun super.  ;D

PS I: Und nochmals vielen, vielen Dank an Toni, für den PopUp Code und seine Session "Dynamische Aktionen" am Entwicklercamp 2008.
PS II: Ist im !!Help!! noch nicht korrigiert. Damit hab ich es gestern zuerst mal versucht.  :)

Gruss
Remo
« Letzte Änderung: 04.12.09 - 10:35:57 von Fedaykin »
Ich sage Euch: "Man muss noch Chaos in sich haben, um einen tanzenden Stern gebären zu können."

Offline ata

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 5.092
  • Geschlecht: Männlich
  • drenaiondrufflos
    • Anton Tauscher Privat
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #26 am: 04.12.09 - 14:10:28 »
Hallo Remo,

danke für die Rückmeldung...

Toni  ;D ;D ;D
Grüßle Toni :)

Offline Fedaykin

  • Aktives Mitglied
  • ***
  • Beiträge: 229
  • Geschlecht: Männlich
  • Ya Hya Chouhada!
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #27 am: 05.12.09 - 20:20:47 »
Hallo Toni

Habe Deinen PopUp Code etwas abgeändert, dass er auch über mehrere Level funktioniert. Kann Dir den Code zuschicken oder hier reinstellen wenn das für Dich okay ist.

Gruss
Remo
Ich sage Euch: "Man muss noch Chaos in sich haben, um einen tanzenden Stern gebären zu können."

Offline ata

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 5.092
  • Geschlecht: Männlich
  • drenaiondrufflos
    • Anton Tauscher Privat
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #28 am: 05.12.09 - 20:59:43 »
... ja - das interessiert mich natürlich...

Toni
Grüßle Toni :)

Offline Fedaykin

  • Aktives Mitglied
  • ***
  • Beiträge: 229
  • Geschlecht: Männlich
  • Ya Hya Chouhada!
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #29 am: 05.12.09 - 21:35:39 »
Hallo Toni

Hier der Code. Viel Spass beim ausprobieren.

Gruss
Remo

Aufruf bei mir ein Button

Code
use "slPopUp"

Sub Click(Source As Button)
	Dim objPopUp As New PopUp
	
	With objPopUp
		.AddEntry "Main/aaa","aaa"
		.AddEntry "Main/-","aaa"
		.AddEntry "Main/Sub1/bbb","bbb"
		.AddEntry "Main/Sub1/-",""
		.AddEntry "Main/Sub1/Sub2/ccc","ccc"
		.AddEntry "Main/Sub1/Sub2/-",""
		
		.AddEntry "Main/Sub2/bbb","bbb"
		.AddEntry "Main/Sub2/-",""
		.AddEntry "Main/Sub2/Sub2/ccc","ccc"
		.AddEntry "Main/Sub2/Sub2/-",""
		
		.AddEntry "Main/ddd","ddd"
		.AddEntry "Test2","ddd"
		
		.Display
		
		If Not .Label="" Then
			Msgbox "Label: " & .Label & Chr(13) & "ID: " & .ID,,"Label"
		End If
	End With
End Sub



Code von slPopUp

Code
Option Public 
Option Declare

Const cLibName="slPopup" 

' # ######################################### 

' # Win-API 32 Strukturen: 
' # Struktur für Fensterverwaltung 
Type RECT 
	Left As Long 
	Top As Long 
    Right As Long 
    Bottom As Long 
End Type 

' # Struktur für Positionsbestimmung der Maus 
Type POINTAPI 
    x As Long 
    y As Long 
End Type 

' # Struktur für Win-API-Popup-Menü-Struktur 
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 
    Alias As String ' # zusätzlich deklariert 
End Type 

' # Win-API-Konstanten: 
' # ... MENUITEMINFO fMask-Konstanten 
Const MIIM_STATE = &H1 ' benutzt die fState-Optionen 
Const MIIM_ID = &H2 ' benutzt die wID-Option 
Const MIIM_SUBMENU = &H4 ' benutzt die hSubMenu-Option 
Const MIIM_CHECKMARKS = &H8 ' benutzt die hbmpChecked- und hb,pUnchecked-Optionen 
Const MIIM_DATA = &H20 ' benutzt die dwItemDate-Option 
Const MIIM_TYPE = &H10 ' benutzt die dwTypeData-Option 

' MENUITEMINFO fType-Konstanten 
Const MFT_BITMAP = &H4 ' Das Handle des Bitmaps muss in dwTypeData übergeben werden. Kann nicht mit MFT_SEPARATOR oder MFT_STRING kombiniert werden 
Const MFT_MENUBARBREAK = &H20 ' platziert das Menü ein einer neuen Zeile oder Spalte und zeichnet über und unter dem Eintrag einen Separator 
Const MFT_MENUBREAK = &H40 ' das Gleiche wie MFT_MENUBARBREAK, nur ohne Separator 
Const MFT_OWNERDRAW = &H100 ' überlässt das Neuzeichnen des Menüs dem Fenster 
Const MFT_RADIOCHECK = &H200 ' zeigt einen Radiobutton als Checked/Unchecked an 
Const MFT_RIGHTJUSTIFY = &H4000 ' richtet ein Menü rechtsbündig aus 
Const MFT_RIGHTORDER = &H2000 ' (Win 9x, 2000) die Menüs platzieren sich rechts voneinander und es wird Text von rechts nach links unterstützt 
Const MFT_SEPARATOR = &H800 ' zeichnet eine horizontale Linie in den MenueEintrag. Kann nicht mit MFT_BITMAP oder MFT_STRING kombiniert werden 
Const MFT_STRING = &H0 ' der MenueEintrag wird mit einem String gefüllt, deTypeData ist der String, der angezeigt werden soll und cch die Länge des Strings.   

' MENUITEMINFO fState-Konstanten 
Const MFS_CHECKED = &H8 ' MenueEintrag ist markiert 
Const MFS_DEFAULT = &H1000 ' MenueEintrag ist die Standard-Auswahl 
Const MFS_DISABLED = &H2 ' MenueEintrag ist deaktiviert 
Const MFS_ENABLED = &H0 ' MenueEintrag ist aktiviert 
Const MFS_GRAYED = &H1 ' MenueEintrag ist grau und deaktiviert 
Const MFS_HILITE = &H80 ' MenueEintrag hat die Selektierung 
Const MFS_UNCHECKED = &H0 ' MenueEintrag ist nicht markiert 
Const MFS_UNHILITE = &H0 ' MenueEintrag hat nicht die Selektierung 

' Konstanten für Win-API-TrackPopupmenu und Flags-Konstanten 
Const TPM_CENTERALIGN = &H4 ' positioniert das Menü horizontal in der Mitte von x 
Const TPM_LEFTALIGN = &H0 ' positioniert das Menü horizontal mit dem linken Rand auf x 
Const TPM_RIGHTALIGN = &H8 ' positioniert das Menü horizontal mit dem rechten Rand auf x 
Const TPM_BOTTOMALIGN = &H20 ' positioniert das Menü mit dem unteren Rand auf y 
Const TPM_TOPALIGN = &H0 ' positioniert das Menü mit dem oberen Rand auf y 
Const TPM_VCENTERALIGN = &H10 ' positioniert das Menü vertikal in der Mitte von y 
Const TPM_NONOTIFY = &H80 ' sendet kein WM_COMMAND an das Elternfenster des Menüs bei Ereignissen 
Const TPM_RETURNCMD = &H100 ' die Funktion gibt den ID des Menüs zurück, das gewählt wurde 
Const TPM_LEFTBUTTON = &H0 ' erlaubt dem Benutzer nur das Markieren der Einträge über die linke Maustaste und die Tastatur 
Const TPM_RIGHTBUTTON = &H2 ' erlaubt den Benutzer, die Einträge mit jedem Mausbutton und der Tastatur zu wählen 

' # WinAPI.Popup-Selection-Funktionen 
Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long 
Declare Function CreatePopupMenu Lib "user32" Alias "CreatePopupMenu" ( ) As Long 
Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" ( ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO ) As Long 
Declare Function TrackPopupMenu Lib "user32" Alias "TrackPopupMenu" (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 RECT) As Long 
Declare Function DestroyMenu Lib "user32" Alias "DestroyMenu" (ByVal hMenu As Long) As Long 
'Declare Function GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Long 
Declare Function GetFocus Lib "user32" Alias "GetFocus" () As Long 
Class PopUp 
	Private aryEntries() As String 
    Private mstrLabel As String 
    Private mstrID As String 
    Private mlngEntriesCount As Long 

    Sub AddEntry(Label As String, ID As String) 
        ReDim Preserve aryEntries(mlngEntriesCount) 
        mlngEntriesCount=mlngEntriesCount+1 
        aryEntries(UBound(aryEntries))=Label & "|" & ID                 
    End Sub 
    
    Sub Display 
        popupSelect 
    End Sub 

    Property Get Label As String 
        Label=mstrLabel 
    End Property 

    Property Get ID As String 
        ID=mstrID                 
    End Property 
        
    Private Sub popupSelect() 
       ' # Einen Wert über ein Popup-Menü ermitteln. 
       ' # sMenu => Variant-Textliste 
	   ' # ... ein Element hat die Syntax "<Hauptmenü-Label> / <Submenu-Label> | <Alias>" 
       ' # ... enthält der String einen Slash, so wird ein Untermenü erzeugt 
       ' # ... enthält der String eine Pipe, so wird der Teil danach als Alias verwendet 
       ' # ... es kann pro String nur einen Slash und eine Pipe geben. weitere Kaskadierungen sind nicht vorgesehen. 
       ' # Rückgabe ist ein Array mit 2 Elementen => PopuSelect(0) = ausgewähltes Label, PopupSelect(1) = Alias des ausgewählten Labels 

	    Const cLSName = "PopupSelect" 
        On Error GoTo ErrorHandle 
    
        Dim MenueEintrag() As MENUITEMINFO 
        Dim Flags As Long 
        Dim hWnd As Long 
        Dim pos As POINTAPI 
        Dim hReturn As Long 
        Dim hPopupMenu As Long 
        Dim rectdata As RECT 
                   ' 
        Dim hSubs List As Long 
        Dim vParam As Variant 

        Dim sLabel As String

        Dim sLabels() As String
        Dim sAlias As String 
        Dim countMenu As Integer 
        Dim vMenuEntries As Variant
        Dim vLabels As Variant
        Dim hParent As long
        
        Dim i As long
		' 
		' # Handle des aktuellen Fensters 
        hWnd = GetFocus( ) 
		' 
		' Position des Fensters ermitteln 
        GetCursorPos pos 
		' 
		' Popupmenü erstellen 
        hPopupMenu = CreatePopupMenu() 
		' 
		' # Bilden des Menübaumes 
        ForAll sEntry In aryEntries 
            countMenu = countMenu + 1 
            ReDim Preserve MenueEintrag(1 To countMenu) 
            If InStr(sEntry, "|") > 0 Then 
                vParam = Split(sEntry,"|") 
                sLabel = Trim(vParam(0)) 
                sAlias = Trim(vParam(1)) 
            Else 
                sLabel = Trim(sEntry) 
                sAlias = sLabel 
            End If 
			'
			vLabels=Split(sLabel,"/")
			
			ReDim sLabels(UBound(vLabels))
			For i=LBound(vLabels) To UBound(vLabels)
				sLabels(i)=Trim(vLabels(i))
			Next
			
			hParent=hPopupMenu
			sLabel=""
			For i=0 To UBound(sLabels)-1
				
				If sLabel="" then
					sLabel=sLabels(i)
				Else
					sLabel=sLabel & "/" & sLabels(i)	
				End if
    	        If Not IsElement(hSubs(sLabel)) Then
    	        	hSubs(sLabel) = CreatePopupMenu()
   		    		CreateMenueEntry hParent, hSubs(sLabel), sLabels(i) & "/", "", MenueEintrag(countMenu), countMenu
                	countMenu = countMenu + 1 
	           		ReDim Preserve MenueEintrag(1 To countMenu)
				End If
				hParent=hSubs(sLabel)
			Next i
			
			CreateMenueEntry hParent, 0, sLabels(UBound(sLabels)), sAlias, MenueEintrag(countMenu), countMenu
		End ForAll 
		' 
		' Menü anzeigen 
		'Print "Position x = " & pos.x & " / y = " & pos.y 
		' 
        Flags = TPM_TOPALIGN Or TPM_LEFTALIGN Or TPM_NONOTIFY Or TPM_RETURNCMD 
		' 
        hReturn = TrackPopupMenu(hPopupMenu , Flags, pos.x , pos.y , 0&, hwnd , rectdata) 
		' 
		' gewähltes Menü ausgeben, wenn eines gewählt wurde 
        If hReturn <> 0 Then 
			'MsgBox "Sie haben auf """ & Replace(MenueEintrag(Retval).Alias, "&", "", 1, 1) & """ gedrückt" 
		End If 
		' 
		' # Speicherplatz wieder freigeben... 
		DestroyMenu hPopupMenu 
        ForAll handles In hSubs 
            DestroyMenu handles 
        End ForAll 
		' 
        If hReturn > 0 Then 
			mstrLabel=Replace(MenueEintrag( hReturn ).dwTypeData, "&", "", 1, 1) 
			mstrID=Replace(MenueEintrag( hReturn ).Alias , "&", "", 1, 1) 
		Else 
			' # skip - OK - leeres Array 
            mstrLabel="" 
            mstrID="" 
        End If 

    Exit Sub 
	ErrorHandle: 
    	MsgBox cLibName & "." & cLSName & ": " & Error , 16 , "Fehler " & Err & " in Zeile " & Erl 
    	End Erl() 
	End Sub 
    
	Private sub createMenueEntry(hPopupMenu As Long, hSub1 As Long, sEntry As String, sAlias As String, MEintrag As MenuItemInfo, Index As Integer) 
		' # Erstellt einen Menüeintrag 
    	Const cLSName = "CreateMenueEntry" 
    	On Error GoTo ErrorHandle 
    
    	Dim vReturn As Variant 
		' MenueEintrag hinzufügen (sEntry) 
    	MEintrag.cbSize = Len(MEintrag) 
    	MEintrag.dwTypeData = sEntry 
    	MEintrag.Alias = sAlias 
    	MEintrag.cch = Len(Trim$(MEintrag.dwTypeData)) 
		' 
    	If Right(sEntry, 1) = "/" Then 
            MEintrag.dwTypeData = Replace(sEntry, "/", "") 
            MEintrag.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU 
            MEintrag.hSubMenu = hSub1 
            MEintrag.fState = 0 ' # MFS_CHECKED 
    	Else 
            MEintrag.fMask = MIIM_TYPE Or MIIM_ID 
            MEintrag.fState = MFS_DEFAULT Or MFS_HILITE 
    	End If 
		' 
    	If sEntry = "-" Then 
            MEintrag.fType = MFT_SEPARATOR 
    	Else 
    	    MEintrag.fType = MFT_STRING 
    	End If 
		' 
    	MEintrag.wID = Index 
		' 
    	vReturn = InsertMenuItem(hPopupMenu, 0&, 0&, MEintrag) 
    	' 
    	If vReturn = 0 Then 
            Print "... MenueEintrag konnte nicht hinzugefügt werden: " & sEntry & "."
	    End If   
    Exit Sub 
	ErrorHandle: 
        MsgBox cLibName & "." & cLSName & ": " & Error, 16, "Fehler " & Err & " in Zeile " & Erl 
        End Erl() 
	End Sub

End Class
« Letzte Änderung: 09.12.09 - 09:41:56 von Fedaykin »
Ich sage Euch: "Man muss noch Chaos in sich haben, um einen tanzenden Stern gebären zu können."

Offline ata

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 5.092
  • Geschlecht: Männlich
  • drenaiondrufflos
    • Anton Tauscher Privat
Re: Dynamische Aktionen Lotus Notes 8.01
« Antwort #30 am: 05.12.09 - 21:47:43 »
Hallo Remo,

danke für den Code - werde ich mir morgen mal genauer anschauen...  ;D ;D ;D ;D

Toni
Grüßle Toni :)

 

Impressum Atnotes.de  -  Powered by Syslords Solutions  -  Datenschutz