85 lines
2.1 KiB
Plaintext
85 lines
2.1 KiB
Plaintext
*-------------------------------------------
|
|
* Function...: Xmenu
|
|
* Author.....: MARTIN
|
|
* Date.......: 04/06/1997
|
|
* Notes......: Based on an idea from Steve Zimmelman for FoxPro 2.x
|
|
* Parameters.: tcItems = Semicolon-separated String with the various options
|
|
* ...........: tnBar = Initially selected item (default=1)
|
|
* Returns....: Selected item number
|
|
* See Also...: PROMPT() [FoxPro Native]
|
|
* lnOption = xmenu('\<Listare1;L\<istare2;Li\<stare3')
|
|
PROCEDURE XMENU
|
|
LPARAMETERS TCITEMS, TNBAR
|
|
|
|
LOCAL NITEMCOUNT, AITEMS, X, NROW, NCOL, CTITLE, NLASTPOS, CCOLOR, AITEMS
|
|
|
|
PRIVATE CPOPMENU, NSELECT && They flow into the GetChoice internal procedure
|
|
|
|
IF PCOUNT() < 2
|
|
TNBAR = 1
|
|
ENDIF
|
|
|
|
ACTIVATE SCREEN
|
|
|
|
* Parse every item
|
|
m.NITEMCOUNT = OCCURS( ';', TCITEMS ) + 1
|
|
DIMEN AITEMS[ m.nItemCount ]
|
|
m.NLASTPOS = 1
|
|
|
|
FOR m.X = 1 TO m.NITEMCOUNT
|
|
|
|
IF m.X < m.NITEMCOUNT
|
|
|
|
AITEMS[ m.x ] = SUBS( m.TCITEMS, m.NLASTPOS, ;
|
|
( AT( ';', m.TCITEMS, m.X ) - 1 ) - m.NLASTPOS + 1 )
|
|
ELSE
|
|
AITEMS[ m.x ] = SUBS( m.TCITEMS, m.NLASTPOS, ;
|
|
( LEN( m.TCITEMS ) - m.NLASTPOS ) + 1 )
|
|
ENDIF
|
|
|
|
IF AITEMS[ m.x ] # "\-"
|
|
|
|
AITEMS[ m.x ] = ALLT( AITEMS[ m.x ] )
|
|
ENDIF
|
|
|
|
m.NLASTPOS=AT( ';', m.TCITEMS, m.X ) + 1
|
|
NEXT
|
|
|
|
* Calculates the mouse pointer position
|
|
m.NROW = IIF( MROW() + m.NITEMCOUNT < SROW(), MROW() - 1, SROW() - m.NITEMCOUNT )
|
|
m.NCOL = IIF( MCOL() + 10 < SCOL(), MCOL() - 3, MCOL() - 13 )
|
|
|
|
* Gets an unique name for the pop-up
|
|
m.CPOPMENU = 'M' + SYS(3) + "_"
|
|
|
|
DEFINE POPUP ( m.CPOPMENU ) SHORTCUT RELATIVE FROM NROW, NCOL
|
|
|
|
FOR m.X = 1 TO m.NITEMCOUNT
|
|
|
|
DEFINE BAR m.X OF ( m.CPOPMENU ) PROMPT AITEMS[ m.x ]
|
|
NEXT
|
|
|
|
m.CANS = ""
|
|
m.NSELECT = 0
|
|
CLEAR TYPE
|
|
|
|
ON SELECTION POPUP ( m.CPOPMENU ) DO GETCHOICE
|
|
|
|
ACTIVATE POPUP ( m.CPOPMENU ) BAR TNBAR
|
|
|
|
POP KEY
|
|
RELEASE POPUP ( m.CPOPMENU )
|
|
|
|
RETURN IIF( LASTKEY()=27, 0, m.NSELECT )
|
|
|
|
ENDPROC && XMENU
|
|
|
|
*--------------------
|
|
PROCEDURE GETCHOICE
|
|
|
|
m.NSELECT = BAR()
|
|
|
|
DEACTIVATE POPUP ( m.CPOPMENU )
|
|
|
|
ENDPROC
|
|
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MENIU &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& |