Page 1 of 1

multi-column popup menu

Posted: Wed Jan 22, 2025 9:15 am
by Natter
I need to make a multi-column popup menu. How can it be done ?
(there is COLUNS option in TMenu class, but I didn't find any examples of using it :( )

Re: multi-column popup menu

Posted: Wed Jan 22, 2025 10:38 am
by Antonio Linares
Dear Yuri,

We are checking it...

Re: multi-column popup menu

Posted: Wed Jan 22, 2025 3:57 pm
by nageswaragunupudi
Sample menu:

Code: Select all | Expand

function ColPopUp()

   local oPop

   MENU oPop POPUP 2007 ;
      SELECT "STATES" ;  // alias
      COLUMNS 1, 2 ;
      HEADERS "One", "Two"

   ENDMENU

return oPop
Image

Re: multi-column popup menu

Posted: Wed Jan 22, 2025 5:53 pm
by cnavarro
Complete sample: MNUSELECT.PRG

Code: Select all | Expand

//----------------------------------------------------------------------------//
//   Author: Cristobal Navarro
//   Sample demo Features MENUS, using databases and arrays
//----------------------------------------------------------------------------//

#include "FiveWin.ch"

Static oWnd
Static oFontMnu

function Main()

   local oMenu

   DEFINE FONT oFontMnu NAME "Segoe UI Symbol" SIZE 0, -14
   
   DbUseArea( .T., , "Customer.dbf" )
   DbUseArea( .T., , "utf8_01.dbf" )
   DbUseArea( .T., , "states.dbf" )
   //DbGoto( 3 )
   DEFINE WINDOW oWnd TITLE "Test Menu From Databases and Arrays: " MENU MenuDatabase() ;
      FROM 20, 40 TO 650, 1200 PIXEL

   oWnd:bRClicked  := { | nR, nC | MenuDatabase( .T., .F., nR, nC ) }
   CtrlMove( oWnd )

   ACTIVATE WINDOW oWnd ON INIT MenuDatabase( .F., .T., , ) MAXIMIZED

   RELEASE oFontMnu

return nil

//----------------------------------------------------------------------------//

Function MenuDatabase( lPopup, lSys, nR, nC )

   local oMenu
   DEFAULT lPopup  := .F.
   DEFAULT lSys    := .F.

   if !lPopup
      if !lSys
         MENU oMenu 2013 ;
            COLORMENU METRO_STEEL, CLR_WHITE ;
            COLORLEFT CLR_WHITE, METRO_STEEL ;
            COLORRIGHT CLR_WHITE, METRO_STEEL ;
            COLORSELECT CLR_HCYAN, CLR_HCYAN, Rgb( 0, 0, 1 ) ; //CLR_WHITE, CLR_WHITE, CLR_BLUE ;
            COLORSEPARATOR CLR_RED ;
            COLORBOX CLR_WHITE
      else
         REDEFINE SYSMENU oMenu OF oWnd 2013 ;
            COLORMENU METRO_STEEL, CLR_WHITE ;
            COLORLEFT CLR_WHITE, METRO_STEEL ;
            COLORRIGHT CLR_WHITE, METRO_STEEL ;
            COLORSELECT CLR_WHITE, CLR_WHITE, CLR_BLUE ;
            COLORSEPARATOR CLR_RED ;
            COLORBOX CLR_WHITE
         
         SEPARATOR
      endif
   else
      MENU oMenu 2013 POPUP FONT oFontMnu ;
         COLORMENU METRO_STEEL, CLR_WHITE ;
         COLORLEFT CLR_WHITE, METRO_STEEL ;
         COLORRIGHT CLR_WHITE, METRO_STEEL ;
         COLORSELECT CLR_WHITE, CLR_WHITE, CLR_BLUE ;
         COLORSEPARATOR CLR_RED ;
         COLORBOX CLR_WHITE
   endif
   if lPopup
      MENUITEM "Databases and Arrays Test and Font" SEPARATOR OF oMenu BOLD //ITALIC
      SEPARATOR
   endif
   MENUITEM Alias( 1 ) // COLORMENU CLR_RED, CLR_YELLOW
      MENU SELECT Alias( 1 ) LIMIT 16 COLUMNS 1, 4, 5
      ENDMENU
   MENUITEM Alias( 2 )
      MENU SELECT Alias( 2 ) LIMIT 06 COLUMNS 1, 2, 3
      ENDMENU
   MENUITEM Alias( 3 )
      MENU SELECT Alias( 3 ) LIMIT -1 COLUMNS 2
      ENDMENU
   MENUITEM Alias( 2 ) + "_EXPAND"
      MENU SELECT Alias( 2 ) LIMIT 06 COLUMNS 1, 2, 3 EXPAND
      ENDMENU
   MENUITEM Upper( "FieldNames_" ) + Alias( 1 )
      MENU SELECT ( Alias( 1 ) )->( DbStruct() ) LIMIT -1 COLUMNS 2, 1, 3 //, 4
      ENDMENU
   MENUITEM Upper( "FieldNames_" ) + Alias( 1 ) + "_EXPAND"
      MENU SELECT ( Alias( 1 ) )->( DbStruct() ) LIMIT -1 COLUMNS 1, 2, 3, 4 ;
         EXPAND NOFORM HEADERS "Name", "Type", "Length", "Decs"
      ENDMENU
   MENUITEM Upper( "FieldNames" ) + "_EXPAND_FORM_ACTIONS"
      MENU SELECT ( Alias( 1 ) )->( DbStruct() ) LIMIT -1 COLUMNS 1, 2, 3, 4 EXPAND ;
         HEADERS "Name", "Type", "Length", "Decs" ACTION { | oI | MyAction( oI ) }
         //LEFTWIDTH if( lSys, 24, 1 ) ;
         //LOGOMENU "..\bitmaps\fivetechv.png" ;
      ENDMENU
   MENUITEM "EXIT" ACTION oWnd:End() WHEN ( !lPopup .and. !lSys )
   if lPopup
      ENDMENU
      if nC < oWnd:nRight - 400
         ACTIVATE MENU oMenu AT nR, nC OF oWnd  // Limit zone for show menu
      else
         oMenu:End()    // Release Menus created
      endif
   else
      if lSys
         SEPARATOR
         MENUITEM "Reset Menu"  ACTION oMenu:Reset()
         ENDSYSMENU
      else
         ENDMENU
      endif
   endif

Return oMenu

//----------------------------------------------------------------------------//

Function MyAction( oI )
     //oI:SetCheck(.T.)
     ? "Object Item: ", oI, ;
       "Position into Menu Parent: ", oI:nPos, ;
       "oItem cPrompt:", oI:cPrompt, ;
       "oItem Id: ", oI:nId, ;
       "Object Menu Parent of Item: ", oI:oMenu, ;
       "Position of Menu Parent: ", oI:oMenu:nPos
     ? "Object Menu Principal: ", Valtype( GetaMenusAux()[ 1 ] ), GetaMenusAux()[ 1 ]:lMenuBar
     ? "Items of Menu Principal: ", Len( GetaMenusAux()[ 1 ]:aMenuItems )
     ? "Menu Parent of Menu of Item Selected", GetParentAuxMenus( oI:oMenu ), ;
       "Items of this Menu: ", Len( GetParentAuxMenus( oI:oMenu ):aMenuItems ), ;
       "Separators, they are also counted"
     ? "Len Items Menu 5: ", Len( GetaMenusAux()[ 5 ]:aMenuItems )
     ? "Total Menus Create: ", Len( GetaMenusAux() )

Return nil

//----------------------------------------------------------------------------//

Function CtrlMove( oDlg )

   local oFontWD2
   local nRow      := oDlg:nBottom - 150
   local nCol      := oDlg:nRight  - 350
   local nSize     := 32
   local oSay

   @ nRow - 64, 20 GROUP TO nRow + 54, oDlg:nRight - 460 OF oDlg PIXEL PROMPT "  Notes:  "
   @ nRow - 64, oDlg:nRight - 450 GROUP TO nRow + 54, oDlg:nRight - 80 OF oDlg PIXEL PROMPT "  Menu " + Alias( 1 ) + " Changes: "
   @ nRow - 24, 80 SAY " - Press RIGHT BUTTON of Mouse for Test Menu POPUP: [ MAX -> oWnd:nRight - 400 ]" ;
      PIXEL OF oDlg COLOR CLR_WHITE, METRO_OLIVE FONT oFontMnu SIZE 550, 24
   @ nRow + 12, 80 SAY " - Press over ICON Application for Test SYSMENU" PIXEL ;
      OF oDlg COLOR CLR_WHITE, METRO_OLIVE FONT oFontMnu SIZE 550, 24
   @ nRow - 24, nCol - nSize - 24 SAY oSay PROMPT " Controls for movement: " + Alias( 1 ) PIXEL ;
      OF oDlg COLOR CLR_WHITE, METRO_OLIVE FONT oFontMnu SIZE 230, 22

   oFontWD2 := TFont():New( 'Wingdings 3', 0, -21, .f., .f., 0, 0, 400, .f., .f., .f., 2,3, 2, 1,, 18 )
   @ nRow, nCol BTNBMP PROMPT Chr( HexToDec( "72" ) ) SIZE nSize, nSize + 1 PIXEL OF oDlg FLAT  ; //BITMAP aBmp[ 1 ]
      TOOLTIP FWString( "Top" ) + " " + Alias( 1 ) FONT oFontWD2 ACTION ( ATTop() )
   @ nRow, nCol + nSize * 1 + 1 BTNBMP PROMPT Chr( HexToDec( "76" ) ) SIZE nSize, nSize + 1 PIXEL OF oDlg FLAT ;
      TOOLTIP FWString( "Move Up" ) + " " + Alias( 1 ) FONT oFontWD2  ACTION ( Retrocede() )
   @ nRow, nCol + nSize * 2 + 2 BTNBMP PROMPT Chr( HexToDec( "77" ) ) SIZE nSize, nSize + 1 PIXEL OF oDlg FLAT ;
      TOOLTIP FWString( "Move Down" ) + " " + Alias( 1 ) FONT oFontWD2  ACTION ( Avanza() )
   @ nRow, nCol + nSize * 3 + 3 BTNBMP PROMPT Chr( HexToDec( "73" ) ) SIZE nSize, nSize + 1 PIXEL OF oDlg FLAT ;
      TOOLTIP FWString( "Bottom" ) + " " + Alias( 1 ) FONT oFontWD2  ACTION ( ATBottom() )
   oFontWD2:End()
   AEval( oDlg:aControls, { |o| If( o:ClassName() == "TBTNBMP", ( o:SetColor( CLR_WHITE, METRO_OLIVE ), o:nRound := 0 ), nil ) } )
Return nil

//----------------------------------------------------------------------------//

Function Avanza( nAr )

   local nRec    := ( Alias( 1 ) )->( RecNo() )
   local nPos    := 0
   local x
   local oMnu    := GetaMenusAux()[ 2 ]
   local n
   local aItems  := {}
   DEFAULT nAr   := 1
   //? oWnd:oMenu:hMenu, Len( GetaMenusAux()[ 1 ]:aMenuItems ), GetaMenusAux()[ 2 ]:aMenuItems[ 4 ]:cPrompt
   //? GetaMenusAux()[ 1 ]:aMenuItems[ 1 ]:bAction:hMenu, oMnu:hMenu
   if !Empty( oMnu )
      if oMnu:nLimit > 0
         ( Alias( nAr ) )->( DbGoTo( ( oMnu:nLimit * oMnu:nPage ) + 1 ) )
         if ( Alias( nAr ) )->( !Eof() )
            oMnu:nPage++
            aItems   := oMnu:aMenuItems
            x        := 0
            Do While ( Alias( nAr ) )->( !Eof() )
                x++
                if x > oMnu:nLimit
                   Exit
                endif
                For n = 1 to Len( oMnu:aCols )
                   aItems[ x +  ( 2 * n ) + oMnu:nLimit * ( n - 1 ) ]:SetPrompt( ( Alias( nAr ) )->( FieldGet( oMnu:aCols[ n ] ) ) )
                Next n
                ( Alias( nAr ) )->( DbSkip() )
            Enddo
         endif
      endif
   endif
   ( Alias( nAr ) )->( DbGoTo( nRec ) )

Return nil

//----------------------------------------------------------------------------//

Function Retrocede( nAr )

   local nRec    := ( Alias( 1 ) )->( RecNo() )
   local nPos    := 0
   local x
   local oMnu    := GetaMenusAux()[ 2 ]
   local n
   local aItems  := {}
   DEFAULT nAr   := 1
   if !Empty( oMnu )
      if oMnu:nLimit > 0
         ( Alias( nAr ) )->( DbGoTo( ( oMnu:nLimit * ( oMnu:nPage - 2 ) ) + 1 ) )
         if ( Alias( nAr ) )->( !Bof() )
            oMnu:nPage--
            aItems   := oMnu:aMenuItems
            x        := 0
            Do While ( Alias( nAr ) )->( !Bof() )
                x++
                if x > oMnu:nLimit
                   Exit
                endif
                For n = 1 to Len( oMnu:aCols )
                   aItems[ x +  ( 2 * n ) + oMnu:nLimit * ( n - 1 ) ]:SetPrompt( ( Alias( nAr ) )->( FieldGet( oMnu:aCols[ n ] ) ) )
                Next n
                ( Alias( nAr ) )->( DbSkip( 1 ) )
            Enddo
         endif
      endif
   endif
   ( Alias( nAr ) )->( DbGoTo( nRec ) )   

Return nil

//----------------------------------------------------------------------------//

Function ATTop( nAr )

   local nRec    := ( Alias( 1 ) )->( RecNo() )
   local nPos    := 0
   local x
   local oMnu    := GetaMenusAux()[ 2 ]
   local n
   local aItems  := {}
   DEFAULT nAr   := 1
   if !Empty( oMnu )
      if oMnu:nLimit > 0
         ( Alias( nAr ) )->( DbGoTop() )
         if ( Alias( nAr ) )->( !Eof() )
            oMnu:nPage := 1
            aItems   := oMnu:aMenuItems
            x        := 0
            Do While ( Alias( nAr ) )->( !Eof() )
                x++
                if x > oMnu:nLimit
                   Exit
                endif
                For n = 1 to Len( oMnu:aCols )
                   aItems[ x +  ( 2 * n ) + oMnu:nLimit * ( n - 1 ) ]:SetPrompt( ( Alias( nAr ) )->( FieldGet( oMnu:aCols[ n ] ) ) )
                Next n
                ( Alias( nAr ) )->( DbSkip() )
            Enddo
         endif
      endif
   endif
   ( Alias( nAr ) )->( DbGoTo( nRec ) )

Return nil

//----------------------------------------------------------------------------//

Function ATBottom( nAr )

   local nRec    := ( Alias( 1 ) )->( RecNo() )
   local nPos    := 0
   local x
   local oMnu    := GetaMenusAux()[ 2 ]
   local n
   local aItems  := {}
   DEFAULT nAr   := 1
   if !Empty( oMnu )
      if oMnu:nLimit > 0
         ( Alias( nAr ) )->( DbGoTo( ( Alias( 1 ) )->( LastRec() ) - oMnu:nLimit + 1 ) )
         if ( Alias( nAr ) )->( !Eof() )
            oMnu:nPage := if( ( ( Alias( nAr ) )->( LastRec() ) % oMnu:nLimit ) = 0, ;
                              ( ( Alias( nAr ) )->( LastRec() ) / oMnu:nLimit ), ;
                              Int( ( Alias( nAr ) )->( LastRec() ) / oMnu:nLimit ) + 1 )
            aItems   := oMnu:aMenuItems
            x        := 0
            Do While ( Alias( nAr ) )->( !Eof() )
                x++
                if x > oMnu:nLimit
                   Exit
                endif
                For n = 1 to Len( oMnu:aCols )
                   aItems[ x +  ( 2 * n ) + oMnu:nLimit * ( n - 1 ) ]:SetPrompt( ( Alias( nAr ) )->( FieldGet( oMnu:aCols[ n ] ) ) )
                Next n
                ( Alias( nAr ) )->( DbSkip() )
            Enddo
         endif
      endif
   endif
   ( Alias( nAr ) )->( DbGoTo( nRec ) )

Return nil

//----------------------------------------------------------------------------//


Re: multi-column popup menu

Posted: Thu Jan 23, 2025 8:26 am
by Natter
Thanks for your help. I tried to make a simple example

Code: Select all | Expand

fld:={1,2}

  MENU oPop POPUP 2015  COLUMNS fld ;
    MENUITEM oCl  PROMPT {"one", "two"}
  ENDMENU
Thanks for your help. I tried to make a simple example. Everything works, but the menu has only 1 column that shows the glued values “one ‘+’two” What am I doing wrong?

Re: multi-column popup menu

Posted: Thu Jan 23, 2025 6:39 pm
by Natter
The array works fine. Why do some kind of initial column and separator between the columns appear ? Is it possible to get rid of them ?

Re: multi-column popup menu

Posted: Thu Jan 23, 2025 9:31 pm
by Ariel
Felicitaciones Cristoblal, excelente trabajo!

Re: multi-column popup menu

Posted: Fri Jan 24, 2025 1:33 am
by cnavarro
Natter wrote: Thu Jan 23, 2025 6:39 pm The array works fine. Why do some kind of initial column and separator between the columns appear ? Is it possible to get rid of them ?
Please run this sample and tell me your opinion

Code: Select all | Expand

//----------------------------------------------------------------------------//
#include "Fivewin.ch"
//----------------------------------------------------------------------------//

Function Main()

   local oWnd

   DEFINE WINDOW oWnd TITLE "Test Menu MultiColumn: " ;
      FROM 20, 40 TO 650, 1200 PIXEL

   oWnd:bRClicked  := { | nR, nC | MyPopMnu( oWnd, nR, nC ) }

   ACTIVATE WINDOW oWnd

Return nil

//----------------------------------------------------------------------------//

Function MyPopMnu( oWnd, nR, nC )

   local oPop

   MENU oPop POPUP 2015
      MENUITEM "Array" 
      MENU SELECT { { "one1", "two1" }, { "one2", "two2" } }  COLUMNS 1, 2 HEADERS "Col-1", "Col-2"
      ENDMENU
   ENDMENU
   ACTIVATE MENU oPop  AT nR, nC OF oWnd

Return oPop

//----------------------------------------------------------------------------//


Re: multi-column popup menu

Posted: Fri Jan 24, 2025 9:23 am
by Natter
I am doing the same thing. But I don't understand the meaning of the characters preceding the data. Is it possible to get rid of them ?

Re: multi-column popup menu

Posted: Fri Jan 24, 2025 11:56 pm
by cnavarro
Sorry, I don't understand ¿ characters ?

Image

Re: multi-column popup menu

Posted: Sat Jan 25, 2025 9:08 am
by Natter
Strange, I compiled your example exactly. The result looks like this

https://cloud.mail.ru/public/jnLg/3ETyhvUcV

Re: multi-column popup menu

Posted: Sun Jan 26, 2025 9:05 pm
by cnavarro
Natter wrote: Sat Jan 25, 2025 9:08 am Strange, I compiled your example exactly. The result looks like this

https://cloud.mail.ru/public/jnLg/3ETyhvUcV
Ah!, ok,
Please, edit PDMENU.PRG ( source/classes ) and search HSYSBITMAP
Copy line and remove HSYSBITMAP <n>
Add new PDMENU.PRG in your project

Re: multi-column popup menu

Posted: Mon Jan 27, 2025 8:00 am
by Natter
It works, thanks ! Is it possible to specify a vertical separator between columns ?

Re: multi-column popup menu

Posted: Mon Jan 27, 2025 10:58 pm
by cnavarro
Natter wrote: Mon Jan 27, 2025 8:00 am It works, thanks ! Is it possible to specify a vertical separator between columns ?
Try with this sample and change colors

Code: Select all | Expand

//----------------------------------------------------------------------------//
#include "Fivewin.ch"
//----------------------------------------------------------------------------//

Static oFontMnu

Function Main()

   local oWnd

   DEFINE FONT oFontMnu NAME "Segoe UI Symbol" SIZE 0, -14

   DEFINE WINDOW oWnd TITLE "Test Menu MultiColumn: " ; // MENU MenuDatabase() ;
      FROM 20, 40 TO 650, 1200 PIXEL

   oWnd:bRClicked  := { | nR, nC | MyPopMnu( oWnd, nR, nC ) }

   ACTIVATE WINDOW oWnd // ON INIT MenuDatabase( .F., .T., , ) MAXIMIZED

Return nil

//----------------------------------------------------------------------------//

Function MyPopMnu( oWnd, nR, nC )

   local oPop
   // local fld := { 1, 2 }

   MENU oPop 2013 POPUP FONT oFontMnu ;
         COLORMENU METRO_STEEL, CLR_WHITE ;
         COLORLEFT CLR_WHITE, METRO_STEEL ;
         COLORRIGHT CLR_WHITE, METRO_STEEL ;
         COLORSELECT CLR_WHITE, CLR_WHITE, CLR_BLUE ;
         COLORSEPARATOR CLR_RED ;
         COLORBOX CLR_WHITE

   // MENU oPop POPUP 2015   //;       COLUMNS fld 
      MENUITEM "Array"   // oCl // PROMPT {"one", "two"}
      MENU SELECT { { "one1", "two1" }, { "one2", "two2" } }  COLUMNS 2, 1 HEADERS "Col-1", "Col-2"
      ENDMENU
   ENDMENU
   ACTIVATE MENU oPop  AT nR, nC OF oWnd

Return oPop

//----------------------------------------------------------------------------//