FiveTech Support Forums

FiveWin / Harbour / xBase community
Board indexAll discussionsLogin (GitHub)
Board index FiveWin for Harbour/xHarbour multi-column popup menu
Natter
Posts: 1392
Joined: Mon May 14, 2007 09:49 AM
multi-column popup menu
Posted: Wed Jan 22, 2025 09:15 AM
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 :( )
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: multi-column popup menu
Posted: Wed Jan 22, 2025 10:38 AM

Dear Yuri,

We are checking it...

regards, saludos

Antonio Linares
www.fivetechsoft.com
nageswaragunupudi
Posts: 10733
Joined: Sun Nov 19, 2006 05:22 AM
Re: multi-column popup menu
Posted: Wed Jan 22, 2025 03:57 PM
Sample menu:
Code: Select all Collapse
function ColPopUp()

   local oPop

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

   ENDMENU

return oPop
Regards



G. N. Rao.

Hyderabad, India
cnavarro
Posts: 6755
Joined: Wed Feb 15, 2012 08:25 PM
Re: multi-column popup menu
Posted: Wed Jan 22, 2025 05:53 PM
Complete sample: MNUSELECT.PRG
Code: Select all Collapse
//----------------------------------------------------------------------------//
//   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: 1392
Joined: Mon May 14, 2007 09:49 AM
Re: multi-column popup menu
Posted: Thu Jan 23, 2025 08:26 AM
Thanks for your help. I tried to make a simple example
Code: Select all Collapse
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: 1392
Joined: Mon May 14, 2007 09:49 AM
Re: multi-column popup menu
Posted: Thu Jan 23, 2025 06: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 ?

Ariel
Posts: 389
Joined: Wed Nov 29, 2006 01:51 PM
Re: multi-column popup menu
Posted: Thu Jan 23, 2025 09:31 PM

Felicitaciones Cristoblal, excelente trabajo!

cnavarro
Posts: 6755
Joined: Wed Feb 15, 2012 08:25 PM
Re: multi-column popup menu
Posted: Fri Jan 24, 2025 01:33 AM
Natter wrote: 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 Collapse
//----------------------------------------------------------------------------//
#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: 1392
Joined: Mon May 14, 2007 09:49 AM
Re: multi-column popup menu
Posted: Fri Jan 24, 2025 09:23 AM

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 ?

cnavarro
Posts: 6755
Joined: Wed Feb 15, 2012 08:25 PM
Re: multi-column popup menu
Posted: Fri Jan 24, 2025 11:56 PM
Sorry, I don't understand ¿ characters ?

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: 1392
Joined: Mon May 14, 2007 09:49 AM
Re: multi-column popup menu
Posted: Sat Jan 25, 2025 09:08 AM
Strange, I compiled your example exactly. The result looks like this

https://cloud.mail.ru/public/jnLg/3ETyhvUcV
cnavarro
Posts: 6755
Joined: Wed Feb 15, 2012 08:25 PM
Re: multi-column popup menu
Posted: Sun Jan 26, 2025 09:05 PM
Natter wrote: 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: 1392
Joined: Mon May 14, 2007 09:49 AM
Re: multi-column popup menu
Posted: Mon Jan 27, 2025 08:00 AM

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

cnavarro
Posts: 6755
Joined: Wed Feb 15, 2012 08:25 PM
Re: multi-column popup menu
Posted: Mon Jan 27, 2025 10:58 PM
Natter wrote: It works, thanks ! Is it possible to specify a vertical separator between columns ?
Try with this sample and change colors
Code: Select all Collapse
//----------------------------------------------------------------------------//
#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

//----------------------------------------------------------------------------//
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
reinaldocrespo
Posts: 990
Joined: Thu Nov 17, 2005 05:49 PM
Re: multi-column popup menu
Posted: Sun Mar 02, 2025 10:52 PM
Hello Cristobal. Very ingenious way to use a Tmenu object. I like it and I wish to use it on a get:
Code: Select all Collapse
   REDEFINE GET o VAR ::oDbf:VarCNKey ID 104 OF oDlg BITMAP "Search16" 
   o:bAction := { || x := MyPopMnu( oDlg, o:nTop, o:nLeft, ::aContractors ) }
The problem is your MyPopMenu function returns the TMenu object itself I don't see how to use it to determine what was the item picked by the user.

Any ideas?

Thank you.
Static archive · New replies & topics via GitHub Discussions