multi-column popup menu

Post Reply
Natter
Posts: 1233
Joined: Mon May 14, 2007 9:49 am

multi-column popup menu

Post 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 :( )
User avatar
Antonio Linares
Site Admin
Posts: 42393
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 9 times
Been thanked: 41 times
Contact:

Re: multi-column popup menu

Post by Antonio Linares »

Dear Yuri,

We are checking it...
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
nageswaragunupudi
Posts: 10701
Joined: Sun Nov 19, 2006 5:22 am
Location: India
Been thanked: 3 times
Contact:

Re: multi-column popup menu

Post 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
Regards

G. N. Rao.
Hyderabad, India
User avatar
cnavarro
Posts: 6556
Joined: Wed Feb 15, 2012 8:25 pm
Location: España
Been thanked: 3 times

Re: multi-column popup menu

Post 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

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

Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Natter
Posts: 1233
Joined: Mon May 14, 2007 9:49 am

Re: multi-column popup menu

Post 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?
Natter
Posts: 1233
Joined: Mon May 14, 2007 9:49 am

Re: multi-column popup menu

Post 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 ?
Ariel
Posts: 378
Joined: Wed Nov 29, 2006 1:51 pm
Location: Rosario - Argentina

Re: multi-column popup menu

Post by Ariel »

Felicitaciones Cristoblal, excelente trabajo!
User avatar
cnavarro
Posts: 6556
Joined: Wed Feb 15, 2012 8:25 pm
Location: España
Been thanked: 3 times

Re: multi-column popup menu

Post 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

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

Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Natter
Posts: 1233
Joined: Mon May 14, 2007 9:49 am

Re: multi-column popup menu

Post 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 ?
User avatar
cnavarro
Posts: 6556
Joined: Wed Feb 15, 2012 8:25 pm
Location: España
Been thanked: 3 times

Re: multi-column popup menu

Post by cnavarro »

Sorry, I don't understand ¿ characters ?

Image
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Natter
Posts: 1233
Joined: Mon May 14, 2007 9:49 am

Re: multi-column popup menu

Post by Natter »

Strange, I compiled your example exactly. The result looks like this

https://cloud.mail.ru/public/jnLg/3ETyhvUcV
User avatar
cnavarro
Posts: 6556
Joined: Wed Feb 15, 2012 8:25 pm
Location: España
Been thanked: 3 times

Re: multi-column popup menu

Post 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
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Natter
Posts: 1233
Joined: Mon May 14, 2007 9:49 am

Re: multi-column popup menu

Post by Natter »

It works, thanks ! Is it possible to specify a vertical separator between columns ?
Post Reply