PureBasic Forums - English

Posted: **Tue Aug 31, 2010 2:50 am**

;
;                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

Posted: **Tue Aug 31, 2010 7:35 am**

Nice!

Posted: **Tue Aug 31, 2010 10:21 am**

Seem to be some bad redrawig issues on Vista. When I run the program, parts of the background window overlay the new window to the extent that it is a right royal mess.

Posted: **Tue Aug 31, 2010 3:44 pm**

srod wrote:Seem to be some bad redrawig issues on Vista. When I run the program, parts of the background window overlay the new window to the extent that it is a right royal mess.

Confirmed. Windows 7.
Pressing the ReDim-Button redraws correctly, but the background of the text is white, which looks ugly on the XP-Style button.
Other than that, your code works fine and might be useful in the future

Thanks for sharing

Posted: **Wed Sep 01, 2010 6:32 am**

Thanks a lot for testing

I add a DrawingMode(#PB_2DDrawing_Outlined) to avoid the white background for the text and a modified the screen capture to try to solve the problem you noticed.

Code above has been updated. Please tell me if it's OK now.

I also added some functions:
- GetComboMenuGadgetState(ComboNum)

- GetComboMenuGadgetText(ComboNum)

- ComboMenuGadgetNewMenu(ComboNum)

Free the old menu used by the gadget and create a new one.
Return the MenuID of the new menu and allow you to refill
the new menu by using MenuItem, OpenSubMenu and CloseSubMenu PB functions

- GetComboMenuGadgetActualMenu(ComboNum)

Return the MenuID of the actual menu and allow you to use the PB menu functions
as GetMenuItemState, SetMenuItemState, HideMenu and so on.

Thanks again

Posted: **Wed Sep 01, 2010 9:45 am**

The drawing problems remain with Vista. When the window first appears it contains elements of the background plastered all over it.

Posted: **Wed Sep 01, 2010 5:03 pm**

The white background is gone, thanks.
As for the other problem, line 351 - 353 seem to be the problem. No they are not the problem, they are there to solve it.

Code: Select all

 For ct = 1 To 30 ; to be sure that the gadget is entirely drawned
        While WindowEvent():Wend
        Delay(1)
      Next

Delay(5) still draws the background of the first gadget, but it's kinda foggy now, like the gadget is drawn with opacity of 60% and the second gadget seems fine.

Delay(10) makes it look like it should look, but ~300ms per gadget might be very annoying if you have more than one or two of them.

.....................

OK. Now I see what you did there.
You draw create the gadget, make a screenshot and then cut the gadget out of the screenshot and use it as background image for your own gadget.

But why?
Couldn't you just use a normal Combobox-Gadget with just one entry, that is active by default (or not, like the first Gadget^^) and somehow 'steal' the click from the events and show your popup-menu?

Posted: **Wed Sep 01, 2010 8:29 pm**

Ok.
I hope you don't mind, but I wrote a little example myself.
It uses an subclassed ComboBoxGadget and no drawing, thus there should be no redraw problems on any machine.
There are only few commands by now, but I first need to get hold of two things, and I don't know how

so I'm hoping for your help, everybody.

1. How do I get the real position of a gadget on the desktop?
I need this at line 22.
Either I can somehow get the real positions, or I have to add the window-border-width and window-title-height (How do I do that

)

2. Can I use two or more Popup-Menus like this?

Code: Select all

CreatePopupMenu(1)
MenuItem(1, "1.1")
MenuItem(2, "1.2")

CreatePopupMenu(2)
MenuItem(1, "2.1")
MenuItem(2, "2.2")

If so: How can I determine in the main-loop which menu was opened?

If this is not possible, only like so:

Code: Select all

CreatePopupMenu(1)
MenuItem(1, "1.1")
MenuItem(2, "1.2")

CreatePopupMenu(2)
MenuItem(3, "2.1")
MenuItem(4, "2.2")

Then this is no problem, since I need exclusive Item-IDs and can simply 'select-case' for them.

Alright, here's what I've got so far.

Code: Select all

Global old ;Old WindowLong from ComboBoxGadget

Structure cbm
	iGadgetID.i
	iMenuID.i
	iGadgetX.i
	iGadgetY.i
	iGadgetWidth.i
	iGadgetHeight.i
	iWindow.i
	sText.s
EndStructure 

Global NewList cbm.cbm()

Procedure cb(hWnd, uMsg, wParam, lParam)	
	Select uMsg
		Case #WM_LBUTTONDOWN 
			ResetList(cbm())
			While NextElement(cbm())
				If hWnd = GadgetID(cbm()\iGadgetID)
					DisplayPopupMenu(cbm()\iMenuID, WindowID(cbm()\iWindow), cbm()\iGadgetX+WindowX(cbm()\iWindow), cbm()\iGadgetY + cbm()\iGadgetHeight +30+WindowY(cbm()\iWindow))
				EndIf 
			Wend 
		Default
			 result = CallWindowProc_(old, hWnd, uMsg, wParam, lParam)
	EndSelect 
	ProcedureReturn DefWindowProc_(hWnd, uMsg, wParam, lParam)
EndProcedure 
	
Procedure CreateComboBoxMenuGadget(iX.i, iY.i, iWidth.i, iHeight.i)
	AddElement(cbm())
	cbm()\iGadgetID = ComboBoxGadget(#PB_Any, iX, iY, iWidth, iHeight)
	cbm()\iGadgetX = iX
	cbm()\iGadgetY = iY
	cbm()\iGadgetWidth = iWidth
	cbm()\iGadgetHeight = iHeight
	old=SetWindowLong_(GadgetID(cbm()\iGadgetID), #GWL_WNDPROC, @cb())
	ProcedureReturn cbm()\iGadgetID
EndProcedure 

Procedure UseComboBoxMenu(iGadgetID.i, iWindow.i)
	ResetList(cbm())
	While NextElement(cbm())
		If cbm()\iGadgetID = iGadgetID
			cbm()\iMenuID = CreatePopupMenu(#PB_Any)
			cbm()\iWindow = iWindow
			ProcedureReturn cbm()\iMenuID 
			Break
		EndIf
	Wend	
EndProcedure 
		

Procedure SetComboBoxText(iGadgetID.i, sText.s)
	ResetList(cbm())
	While NextElement(cbm())
		If cbm()\iGadgetID = iGadgetID
			ClearGadgetItems(iGadgetID)
			AddGadgetItem(iGadgetID, -1, sText)
			SetGadgetState(iGadgetID, 0)	
			cbm()\sText = sText
			Break;
		EndIf
	Wend
EndProcedure 

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

combo1 = CreateComboBoxMenuGadget(5, 5, 95, 20)

combomenu1 = UseComboBoxMenu(combo1, hWnd)

MenuItem(1, "A.")
MenuItem(2, "B.(preselected)")
OpenSubMenu("C-E")
	MenuItem(3, "C.")
	MenuItem(4, "D.")
	MenuItem(5, "E.")
CloseSubMenu()
MenuItem(6, "F.")

SetComboBoxText(combo1.i, GetMenuItemText(combomenu1, 2))

Repeat
	event = WaitWindowEvent(20)
	Select event
		Case #PB_Event_Menu 
			Select EventMenu()
				Case 1 To 6
					SetComboBoxText(combo1.i, GetMenuItemText(combomenu1,EventMenu()))
			EndSelect 			
	EndSelect 	
Until event = #PB_Event_CloseWindow 
CloseWindow(hWnd)
End

Posted: **Thu Sep 02, 2010 12:18 pm**

Hi Toms,

Your solution is terrific. Thanks many time for that!.

For my needs, it's just missing 2 things to your very elegant and small code:
- when the user click and the combo and maintain the click on and then release on a popup line, the menu stay open. He has to click a second time to close it.
- I need folder icons on submenu titles.

I'll adapt my code using your tip and update it soon.

Thanks again.

Posted: **Thu Sep 02, 2010 3:34 pm**

1. How do I get the real position of a gadget on the desktop?
I need this at line 22.

Code: Select all

GetWindowRect_(GadgetID(<gadget>), @gr.RECT)

and now the rectangle in gr contains the screen coordinates of the gadget.

Posted: **Thu Sep 02, 2010 3:50 pm**

I've just updated my code using the idea of TomS.

The beauty of this new solution is that the gagdet can now be used
exactly like a classical combobox and manages all PureBasic functions like
addgadgetitem, setgadgetitemtext, etc. ...

I love it. Thank you again TomS

Posted: **Thu Sep 02, 2010 4:36 pm**

Nice.
Glad, I inspired you.
Good work!

Posted: **Thu Sep 02, 2010 4:48 pm**

Nice.

The only thing with this though is that the popup menu will be repositioned and/or resized automatically by windows if there are too many items for it to fit on the screen. It will also expand vertically to fill the entire screen (if you add loads of items) instead of adding a scrollbar etc. Try it, reposition the window close to the bottom right hand side of your screen and then click the combo.

This is why I abandoned an attempt at this some time ago.

It is nice work though and could be useful nevertheless.

Thanks.

Posted: **Thu Sep 02, 2010 5:25 pm**

srod wrote:The only thing with this though is that the popup menu will be repositioned and/or resized automatically by windows if there are too many items for it to fit on the screen. It will also expand vertically to fill the entire screen (if you add loads of items) instead of adding a scrollbar etc. Try it, reposition the window close to the bottom right hand side of your screen and then click the combo.

Those observations are interesting. The point is to decide if they represent a problem or an advantage.

When the window is positionned close to the bottom right hand side of the screen as you suggest, the new hierarchical combo is still usable while the classical combo is not.

Posted: **Thu Sep 02, 2010 5:29 pm**

Yes it is a matter of prefernce whether you deem this an 'annoyance' or not.

Personally, I prefer a scrollbar rather than a vertical expansion etc.

PureBasic Forums - English

Hierarchical pop-up Combo Gadget

Hierarchical pop-up Combo Gadget

Re: HIERARCHICAL POP-UP COMBO GADGET

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget

Re: Hierarchical pop-up Combo Gadget