PureBoard

Verfasst: **23.01.2008 00:04**

als Beispiel oder wer Spaß daran hat

Funktion: sowie der Mauszeiger den Button Bearbeiten oder den ImageButton berührt klappt ein PopUpMenu auf.

Code: Alles auswählen

Declare myWindowCallback(hWnd, message, wParam, lParam) 

#buttonbr=80
#buttonhh=30

Enumeration
#window
#buttonnr1=10
#buttonnr3
#buttonnr4
#listiconnr

#popup01
#popup01itemA
#popup01itemB
#popup01itemC
#popup01itemD
#popup01Ende
#popup02
#popup02itemA
#popup02itemB
#popup02itemC
#popup02Ende
EndEnumeration

;Image=====================================================      

UseJPEGImageDecoder()
pfad1$=#PB_Compiler_Home+"Examples\Sources\Data\" 
bitmap0ID = ImageID(LoadImage(#PB_Any,pfad1$+"terrain_detail.jpg"))
bitmap1ID = ResizeImage(LoadImage(#PB_Any,pfad1$+"PureBasicLogo.bmp"),#buttonbr,#buttonhh)

;PopUP=====================================================      

pop01ID=CreatePopupMenu(#popup01)
        MenuItem (#popup01itemA, "1.Zeile weg")
        MenuItem (#popup01itemB, "letzte Zeile weg")
        MenuItem (#popup01itemC, "mittlere Zeile weg")
        MenuItem (#popup01itemD, "es passiert nix")
        ;usw
                
pop02ID=CreatePopupMenu(#popup02)
        MenuItem (#popup02itemA, "in Spalte 1 steht Blubb")
        MenuItem (#popup02itemB, "in Spalte 2 steht Guten Tag")
        MenuItem (#popup02itemC, "Liste wird gelöscht")
        ;usw
                
Structure MENUINFO 
  cbSize.l 
  fMask.l 
  dwStyle.l 
  cyMax.l 
  hbrBack.l 
  dwContextHelpID.l 
  dwMenuData.l 
EndStructure 

#MIM_BACKGROUND=2 
#MIM_STYLE=16
#MNS_AUTODISMISS = $10000000 

MI.MENUINFO\cbSize=SizeOf(MENUINFO) 
;MI\hbrBack=CreateSolidBrush_(farbe)  ;irgendeine farbe 
;oder
MI\hbrBack=CreatePatternBrush_(bitmap0ID)
MI\fMask=#MIM_BACKGROUND | #MIM_STYLE
MI\dwStyle=#MNS_AUTODISMISS 

SetMenuInfo_(pop01ID,MI)
SetMenuInfo_(pop02ID,MI)

;=====================================================      

WindowBreite = 700                    
WindowHoehe  = 500

hWnd=OpenWindow(#window, 0,0, WindowBreite, WindowHoehe, "",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
     CreateGadgetList(WindowID(0)) 
   
      idnr1=ButtonGadget(#buttonnr1, 100,450,#buttonbr,#buttonhh,"Zeile add") 
      idnr3=ButtonGadget(#buttonnr3, 200,450,#buttonbr,#buttonhh,"Bearbeiten") 
      idnr4=ButtonImageGadget(#buttonnr4, 350,50,#buttonbr,#buttonhh,bitmap1ID) 
      
      sp=10:ze=10
      idlig=ListIconGadget(#listiconnr,sp,ze,300+4,400,"Spalte1",100)
      AddGadgetColumn(#listiconnr,1,"spalte2",100)
      AddGadgetColumn(#listiconnr,2,"spalte3",100)
      
      SendMessage_(idlig,#LVM_SETTEXTCOLOR,0,#Blue)
      SendMessage_(idlig,#LVM_SETBKCOLOR,0,GetSysColor_(#COLOR_BTNFACE))
      SendMessage_(idlig,#LVM_SETTEXTBKCOLOR,0,GetSysColor_(#COLOR_BTNFACE))
   
SetWindowCallback(@myWindowCallback()) 
   
Repeat 
    EventID = WaitWindowEvent()
    
    If EventID = #PB_Event_Gadget Or EventID = #PB_Event_Menu 
      
      welcherButton=EventGadget()            
      
      Select welcherButton      
                
        Case #buttonnr1
              nr+1
              AddGadgetItem(#listiconnr,-1,"Hallo"+#LF$+"Testnr "+Str(nr)+#LF$+Str(Date()))
        
        Case #popup01itemA
              RemoveGadgetItem(#listiconnr,0)                        
              
        Case #popup01itemB
              anz = CountGadgetItems(#listiconnr)-1
              RemoveGadgetItem(#listiconnr,anz)                           
    
        Case #popup01itemC
              anz = CountGadgetItems(#listiconnr)-1
              RemoveGadgetItem(#listiconnr,anz/2)
    
        Case #popup02itemA
              anz = CountGadgetItems(#listiconnr)-1
              For j=0 To anz
                SetGadgetItemText(#listiconnr,j,"Blubb",0)
              Next
              
        Case #popup02itemB
              anz = CountGadgetItems(#listiconnr)-1
              For j=0 To anz
                SetGadgetItemText(#listiconnr,j,"Guten Tag "+Str(j+1),1)
              Next              
    
        Case #popup02itemC
              ClearGadgetItemList(#listiconnr)
    
      EndSelect
    
    EndIf
      
Until EventID = #PB_Event_CloseWindow 

End

Procedure myWindowCallback(hWnd, Message, wParam, lParam) 
  
  result = #PB_ProcessPureBasicEvents 
                 
      Static popflag ,popbutton    
                       
      Select Message            

           Case #WM_NOTIFY

                ;diese Struktur sagt von welchem Gadget und was ist wo passiert
                *nmhdr.NMHDR = lParam   
                
                Select *nmhdr\idfrom

                  Case #buttonnr3, #buttonnr4
                                                                                
                        Select *nmhdr\code 
                           
                           Case -1249 ;Popup klappt beim berühren des Button automatisch auf
                              
                               ;if else weil -1249 2x kommt und popflag gelöscht werden muß
                               ;beim 1.mal ist popflag=0 und IF popflag=0 ist wahr
                               ;beim 2.mal ist popflag=1 und der ELSE Teil löscht popflag
                               If popflag=0  
                                  popflag=1
                                  ;hole Posi vom Button
                                  popbutton=*nmhdr\hwndfrom
                                  GetWindowRect_(popbutton,r.rect)
                                  ;PopUp ab linke obere Ecke, damit Button verdeckt ist
                                  
                                  Select *nmhdr\idfrom
                                      Case #buttonnr3: DisplayPopupMenu(#popup01, hWnd, r\left,r\top)
                                      Case #buttonnr4: DisplayPopupMenu(#popup02, hWnd, r\left,r\top) 
                                  EndSelect
                               
                               Else
                                  popflag=0
                               EndIf   
                           
                        EndSelect        
                                        
                        
                  ;Case irgendeinandererButton
                  ;     für irgendwas anderes
                EndSelect       
                                        
           Case #WM_COMMAND
                ;wenn menueintrag angeklickt
                If popflag
                   GetWindowRect_(popbutton,r.rect)
                   SetCursorPos_(r\right+10,r\bottom+5)
                EndIf
           
           Case #WM_ENTERIDLE     
                If popflag  ; damit diese message nur fürs Popup ausgewertet wird
               
                   ;#WM_ENTERIDLE stellt das handle fürs PopupWindow in lParam
                   popid=lparam  
                   
                   ;solange Mauszeiger im Popup ist, id=popid
                   GetCursorPos_(p.POINT) 
                   id = WindowFromPoint_(p\X, p\Y) 
                   
                   ;wenn Mauszeiger Popup verläßt
                   If id<>popid
                        DestroyWindow_(popid)
                   EndIf
               
                EndIf
           
      EndSelect
       
   ProcedureReturn result 
   
EndProcedure

Es gibt nur eine kleine Einschränkung. Ein PopUpMenu darf keinen anderen PopUpButton berühren. Denn es klappt dann nicht mehr automatisch zu.

Wer von den CallbackExperten perfektioniert den Code damit dies nicht passiert ?

Verfasst: **23.01.2008 13:44**

xp-skin support muss an sein. (nur falls sich - wie ich - jemand wundert warum es nicht geht)

Verfasst: **23.01.2008 22:35**

Hier eine verbesserte Version: XP-SKIN sollte jetzt egal sein
Einschränkung vom 1.Code behoben.

Code: Alles auswählen

;verbesserte Version die auch ohne XP-SKIN funktioniert
;PopUpButtons können nebeneinander stehen
;wenn #WM_Command aktiviert dann wird nach Menuwahl die Maus verschoben
;     damit PopUp bei einer kleinen Mausbewegung nicht sofort wieder erscheint
;     wem es nicht gefällt, muß den #WM_Command Teil entfernen
;das PopUpMenu sollte größer als der Button sein, sonst erscheint/verschwindet es
;    wenn man beim verlassen des PopUps auf den Button kommt

Declare myWindowCallback(hWnd, message, wParam, lParam) 

#buttonbr=80
#buttonhh=30

Enumeration
#window
#buttonnr1=10
#buttonnr3
#buttonnr4
#listiconnr

#popup01
#popup01itemA
#popup01itemB
#popup01itemC
#popup01itemD
#popup01Ende
#popup02
#popup02itemA
#popup02itemB
#popup02itemC
#popup02Ende
EndEnumeration

;Image=====================================================      

UseJPEGImageDecoder()
pfad1$=#PB_Compiler_Home+"Examples\Sources\Data\" 
bitmap0ID = ImageID(LoadImage(#PB_Any,pfad1$+"terrain_detail.jpg"))
bitmap1ID = ResizeImage(LoadImage(#PB_Any,pfad1$+"PureBasicLogo.bmp"),#buttonbr,#buttonhh)

;PopUP=====================================================      

pop01ID=CreatePopupMenu(#popup01)
        MenuItem (#popup01itemA, "1.Zeile weg")
        MenuItem (#popup01itemB, "letzte Zeile weg")
        MenuItem (#popup01itemC, "mittlere Zeile weg")
        MenuItem (#popup01itemD, "es passiert nix")
        ;usw
                
pop02ID=CreatePopupMenu(#popup02)
        MenuItem (#popup02itemA, "in Spalte 1 steht Blubb")
        MenuItem (#popup02itemB, "in Spalte 2 steht Guten Tag")
        MenuItem (#popup02itemC, "Liste wird gelöscht")
        ;usw
                
Structure MENUINFO 
  cbSize.l 
  fMask.l 
  dwStyle.l 
  cyMax.l 
  hbrBack.l 
  dwContextHelpID.l 
  dwMenuData.l 
EndStructure 

#MIM_BACKGROUND=2 
#MIM_STYLE=16
#MNS_AUTODISMISS = $10000000 

MI.MENUINFO\cbSize=SizeOf(MENUINFO) 
;MI\hbrBack=CreateSolidBrush_(farbe)  ;irgendeine farbe 
;oder
MI\hbrBack=CreatePatternBrush_(bitmap0ID)
MI\fMask=#MIM_BACKGROUND | #MIM_STYLE
MI\dwStyle=#MNS_AUTODISMISS 

SetMenuInfo_(pop01ID,MI)
SetMenuInfo_(pop02ID,MI)

;=====================================================      

WindowBreite = 700                    
WindowHoehe  = 500

hWnd=OpenWindow(#window, 0,0, WindowBreite, WindowHoehe, "",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
     CreateGadgetList(WindowID(0)) 
   
      idnr1=ButtonGadget(#buttonnr1,100,450,#buttonbr,#buttonhh,"Zeile add") 
      idnr3=ButtonGadget(#buttonnr3,200,450,#buttonbr,#buttonhh,"Bearbeiten") 
      idnr4=ButtonImageGadget(#buttonnr4,300,450,#buttonbr,#buttonhh,bitmap1ID) ;zum Testen, Buttonbreite +200
      
      sp=10:ze=10
      idlig=ListIconGadget(#listiconnr,sp,ze,300+4,400,"Spalte1",100)
      AddGadgetColumn(#listiconnr,1,"spalte2",100)
      AddGadgetColumn(#listiconnr,2,"spalte3",100)
      
      SendMessage_(idlig,#LVM_SETTEXTCOLOR,0,#Blue)
      SendMessage_(idlig,#LVM_SETBKCOLOR,0,GetSysColor_(#COLOR_BTNFACE))
      SendMessage_(idlig,#LVM_SETTEXTBKCOLOR,0,GetSysColor_(#COLOR_BTNFACE))
   
SetWindowCallback(@myWindowCallback()) 
   
Repeat 
    EventID = WaitWindowEvent()
    
    If EventID = #PB_Event_Gadget Or EventID = #PB_Event_Menu ;Menu/Shortcut kann gleiche Nummer wie ein Gadget haben
      
      welcherButton=EventGadget()            ;:Debug "Button " + Str(welcherbutton)
      
      Select welcherButton      
                
        Case #buttonnr1
              nr+1
              AddGadgetItem(#listiconnr,-1,"Hallo"+#LF$+"Testnr "+Str(nr)+#LF$+Str(Date()))
        
        Case #popup01itemA
              RemoveGadgetItem(#listiconnr,0)                        
              
        Case #popup01itemB
              anz = CountGadgetItems(#listiconnr)-1
              RemoveGadgetItem(#listiconnr,anz)                           
    
        Case #popup01itemC
              anz = CountGadgetItems(#listiconnr)-1
              RemoveGadgetItem(#listiconnr,anz/2)
    
        Case #popup02itemA
              anz = CountGadgetItems(#listiconnr)-1
              For j=0 To anz
                SetGadgetItemText(#listiconnr,j,"Blubb",0)
              Next
              
        Case #popup02itemB
              anz = CountGadgetItems(#listiconnr)-1
              For j=0 To anz
                SetGadgetItemText(#listiconnr,j,"Guten Tag "+Str(j+1),1)
              Next
                  
        Case #popup02itemC
              ClearGadgetItemList(#listiconnr)
    
      EndSelect
    
    EndIf
      
Until EventID = #PB_Event_CloseWindow 

End

Procedure myWindowCallback(hWnd, Message, wParam, lParam) 
  
  result = #PB_ProcessPureBasicEvents 
                 
      Static popbutton    
                   
      Select Message            

           Case #WM_SETCURSOR
                 
                 If wparam = GadgetID(#buttonnr3)
                    popbutton=GadgetID(#buttonnr3)
                    GetWindowRect_(popbutton,r.rect)
                    DisplayPopupMenu(#popup01, hWnd, r\left,r\top)
                 ElseIf wparam = GadgetID(#buttonnr4) 
                    popbutton=GadgetID(#buttonnr4) 
                    GetWindowRect_(popbutton,r.rect)
                    DisplayPopupMenu(#popup02, hWnd, r\left,r\top+hh)                 
                 EndIf           
           
           Case #WM_COMMAND   ;verschiebt den Mauszeiger
                If popbutton
                   GetWindowRect_(popbutton,r.rect)     ;zum Testen Semikolon setzen   
                   SetCursorPos_(r\right+10,r\bottom+5) ;zum Testen Semikolon setzen    
                EndIf
                
           Case #WM_ENTERIDLE     
                If popbutton  ; damit diese message nur fürs Popup ausgewertet wird
               
                   ;#WM_ENTERIDLE stellt das handle fürs PopupWindow in lParam
                   popid=lparam  
                   
                   ;solange Mauszeiger im Popup ist, id=popid
                   GetCursorPos_(p.POINT) 
                   id = WindowFromPoint_(p\X, p\Y) 
                   
                   ;wenn Mauszeiger Popup verläßt
                   If id<>popid
                        DestroyWindow_(popid)                        
                        popbutton=0
                   EndIf
               
                EndIf
           
      EndSelect
       
   ProcedureReturn result 
   
EndProcedure

Verfasst: **23.01.2008 22:57**

Der Code hat einen schwerwiegenden Fehler denn du schließt das Popupmenü mittels DestroyWindow_(). Das Problem hier bei ist das wenn das Popupmenu ein Submenu (oder gar mehere) enthält du nur das Popupmenu schließt, nicht aber das darin enthaltene Submenu. Das heißt es bleibt nur das Submenu bestehen und das findet Windows gar nicht klasse.

Im Klartext:

Nicht nur dein Programm und Windows verabschieden sich sondern, zumindest im meinem Fall, startet sich der Rechner neu.

Um das zu verhindern musst du

Code: Alles auswählen

DestroyWindow_()

durch

Code: Alles auswählen

EndMenu_()

ersetzen und das Problem sollte behoben sein.

Verfasst: **24.01.2008 00:12**

Vielen Dank für den Hinweis !
auf EndMenu bin ich, muß ich zu meiner Schande gestehen, nie gekommen, denn mit Submenus habe ich es nicht getestet, da ich diese für meinen Zweck nicht brauche.

Man sollte aber erwähnen, das laut MSDN es EndMenu_ erst ab Windows98 gibt. Für den unwahrscheinlichen Fall, jemand will diesen Code mit Submenus unter Win95 benutzen, der kann es ja mal mit folgendem Testen.

Code: Alles auswählen

DestroyMenu_(popid)
mouse_event_(#MOUSEEVENTF_LEFTDOWN,0,0,0,0);Mausklick senden

Allerdings hat man dann wieder das kleine Problem mit dem überlappen des PopUps zum nächsten PopUpButton.

PureBoard

Buttongadget / Imagegadget mit PopUpMenu

Buttongadget / Imagegadget mit PopUpMenu