Pop-Up COMBOGADGET hiérarchique

[ZapMan]

Code : Tout sélectionner

;
;                HIERARCHICAL POP-UP COMBO GADGET
;        By Zapman with the help of TomS, Demivec and Nico
;
; This code allows to create a ComboGadget with hierarchical levels
;
; The resulting gadget has the same apparence as a ComboGadget but
; the same possibilities of a popupmenu and offers multiple levels
; in the data ordering as submenus.
;
;                   --------------------------
;
; Ce code permet de créer un ComboGadget avec des niveaux hiérarchiques
;
; Le résultat a la même apparence qu'un combogadget et les mêmes
; possibilités qu'un popupmenu puisqu'il permet de classer les données
; sur plusieurs niveaux dans des sous-menus.
;
;                   --------------------------
;
; ------------------------------------------------------
; Prepare a small Folder Icon to add to submenus
; ------------------------------------------------------
;
; Get the Folder Icon from Windows API
*sfi.SHFILEINFO = AllocateMemory(SizeOf(SHFILEINFO))
If SHGetFileInfo_("aa.txt",#FILE_ATTRIBUTE_DIRECTORY,*sfi, SizeOf(SHFILEINFO), #SHGFI_ICON| #SHGFI_SMALLICON | #SHGFI_USEFILEATTRIBUTES)
  hFolderIcon = *sfi\hIcon
EndIf
FreeMemory(*sfi)
;
; Redraw the icon in an image
FImage = CreateImage(#PB_Any, 16, 16)
himg = StartDrawing(ImageOutput(FImage))
; --> White background to match menu background
Box(0, 0, 16, 16, RGB(255, 255, 255))
; --> Draw the icon
DrawImage(hFolderIcon, 0, 0, 16, 16)
DestroyIcon_(hFolderIcon)
StopDrawing()

;
; Resize the image to the menu needs
menuImageWidth = GetSystemMetrics_(#SM_CXMENUCHECK)
menuImageHeight = GetSystemMetrics_(#SM_CYMENUCHECK)
itemImage = ResizeImage(FImage, menuImageWidth, menuImageHeight)
;
; Set a MenuItemInfo Structure with our icon/image
Global myMenuInfo.MENUITEMINFO
myMenuInfo\cbSize = SizeOf(MENUITEMINFO)
myMenuInfo\fMask = #MIIM_CHECKMARKS
myMenuInfo\hbmpUnchecked = itemImage
;
Procedure SetSubMenuIcon(menu) ; add the folder icon to all submenus titles
  mc = GetMenuItemCount_(menu)
  For ct = 0 To mc
    hSubMenu = GetSubMenu_(menu, ct) ; is the item a submenu title?
    If hSubMenu                      ; if yes....
      SetMenuItemInfo_(menu, ct, 1, myMenuInfo) ; add an icon
      SetSubMenuIcon(hSubMenu) ;                  and explore the submenu for next levels
    EndIf
  Next
EndProcedure
;
; ------------------------------------------------------
;     Define functions for our new gadget
; ------------------------------------------------------
;
Import ""
  PB_Menu_SendMenuCommand(hWnd, EventType)
  PB_Gadget_SendGadgetCommand(hWnd, EventType)
EndImport
;
#TPM_RETURNCMD=$100
;
Structure CBM
  iGadgetID.i
  iMenuID.i
  iMenuOpen.i
  iOldCBMCallBack.i
EndStructure 

Global NewList hCBM.CBM()

Procedure CBMCallback(hWnd, uMsg, wParam, lParam)
  ;By Zapman with the help of TomS and Nico
  ;
  If IsGadget(hCBM()\iGadgetID)
    If hWnd <> GadgetID(hCBM()\iGadgetID)
      ResetList(hCBM())
      While NextElement(hCBM()) And  hWnd <> GadgetID(hCBM()\iGadgetID) : Wend
    EndIf
    *PCBM.CBM = @hCBM()
  
    If hWnd = GadgetID(*PCBM\iGadgetID)
      
      If uMsg = #WM_LBUTTONDOWN Or uMsg = #WM_LBUTTONDBLCLK
          If *PCBM\iMenuOpen=0
            *PCBM\iMenuOpen = -1
            SetFocus_(hwnd)
            ;
            *PCBM\iMenuID = CreatePopupMenu(#PB_Any)
            If *PCBM\iMenuID
              
              For ct = 0 To CountGadgetItems(*PCBM\iGadgetID)-1
                mline$ = GetGadgetItemText(*PCBM\iGadgetID,ct)
                Open = 0
                Close = 0
                Value = SendMessage_(GadgetID(*PCBM\iGadgetID),#CB_GETITEMDATA,ct,0)
                If Value<>#CB_ERR
                  Open = Value&1
                  Close = Value/2
                EndIf
                If Open
                  OpenSubMenu(mline$)
                Else
                  MenuItem(ct+10000,mline$) ; we use menu items over 10000 to avoid conflicts with other application menus
                EndIf
                While Close
                  CloseSubMenu()
                  Close - 1
                Wend
              Next
              ;
              ; Transmit the event to the main application
              ;
              PB_Gadget_SendGadgetCommand(GadgetID(*PCBM\iGadgetID),#CBN_DROPDOWN)
              ;
              *PCBM\iMenuOpen = 1
              ;
            EndIf
            
          EndIf
          ProcedureReturn 0 ; hide the event to the combogadget
          ;
      ElseIf (uMsg = #WM_SETFOCUS Or uMsg = #WM_KILLFOCUS) And *PCBM\iMenuOpen = -1
        ; Avoid the EventType "SetFocus" on a mouse click
        ; because a classical ComboBox gadget does'nt send this event.
        ProcedureReturn 0
        ;
      ElseIf *PCBM\iMenuOpen = 1 And uMSG = #WM_NCHITTEST
  
        *PCBM\iMenuOpen = 2 
        ;
        ; Display the popup menu
        GetWindowRect_(hWnd,re.RECT)
        id=TrackPopupMenu_(MenuID(*PCBM\iMenuID),#TPM_RETURNCMD | #TPM_LEFTBUTTON | #TPM_LEFTALIGN ,re\left,re\bottom,0,GadgetID(*PCBM\iGadgetID),0)
        
        If PeekMessage_(@msg.msg,hwnd,#WM_LBUTTONDOWN,#WM_LBUTTONDOWN,#PM_NOREMOVE)=0
          ; menu has been closed!
          FreeMenu(*PCBM\iMenuID)
        EndIf 
        ;
        ; Menu is now closed. Update our combo with the menu choice,
        ; and generate a PB event to tell the main application that something occured
        ;
        If id>0
          SetGadgetState(*PCBM\iGadgetID,id-10000) ; Update our combo with the menu choice
          PB_Gadget_SendGadgetCommand(GadgetID(*PCBM\iGadgetID), #CBN_SELCHANGE) ; Generate a PB event
        Else
          PB_Gadget_SendGadgetCommand(GadgetID(*PCBM\iGadgetID), #CBN_CLOSEUP)   ; Generate a PB event
        EndIf
        ;
      ElseIf *PCBM\iMenuOpen = 2; the menu has just been displayed. Set the submenus icons
        *PCBM\iMenuOpen = 0
        SetSubMenuIcon(MenuID(*PCBM\iMenuID))
      EndIf
      ;
      ProcedureReturn CallWindowProc_(*PCBM\iOldCBMCallBack, hwnd, uMsg, wParam, lParam)
      ;
    EndIf
  EndIf
  ProcedureReturn DefWindowProc_(hWnd, uMsg, wParam, lParam)
EndProcedure 


Procedure CreateComboBoxMenuGadget(ID.i, iX.i, iY.i, iWidth.i, iHeight.i,Option=0)
  ;
  ReturnValue = ComboBoxGadget(ID, iX, iY, iWidth, iHeight,Option)
  AddElement(hCBM())
  If ID = #PB_Any
    hCBM()\iGadgetID = ReturnValue
  Else
    hCBM()\iGadgetID = ID
  EndIf 
  hCBM()\iMenuOpen = 0
  hCBM()\iOldCBMCallBack=SetWindowLong_(GadgetID(hCBM()\iGadgetID), #GWL_WNDPROC, @CBMCallBack())
  ProcedureReturn ReturnValue
EndProcedure
;
Procedure OpenSubMenu_CBM(iGadgetID,ItemIndex=-1,Text$="_NoText_")
  ;
  ; Last two arguments are optionnals
  ;
  ; OpenSubMenu_CBM(GadgetID,-1,"Line")
  ;   Add the line "Line" in the List As a submenu title
  ; OpenSubMenu_CBM(GadgetID)
  ;   Transform the last added line To a submenu title
  ; OpenSubMenu_CBM(GadgetID,5)
  ;   Transform the line indexed "5" To a submenu title
  ; OpenSubMenu_CBM(GadgetID,5,"Line")
  ;   Insert "Line" at position "5" in the List And transform it To a submenu title
  ;
  If Text$<>"_NoText_"
    AddGadgetItem(iGadgetID, ItemIndex,Text$)
  EndIf
  ;
  If ItemIndex = -1
    ItemIndex = CountGadgetItems(iGadgetID)-1
  EndIf
  ;
  vReturn = 0
  actualValue = SendMessage_(GadgetID(iGadgetID),#CB_GETITEMDATA,ItemIndex,0)
  If actualValue<>#CB_ERR
    actualValue|1
    If SendMessage_(GadgetID(iGadgetID),#CB_SETITEMDATA,ItemIndex,actualValue)<>#CB_ERR
      vReturn = 1
    EndIf
  EndIf
  ProcedureReturn vReturn
EndProcedure
;
Procedure CloseSubMenu_CBM(iGadgetID,ItemIndex=-1,Text$="_NoText_")
  ;
  If Text$<>"_NoText_"
    AddGadgetItem(iGadgetID, ItemIndex,Text$)
  EndIf
  ;
  If ItemIndex = -1
    ItemIndex = CountGadgetItems(iGadgetID)-1
  EndIf
  ;
  vReturn = 0
  actualValue = SendMessage_(GadgetID(iGadgetID),#CB_GETITEMDATA,ItemIndex,0)
  If actualValue<>#CB_ERR
    Open = actualValue&1
    Close = actualValue/2
    Close + 1
    Close *2
    Value = Close | Open
    If SendMessage_(GadgetID(iGadgetID),#CB_SETITEMDATA,ItemIndex,Value)<>#CB_ERR
      vReturn = 1
    EndIf
  EndIf
  ProcedureReturn vReturn
EndProcedure

; 
; ------------------------------------------------------
;                      DEMO CODE
; ------------------------------------------------------


mhWnd = OpenWindow(#PB_Any, 0,0, 480, 100, "Combobox", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

TextGadget(#PB_Any,10,5,140,20,"Classical ComboBox")

combomenu1 = ComboBoxGadget(#PB_Any,10, 25, 140, 20)
;
AddGadgetItem(combomenu1, -1,"Spaghetti")
AddGadgetItem(combomenu1, -1,"Great sole")
AddGadgetItem(combomenu1, -1,"Potato omelette")
AddGadgetItem(combomenu1, -1,"Fondue chinoise")
AddGadgetItem(combomenu1, -1,"Tapioca soup")
AddGadgetItem(combomenu1, -1,"Duck liver")
AddGadgetItem(combomenu1, -1,"Sauces")
AddGadgetItem(combomenu1, -1,"Chili")
AddGadgetItem(combomenu1, -1,"American")
AddGadgetItem(combomenu1, -1,"Indian")
AddGadgetItem(combomenu1, -1,"Kebap")

SetGadgetState(combomenu1, 2)


TextGadget(#PB_Any,170,5,140,20,"Hierarchical ComboBox")

combomenu2 = CreateComboBoxMenuGadget(#PB_Any,170, 25, 140, 20) 
;
AddGadgetItem(combomenu2, -1,"Spaghetti")
AddGadgetItem(combomenu2, -1,"Great sole")
AddGadgetItem(combomenu2, -1,"Potato omelette")
AddGadgetItem(combomenu2, -1,"Fondue chinoise")
AddGadgetItem(combomenu2, -1,"Tapioca soup")
AddGadgetItem(combomenu2, -1,"Duck liver")
OpenSubMenu_CBM(combomenu2,-1,"Sauces") ; will open a submenu with the last added item as title
AddGadgetItem(combomenu2, -1,"Chili")
AddGadgetItem(combomenu2, -1,"American")
CloseSubMenu_CBM(combomenu2,-1,"Indian") ; will close the submenu
AddGadgetItem(combomenu2, -1,"Kebap")

SetGadgetState(combomenu2, 1)

TextGadget(#PB_Any,330,5,140,20,"Hierarchical ComboBox")

combomenu3 = CreateComboBoxMenuGadget(#PB_Any,330, 25, 140, 20) 
;
AddGadgetItem(combomenu3, -1,"Spaghetti")
AddGadgetItem(combomenu3, -1,"Great sole")
AddGadgetItem(combomenu3, -1,"Potato omelette")
AddGadgetItem(combomenu3, -1,"Fondue chinoise")
AddGadgetItem(combomenu3, -1,"Tapioca soup")
AddGadgetItem(combomenu3, -1,"Duck liver")
AddGadgetItem(combomenu3, -1,"Sauces")
OpenSubMenu_CBM(combomenu3) ; will open a submenu with the last added item as title
AddGadgetItem(combomenu3, -1,"Chili")
AddGadgetItem(combomenu3, -1,"American")
AddGadgetItem(combomenu3, -1,"Indian")
CloseSubMenu_CBM(combomenu3) ; will close the submenu
AddGadgetItem(combomenu3, -1,"Kebap")

SetGadgetState(combomenu3, 0)

Repeat
  event = WaitWindowEvent(20)
  Select event
    Case #PB_Event_Gadget
      If EventGadget() = combomenu1
        Debug "Event on the Classical Combo! GadgetState ="+Str(GetGadgetState(combomenu1))+" Selected line = "+GetGadgetText(combomenu1)+" EventType() = "+Str(EventType())
      EndIf
      If EventGadget() = combomenu2
        Debug "Event on the Hierarchical Combo! GadgetState ="+Str(GetGadgetState(combomenu2))+" Selected line = "+GetGadgetText(combomenu2)+" EventType() = "+Str(EventType())
      EndIf
  EndSelect    
Until event = #PB_Event_CloseWindow 
CloseWindow(mhWnd)
End

[Jacobus]

Pas mal. Un seul problème, lors de la screen capture, en mode test c'est le fond de l'IDE de PB qui est affiché à la place des combos. Il faut cliquer sur un des boutons pour modifier l'image.

exemple : Là c'est la barre d'outils

[ZapMan]

Merci de ce retour, Jacobus !!

Je viens de mettre le code à jour pour tenter de régler le problème. Si tu as encore 5mn, pourrais-tu me dire si ça marche ?

[édité]

[comtois]

J'ai un IMA (invalid memory access) à la ligne 263 avec la version 64 bits sous seven.

Code : Tout sélectionner

   Result = CallWindowProc_(HCombo()\OldCallback, hwnd, uMsg, wParam, lParam)

[nico]

Essaye en remplaçant OldCallback.l par OldCallback.i dans la structure HComboZ

[comtois]

Essaye en remplaçant OldCallback.l par OldCallback.i dans la structure HComboZ

C'était ça, merci

[ZapMan]

Je viens de revoir complètement mon code suite à une suggestion de TomS sur le forum anglais.

On est arrivé à une solution beaucoup plus élégante avec un code plus court et une compatibilité complète avec un gadget classique. Désormais, le gadget créé est compatible avec toutes les fonctions PureBasic classiques telles que AddGadgetItem, SetGadgetState, etc.

Il n'y a plus de problème avec le fond du gadget puisqu'à présent, le gadget visible par l'utilisateur est réellement un combo et non plus une copie d'écran.

Ca me semble une bonne piste à suivre pour modifier éventuellement le comportement d'autres types de gadgets.

[nico]

Certaines choses dans le code ne me plaisait pas alors j'ai fait quelques modifs et je te propose ce code, dis moi ce que tu en penses.

Code : Tout sélectionner

#TPM_RETURNCMD=$100

Import ""
  PB_Menu_SendMenuCommand(hWnd, EventType)
  PB_Gadget_SendGadgetCommand(hWnd, EventType)
EndImport
;
; ------------------------------------------------------
; Prepare a small Folder Icon to add to submenus
; ------------------------------------------------------
;
; Get the Folder Icon from Windows API
*sfi.SHFILEINFO = AllocateMemory(SizeOf(SHFILEINFO))
If SHGetFileInfo_("aa.txt",#FILE_ATTRIBUTE_DIRECTORY,*sfi, SizeOf(SHFILEINFO), #SHGFI_ICON| #SHGFI_SMALLICON | #SHGFI_USEFILEATTRIBUTES)
  hFolderIcon = *sfi\hIcon
EndIf
FreeMemory(*sfi)
;
; Redraw the icon in an image
FImage = CreateImage(#PB_Any, 16, 16)
himg = StartDrawing(ImageOutput(FImage))
; --> White background to match menu background
Box(0, 0, 16, 16, RGB(255, 255, 255))
; --> Draw the icon
DrawImage(hFolderIcon, 0, 0, 16, 16)
DestroyIcon_(hFolderIcon)
StopDrawing()

;
; Resize the image to the menu needs
menuImageWidth = GetSystemMetrics_(#SM_CXMENUCHECK)
menuImageHeight = GetSystemMetrics_(#SM_CYMENUCHECK)
itemImage = ResizeImage(FImage, menuImageWidth, menuImageHeight)
;
; Set a MenuItemInfo Structure with our icon/image
Global myMenuInfo.MENUITEMINFO
myMenuInfo\cbSize = SizeOf(MENUITEMINFO)
myMenuInfo\fMask = #MIIM_CHECKMARKS
myMenuInfo\hbmpUnchecked = itemImage
;
Procedure SetSubMenuIcon(menu) ; add the folder icon to all submenus titles
  mc = GetMenuItemCount_(menu)
  For ct = 0 To mc
    hSubMenu = GetSubMenu_(menu, ct) ; is the item a submenu title?
    If hSubMenu                      ; if yes....
      SetMenuItemInfo_(menu, ct, 1, myMenuInfo) ; add an icon
      SetSubMenuIcon(hSubMenu) ;                  and explore the submenu for next levels
    EndIf
  Next
EndProcedure
;
; ------------------------------------------------------
;     Define functions for our new gadget
; ------------------------------------------------------

Structure CBM
  iGadgetID.i
  iMenuID.i
  iMenuOpen.i
  iOldCBMCallBack.i
EndStructure 

Global NewList hCBM.CBM()

Procedure CBMCallback(hWnd, uMsg, wParam, lParam)
  Static mem.l
  
  If hWnd <> GadgetID(hCBM()\iGadgetID)
    ResetList(hCBM())
    While NextElement(hCBM()) And  hWnd <> GadgetID(hCBM()\iGadgetID) : Wend
  EndIf
  If hWnd = GadgetID(hCBM()\iGadgetID)
    Select uMsg
      Case #WM_LBUTTONDOWN,#WM_LBUTTONDBLCLK
        Debug "mem= "+Str(mem)
        If mem=0
          SetFocus_(hwnd)
          mem=1
          hCBM()\iMenuID = CreatePopupMenu(#PB_Any)
          If hCBM()\iMenuID
            For ct = 0 To CountGadgetItems(hCBM()\iGadgetID)-1
              mline$ = GetGadgetItemText(hCBM()\iGadgetID,ct)
              If Right(mline$,1)=Chr(9); the Chr(9) at right of the text will open a submenu
                OpenSubMenu(mline$)
              Else
                If Right(mline$,1)=Chr(10); the Chr(10) at right of text will close the submenu
                  CloseSubMenu()
                EndIf
                MenuItem(ct+10000,mline$) ; we use menu items over 10000 to avoid conflicts with other application menus
              EndIf
            Next
            hCBM()\iMenuOpen = -1
            GetWindowRect_(hWnd,re.RECT)
            id=TrackPopupMenu_(MenuID(hCBM()\iMenuID),#TPM_RETURNCMD | #TPM_LEFTBUTTON | #TPM_LEFTALIGN	,re\left,re\bottom,0,GadgetID(hCBM()\iGadgetID),0)
            ; We'll hide the event to the combogadget but transmit it to the main application
            
            If PeekMessage_(@msg.msg,hwnd,#WM_LBUTTONDOWN,#WM_LBUTTONDOWN,#PM_NOREMOVE)=0
              mem=0
            EndIf 
            
            If id>0
              PostMessage_(hwnd,#WM_COMMAND,id,0)
            EndIf
            
            ProcedureReturn 0
          EndIf
        Else
          mem=0
          ProcedureReturn 0
        EndIf 
        
      Case #WM_COMMAND ; the user has released the click  on a line or has clicked on a line
        If hCBM()\iMenuOpen
          SetGadgetState(hCBM()\iGadgetID,(wParam & $FFFF)-10000) ; update our combo with the menu choice
          If IsMenu(hCBM()\iMenuID) ; free the popupmenu
            FreeMenu(hCBM()\iMenuID)
          EndIf
          
          ; Generate a PB event on our Combo to tell the main application that something occured
          PB_Gadget_SendGadgetCommand(GadgetID(hCBM()\iGadgetID), #CBN_SELCHANGE)
        EndIf
        
    EndSelect
    ;
    If hCBM()\iMenuOpen = -1 ; the menu has just been displayed. Set the submenus icons
      hCBM()\iMenuOpen = -2
      SetSubMenuIcon(MenuID(hCBM()\iMenuID))
    EndIf
    
    ProcedureReturn CallWindowProc_(hCBM()\iOldCBMCallBack, hwnd, uMsg, wParam, lParam)
    
  Else
    ProcedureReturn DefWindowProc_(hWnd, uMsg, wParam, lParam)
  EndIf
  
EndProcedure 

Procedure CreateComboBoxMenuGadget(iX.i, iY.i, iWidth.i, iHeight.i,Option=0)
  AddElement(hCBM())
  hCBM()\iGadgetID = ComboBoxGadget(#PB_Any, iX, iY, iWidth, iHeight,Option)
  hCBM()\iMenuOpen = 0
  hCBM()\iOldCBMCallBack=SetWindowLong_(GadgetID(hCBM()\iGadgetID), #GWL_WNDPROC, @CBMCallBack())
  ProcedureReturn hCBM()\iGadgetID
EndProcedure


;
; ------------------------------------------------------
;                      DEMO CODE
; ------------------------------------------------------


hWnd = OpenWindow(#PB_Any, 0,0, 320, 100, "Combobox", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

TextGadget(#PB_Any,5,5,140,20,"Classical ComboBox")

combomenu1 = ComboBoxGadget(#PB_Any,5, 25, 140, 20)
;
AddGadgetItem(combomenu1, -1,"Spaghetti")
AddGadgetItem(combomenu1, -1,"Great sole")
AddGadgetItem(combomenu1, -1,"Potato omelette")
AddGadgetItem(combomenu1, -1,"Fondue chinoise")
AddGadgetItem(combomenu1, -1,"Tapioca soup")
AddGadgetItem(combomenu1, -1,"Duck liver")
AddGadgetItem(combomenu1, -1,"Sauces")
AddGadgetItem(combomenu1, -1,"Chili")
AddGadgetItem(combomenu1, -1,"American")
AddGadgetItem(combomenu1, -1,"Indian")
AddGadgetItem(combomenu1, -1,"Kebap")

SetGadgetState(combomenu1, 2)

TextGadget(#PB_Any,170,5,140,20,"Hierarchical ComboBox")

combomenu2 = CreateComboBoxMenuGadget(170, 25, 140, 20) 
;
AddGadgetItem(combomenu2, -1,"Spaghetti")
AddGadgetItem(combomenu2, -1,"Great sole")
AddGadgetItem(combomenu2, -1,"Potato omelette")
AddGadgetItem(combomenu2, -1,"Fondue chinoise")
AddGadgetItem(combomenu2, -1,"Tapioca soup")
AddGadgetItem(combomenu2, -1,"Duck liver")
AddGadgetItem(combomenu2, -1,"Sauces"+Chr(9)) ; add Chr(9) to right of the text will open a submenu
AddGadgetItem(combomenu2, -1,"Chili")
AddGadgetItem(combomenu2, -1,"American")
AddGadgetItem(combomenu2, -1,"Indian")
AddGadgetItem(combomenu2, -1,"Kebap"+Chr(10)); add Chr(10) to the right of text will close the submenu

SetGadgetState(combomenu2, 2)

Repeat
  event = WaitWindowEvent(20)
  Select event
    Case #PB_Event_Gadget
      If EventGadget() = combomenu1
        Debug "Event on the Classical Combo! GadgetState ="+Str(GetGadgetState(combomenu1))+" Selected line = "+GetGadgetText(combomenu1)+" EventType() = "+Str(EventType())
      EndIf
      If EventGadget() = combomenu2
        Debug "Event on the Hierarchical Combo! GadgetState ="+Str(GetGadgetState(combomenu2))+" Selected line = "+GetGadgetText(combomenu2)+" EventType() = "+Str(EventType())
      EndIf
  EndSelect    
Until event = #PB_Event_CloseWindow 
CloseWindow(hWnd)
End

[ZapMan]

[Edité]

Merci beaucoup pour ces suggestion Nico

Je viens de mettre mon code à jour en intégrant tes idées. Désormais, les EventType() générés par ce nouveau gadget sont en tout point conformes à ceux générés par un ComboBox Classique. On peut donc remplacer l'un par l'autre très simplement dans un code.

Je suis très content du résultat final. Merci pour votre aide à tous.

[ZapMan]

Encore un petit update pour corriger un problème d'affichage signalé sur certaines versions d'XP et pour rendre la création de gadget plus logique et plus conforme à celle des gagdets de PureBasic.

[Jacobus]

Excellent résultat Zapinou, fonctionne très bien sous Win 7 64bit.
Cette Lib apporte un plus indéniable dans les fonctionnalités.

[ZapMan]

Merci Jacobus

Je viens encore de procéder à une mise à jour du code situé en tête de ce topic, suite à des remarques issues du forum anglais.

[PAPIPP]

Bonjour ZapMan
Merci tout d'abord pour cette contribution
Toutefois dans la dernière version j'ai une erreur à la ligne 88 le #Gadget n'est pas initialisé

Code : Tout sélectionner

Procedure CBMCallback(hWnd,uMsg,wParam,lParam)
  ;By Zapman with the help of TomS and Nico
  ;
  If hWnd<>GadgetID(hCBM()\iGadgetID)  ;--------> ici (ERREUR) Le #gadget spécifié n'est pas initialisé
    ResetList(hCBM())
    While NextElement(hCBM()) And hWnd<>GadgetID(hCBM()\iGadgetID) :Wend
  EndIf
  *PCBM.CBM=@hCBM()
  
  If hWnd=GadgetID(*PCBM\iGadgetID)
    
    If uMsg=#WM_LBUTTONDOWN Or uMsg=#WM_LBUTTONDBLCLK
      If *PCBM\iMenuOpen=0
        *PCBM\iMenuOpen=-1
        SetFocus_(hwnd)
        ;
        *PCBM\iMenuID=CreatePopupMenu(#PB_Any)
        If *PCBM\iMenuID
          
          For ct=0 To CountGadgetItems(*PCBM\iGadgetID)-1
            mline$=GetGadgetItemText(*PCBM\iGadgetID,ct)
            Open=0
            Close=0
            Value=SendMessage_(GadgetID(*PCBM\iGadgetID),#CB_GETITEMDATA,ct,0)
            If Value<>#CB_ERR
              Open=Value & 1
              Close=Value/2
            EndIf
            If Open
              OpenSubMenu(mline$)
            Else
              MenuItem(ct+10000,mline$) ; we use menu items over 10000 to avoid conflicts with other application menus
            EndIf
            While Close
              CloseSubMenu()
              Close-1
            Wend
          Next
          ;
          ; Transmit the event to the main application
          ;
          PB_Gadget_SendGadgetCommand(GadgetID(*PCBM\iGadgetID),#CBN_DROPDOWN)
          ;
          *PCBM\iMenuOpen=1
          ;
        EndIf
        
      EndIf
      ProcedureReturn 0 ; hide the event to the combogadget
      ;
    ElseIf (uMsg=#WM_SETFOCUS Or uMsg=#WM_KILLFOCUS) And *PCBM\iMenuOpen=-1
      ; Avoid the EventType "SetFocus" on a mouse click
      ; because a classical ComboBox gadget does'nt send this event.
      ProcedureReturn 0
      ;
    ElseIf *PCBM\iMenuOpen=1 And uMSG=#WM_NCHITTEST
      
      *PCBM\iMenuOpen=2
      ;
      ; Display the popup menu
      GetWindowRect_(hWnd,re.RECT)
      id=TrackPopupMenu_(MenuID(*PCBM\iMenuID),#TPM_RETURNCMD | #TPM_LEFTBUTTON | #TPM_LEFTALIGN,re\left,re\bottom,0,GadgetID(*PCBM\iGadgetID),0)
      
      If PeekMessage_(@msg.msg,hwnd,#WM_LBUTTONDOWN,#WM_LBUTTONDOWN,#PM_NOREMOVE)=0
        ; menu has been closed!
        FreeMenu(*PCBM\iMenuID)
      EndIf
      ;
      ; Menu is now closed. Update our combo with the menu choice,
      ; and generate a PB event to tell the main application that something occured
      ;
      If id>0
        SetGadgetState(*PCBM\iGadgetID,id-10000) ; Update our combo with the menu choice
        PB_Gadget_SendGadgetCommand(GadgetID(*PCBM\iGadgetID),#CBN_SELCHANGE) ; Generate a PB event
      Else
        PB_Gadget_SendGadgetCommand(GadgetID(*PCBM\iGadgetID),#CBN_CLOSEUP)   ; Generate a PB event
      EndIf
      ;
    ElseIf *PCBM\iMenuOpen=2; the menu has just been displayed. Set the submenus icons
      *PCBM\iMenuOpen=0
      SetSubMenuIcon(MenuID(*PCBM\iMenuID))
    EndIf
    ;
    ProcedureReturn CallWindowProc_(*PCBM\iOldCBMCallBack,hwnd,uMsg,wParam,lParam)
    ;
  Else
    ProcedureReturn DefWindowProc_(hWnd,uMsg,wParam,lParam)
  EndIf
  
EndProcedure

A+

[Jacobus]

En ajoutant un test d'initialisation dans la Callback ça roule.

Code : Tout sélectionner

Procedure CBMCallback(hWnd, uMsg, wParam, lParam)
  ;By Zapman with the help of TomS and Nico
  ;
 If IsGadget(hCBM()\iGadgetID)<>0
  If hWnd <> GadgetID(hCBM()\iGadgetID)
    ResetList(hCBM())
    While NextElement(hCBM()) And  hWnd <> GadgetID(hCBM()\iGadgetID) : Wend
  EndIf
  *PCBM.CBM = @hCBM()

  If hWnd = GadgetID(*PCBM\iGadgetID)
    
    If uMsg = #WM_LBUTTONDOWN Or uMsg = #WM_LBUTTONDBLCLK
        If *PCBM\iMenuOpen=0
          *PCBM\iMenuOpen = -1
          SetFocus_(hwnd)
          ;
          *PCBM\iMenuID = CreatePopupMenu(#PB_Any)
          If *PCBM\iMenuID
            
            For ct = 0 To CountGadgetItems(*PCBM\iGadgetID)-1
              mline$ = GetGadgetItemText(*PCBM\iGadgetID,ct)
              Open = 0
              Close = 0
              Value = SendMessage_(GadgetID(*PCBM\iGadgetID),#CB_GETITEMDATA,ct,0)
              If Value<>#CB_ERR
                Open = Value&1
                Close = Value/2
              EndIf
              If Open
                OpenSubMenu(mline$)
              Else
                MenuItem(ct+10000,mline$) ; we use menu items over 10000 to avoid conflicts with other application menus
              EndIf
              While Close
                CloseSubMenu()
                Close - 1
              Wend
            Next
            ;
            ; Transmit the event to the main application
            ;
            PB_Gadget_SendGadgetCommand(GadgetID(*PCBM\iGadgetID),#CBN_DROPDOWN)
            ;
            *PCBM\iMenuOpen = 1
            ;
          EndIf
          
        EndIf
        ProcedureReturn 0 ; hide the event to the combogadget
        ;
    ElseIf (uMsg = #WM_SETFOCUS Or uMsg = #WM_KILLFOCUS) And *PCBM\iMenuOpen = -1
      ; Avoid the EventType "SetFocus" on a mouse click
      ; because a classical ComboBox gadget does'nt send this event.
      ProcedureReturn 0
      ;
    ElseIf *PCBM\iMenuOpen = 1 And uMSG = #WM_NCHITTEST

      *PCBM\iMenuOpen = 2 
      ;
      ; Display the popup menu
      GetWindowRect_(hWnd,re.RECT)
      id=TrackPopupMenu_(MenuID(*PCBM\iMenuID),#TPM_RETURNCMD | #TPM_LEFTBUTTON | #TPM_LEFTALIGN ,re\left,re\bottom,0,GadgetID(*PCBM\iGadgetID),0)
      
      If PeekMessage_(@msg.msg,hwnd,#WM_LBUTTONDOWN,#WM_LBUTTONDOWN,#PM_NOREMOVE)=0
        ; menu has been closed!
        FreeMenu(*PCBM\iMenuID)
      EndIf 
      ;
      ; Menu is now closed. Update our combo with the menu choice,
      ; and generate a PB event to tell the main application that something occured
      ;
      If id>0
        SetGadgetState(*PCBM\iGadgetID,id-10000) ; Update our combo with the menu choice
        PB_Gadget_SendGadgetCommand(GadgetID(*PCBM\iGadgetID), #CBN_SELCHANGE) ; Generate a PB event
      Else
        PB_Gadget_SendGadgetCommand(GadgetID(*PCBM\iGadgetID), #CBN_CLOSEUP)   ; Generate a PB event
      EndIf
      ;
    ElseIf *PCBM\iMenuOpen = 2; the menu has just been displayed. Set the submenus icons
      *PCBM\iMenuOpen = 0
      SetSubMenuIcon(MenuID(*PCBM\iMenuID))
    EndIf
    ;
    ProcedureReturn CallWindowProc_(*PCBM\iOldCBMCallBack, hwnd, uMsg, wParam, lParam)
    ;
  Else
    ProcedureReturn DefWindowProc_(hWnd, uMsg, wParam, lParam)
  EndIf
  
 EndIf 
EndProcedure

[ZapMan]

Désolé

C'est corrigé.