home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NFSRC.ZIP / MENU1.PRG < prev    next >
Encoding:
Text File  |  1991-08-16  |  19.7 KB  |  552 lines
  1. /*
  2.  * File......: MENU1.PRG
  3.  * Author....: Paul Ferrara
  4.  * CIS ID....: 76702,556
  5.  * Date......: $Date:   15 Aug 1991 23:04:42  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/menu1.prv  $
  8.  *
  9.  * This is an original work by Paul Ferrara and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/menu1.prv  $
  16.  * 
  17.  *    Rev 1.2   15 Aug 1991 23:04:42   GLENN
  18.  * Forest Belt proofread/edited/cleaned up doc
  19.  * 
  20.  *    Rev 1.1   14 Jun 1991 19:52:12   GLENN
  21.  * Minor edit to file header
  22.  * 
  23.  *    Rev 1.0   01 Apr 1991 01:01:40   GLENN
  24.  * Nanforum Toolkit
  25.  *
  26.  */
  27.  
  28.  
  29. /*  $DOC$
  30.  *  $FUNCNAME$
  31.  *     FT_MENU1()
  32.  *  $CATEGORY$
  33.  *     Menus/Prompts
  34.  *  $ONELINER$
  35.  *     Pulldown menu system
  36.  *  $SYNTAX$
  37.  *     FT_MENU1( <acBarNames>, <acOptions>, <acAction>,
  38.  *               <acColors> [, <nTopRow> ], [ <lShadow> ] ) -> NIL
  39.  *  $ARGUMENTS$
  40.  *     <acBarNames> is a character array containing the names to appear
  41.  *     on the menu bar.
  42.  *
  43.  *     <acOptions> is a multi-dimensional array with one element for each
  44.  *     selection to appear on the pulldown menus.
  45.  *
  46.  *     <acColors> is an array containing the colors for the menu groups.
  47.  *
  48.  *     <nTopRow> is a numeric value that determines the row for the menu
  49.  *     bar.  If omitted, it defaults to 0.
  50.  *
  51.  *     <lShadow> is a logical variable.  If true (.T.) or omitted, it
  52.  *     uses FT_SHADOW() to add a transparent shadow to the each
  53.  *     pulldown menu.  If false (.F.), the menu is drawn without
  54.  *     the shadow.
  55.  *
  56.  *     All arguments except nTopRow and lShadow are required.
  57.  *  $RETURNS$
  58.  *     NIL
  59.  *  $DESCRIPTION$
  60.  *     FT_MENU1() is a function that displays a pulldown menu for each item
  61.  *     on the menu bar and executes the corresponding function for the item
  62.  *     selected.  When a called function returns false, FT_MENU1 returns
  63.  *     control to the calling program.
  64.  *
  65.  *     Valid keystrokes and their corresponding actions:
  66.  *
  67.  *     Home             -  Activates Pulldown for first item on the menu bar
  68.  *     End              -  Activates Pulldown for last item on the menu bar
  69.  *     Left Arrow       -  Activates next Pulldown to the left
  70.  *     Right Arrow      -  Activates next Pulldown to the right
  71.  *     Tab              -  Same as Right Arrow
  72.  *     Shift-Tab        -  Same as Left Arrow
  73.  *     Page Up          -  Top item on current Pulldown menu
  74.  *     Page Down        -  Bottom item on current Pulldown menu
  75.  *     Enter            -  Selects current item
  76.  *     Alpha Character  -  Moves to closest match and selects
  77.  *     Alt-<Key>        -  Moves to corresponding menu bar item
  78.  *     Escape           -  Prompts for confirmation and either returns to
  79.  *                         the calling routine or resumes
  80.  *  $EXAMPLES$
  81.  *     // Declare arrays
  82.  *     LOCAL aColors  := {}
  83.  *     LOCAL aBar     := { " ENTER/EDIT ", " REPORTS ", " DISPLAY " }
  84.  *
  85.  *     // Include the following two lines of code in your program, as is.
  86.  *     // The first creates aOptions with the same length as aBar.  The
  87.  *     // second assigns a three-element array to each element of aOptions.
  88.  *     LOCAL aOptions[ LEN( aBar ) ]
  89.  *     AEVAL( aBar, { |x,i| aOptions[i] := { {},{},{} } } )
  90.  *
  91.  *     // fill color array
  92.  *     // Box Border, Menu Options, Menu Bar, Current Selection, Unselected
  93.  *     aColors := IF( lColor, {"W+/G", "N/G", "N/G", "N/W", "N+/G"}, ;
  94.  *                            {"W+/N", "W+/N", "W/N", "N/W","W/N"} )
  95.  *
  96.  *  // array for first pulldown menu
  97.  *  FT_FILL( aOptions[1], 'A. Execute A Dummy Procedure' , {|| fubar()}, .t. )
  98.  *  FT_FILL( aOptions[1], 'B. Enter Daily Charges'       , {|| .t.},     .f. )
  99.  *  FT_FILL( aOptions[1], 'C. Enter Payments On Accounts', {|| .t.},     .t. )
  100.  *
  101.  *  // array for second pulldown menu
  102.  *  FT_FILL( aOptions[2], 'A. Print Member List'         , {|| .t.},     .t. )
  103.  *  FT_FILL( aOptions[2], 'B. Print Active Auto Charges' , {|| .t.},     .t. )
  104.  *
  105.  *  // array for third pulldown menu
  106.  *  FT_FILL( aOptions[3], 'A. Transaction Totals Display', {|| .t.},     .t. )
  107.  *  FT_FILL( aOptions[3], 'B. Display Invoice Totals'    , {|| .t.},     .t. )
  108.  *  FT_FILL( aOptions[3], 'C. Exit To DOS'               , {|| .f.},     .t. )
  109.  *
  110.  *     Call FT_FILL() once for each item on each pulldown menu, passing it
  111.  *     three parameters:
  112.  *
  113.  *        FT_FILL( <cMenuSelection>, <bCodeBlock>, <lSelectable>
  114.  *
  115.  *     <cMenuSelection> is a character string which will be displayed on
  116.  *      the pulldown menu.
  117.  *
  118.  *     <bCodeBlock> should contain one of the following:
  119.  *
  120.  *        A function name to execute, which in turn should return .T. or .F.
  121.  *        FT_MENU1 WILL RETURN CONTROL TO THE CALLING PROGRAM IF .F. IS
  122.  *        RETURNED OR CONTINUE IF .T. IS RETURNED.
  123.  *
  124.  *        .F. WHICH WILL CAUSE FT_MENU1 TO RETURN CONTROL TO THE CALLING
  125.  *        PROGRAM.
  126.  *
  127.  *        .T. WHICH WILL DO NOTHING.  THIS ALLOWS THE DEVELOPER TO DESIGN A
  128.  *        SKELETON MENU STRUCTURE PRIOR TO COMPLETING ALL OF THE SUBROUTINES.
  129.  *
  130.  *     // CALL FT_MENU1
  131.  *     FT_MENU1( aBar, aOptions, aColors, 0 )
  132.  *
  133.  *     NOTE: FT_MENU1() disables Alt-C and Alt-D in order to make them
  134.  *           available for the menu bar.  It enables Alt-D and resets
  135.  *           Alt-C to its previous state prior to calling each function.
  136.  *  $SEEALSO$
  137.  *     FT_FILL()
  138.  *  $END$
  139.  */
  140.  
  141.  
  142.  
  143.  
  144. /*
  145.      For the sample program:
  146.  
  147.      Compile with "/n /dFT_TEST" SWITCHES AND LINK.
  148.  
  149.      PASS "MONO" OR "MONO" AS A COMMAND LINE PARAMETER TO FORCE MONO MODE.
  150.  
  151.      PASS "NOSNOW" OR "NOSNOW" AS A COMMAND LINE PARAMETER ON A CGA.
  152.  
  153.      PASS "VGA" OR "VGA" AS A COMMAND LINE PARAMETER FOR 50-LINE MODE.
  154.  */
  155.  
  156.  
  157.  
  158.  
  159. #define LEFTARROW  19
  160. #define RIGHTARROW  4
  161. #define ENTER      13
  162. #define CTRLEND    23
  163. #define CTRLHOME   29
  164. #define HOME        1
  165. #define END         6
  166. #define TAB         9
  167. #define SHIFTTAB  271
  168. #define PGUP       18
  169. #define PGDN        3
  170. #define ESCAPE     27
  171. #define HITTOP      1
  172. #define HITBOTTOM   2
  173. #define KEYEXCEPT   3
  174. #define NEXTITEM    3
  175. #define RESUME      2
  176. #define MAKESELECT  1
  177. #define ABORT       0
  178. #define DISABLE     0
  179. #define ENABLE      1
  180. #define SCNONE      0
  181. #define SCNORMAL    1
  182.  
  183. STATIC ACHOICES := {}, AVALIDKEYS := {}
  184. STATIC NHPOS, NVPOS, NMAXROW, NMAXCOL
  185.  
  186. // BEGINNING OF DEMO PROGRAM
  187. #IFDEF FT_TEST
  188.    // DUMMY PROCEDURE NAME SO "CCMDLINE" WILL BE LOCAL
  189.    PROCEDURE CALLMENU( cCmdLine )
  190.    LOCAL sDosScrn, nDosRow, nDosCol, lColor
  191.  
  192.    // my approach to color variables
  193.    // see colorchg.arc on NANFORUM
  194.    STATIC cNormH, cNormN, cNormE, ;
  195.           cWindH, cWindN, cWindE, ;
  196.           cErrH, cErrN, cErrE
  197.  
  198.    // options on menu bar
  199.    LOCAL aColors  := {}
  200.    LOCAL aBar     := { " ENTER/EDIT ", " REPORTS ", " DISPLAY ", " MAINTENANCE ", " QUIT " }
  201.    LOCAL aOptions[ LEN( aBar ) ]
  202.    AEVAL( aBar, { |x,i| aOptions[i] := { {},{},{} } } )
  203.  
  204.    cCmdLine := IF( cCmdLine == NIL, "", cCmdLine )
  205.  
  206.    lColor := IF( "MONO" $ UPPER( cCmdLine ), .F., ISCOLOR() )
  207.  
  208.    * Border, Box, Bar, Current, Unselected
  209.    aColors := IF( lColor, {"W+/G", "N/G", "N/G", "N/W", "N+/G"}, ;
  210.                           {"W+/N", "W+/N", "W/N", "N/W", "W/N"} )
  211.  
  212.    FT_FILL( aOptions[1], 'A. Execute A Dummy Procedure'        , {|| fubar()}, .t. )
  213.    FT_FILL( aOptions[1], 'B. Enter Daily Charge/Credit Slips'  , {|| .t.}, .t. )
  214.    FT_FILL( aOptions[1], 'C. Enter Payments On Accounts'       , {|| .t.}, .f. )
  215.    FT_FILL( aOptions[1], 'D. Edit Daily Transactions'          , {|| .t.}, .t. )
  216.    FT_FILL( aOptions[1], 'E. Enter/Update Member File'         , {|| .t.}, .t. )
  217.    FT_FILL( aOptions[1], 'F. Update Code File'                 , {|| .t.}, .f. )
  218.    FT_FILL( aOptions[1], 'G. Add/Update Auto Charge File'      , {|| .t.}, .t. )
  219.    FT_FILL( aOptions[1], 'H. Post All Transactions To A/R File', {|| .t.}, .t. )
  220.    FT_FILL( aOptions[1], 'I. Increment Next Posting Date'      , {|| .t.}, .t. )
  221.  
  222.    FT_FILL( aOptions[2], 'A. Print Member List'                , {|| .t.}, .t. )
  223.    FT_FILL( aOptions[2], 'B. Print Active Auto Charges'        , {|| .t.}, .t. )
  224.    FT_FILL( aOptions[2], 'C. Print Edit List'                  , {|| .t.}, .t. )
  225.    FT_FILL( aOptions[2], 'D. Print Pro-Usage Report'           , {|| .t.}, .t. )
  226.    FT_FILL( aOptions[2], 'E. Print A/R Transaction Report'     , {|| .t.}, .t. )
  227.    FT_FILL( aOptions[2], 'F. Aging Report Preparation'         , {|| .t.}, .t. )
  228.    FT_FILL( aOptions[2], 'G. Add Interest Charges'             , {|| .t.}, .t. )
  229.    FT_FILL( aOptions[2], 'H. Print Aging Report'               , {|| .t.}, .t. )
  230.    FT_FILL( aOptions[2], 'I. Print Monthly Statements'         , {|| .t.}, .t. )
  231.    FT_FILL( aOptions[2], 'J. Print Mailing Labels'             , {|| .t.}, .t. )
  232.    FT_FILL( aOptions[2], 'K. Print Transaction Totals'         , {|| .t.}, .t. )
  233.    FT_FILL( aOptions[2], 'L. Print Transaction Codes File'     , {|| .t.}, .t. )
  234.    FT_FILL( aOptions[2], 'M. Print No-Activity List'           , {|| .t.}, .t. )
  235.  
  236.    FT_FILL( aOptions[3], 'A. Transaction Totals Display'       , {|| .t.}, .t. )
  237.    FT_FILL( aOptions[3], 'B. Display Invoice Totals'           , {|| .t.}, .t. )
  238.    FT_FILL( aOptions[3], 'C. Accounts Receivable Display'      , {|| .t.}, .t. )
  239.  
  240.    FT_FILL( aOptions[4], 'A. Backup Database Files'            , {|| .t.}, .t. )
  241.    FT_FILL( aOptions[4], 'B. Reindex Database Files'           , {|| .t.}, .t. )
  242.    FT_FILL( aOptions[4], 'C. Set System Parameters'            , {|| .t.}, .t. )
  243.    FT_FILL( aOptions[4], 'D. This EXITs Too'                   , {|| .f. }, .t. )
  244.  
  245.    FT_FILL( aOptions[5], 'A. Does Nothing'                     , {|| .t.}, .t. )
  246.    FT_FILL( aOptions[5], 'B. Exit To DOS'                      , {|| .f. }, .t. )
  247.  
  248.    // main routine starts here
  249.    SET SCOREBOARD OFF
  250.  
  251.    cNormH := IF( lColor, "W+/G", "W+/N" )
  252.    cNormN := IF( lColor, "N/G" , "W/N"  )
  253.    cNormE := IF( lColor, "N/W" , "N/W"  )
  254.    cWindH := IF( lColor, "W+/B", "W+/N" )
  255.    cWindN := IF( lColor, "W/B" , "W/N"  )
  256.    cWindE := IF( lColor, "N/W" , "N/W"  )
  257.    cErrH  := IF( lColor, "W+/R", "W+/N" )
  258.    cErrN  := IF( lColor, "W/R" , "W/N"  )
  259.    cErrE  := IF( lColor, "N/W" , "N/W"  )
  260.  
  261.    SAVE SCREEN TO sDosScrn
  262.    nDosRow=ROW()
  263.    nDosCol=COL()
  264.    SETCOLOR( "w/n" )
  265.    CLS
  266.    NOSNOW( ( "NOSNOW" $ UPPER( cCmdLine ) ) )
  267.    IF "VGA" $ UPPER( cCmdLine )
  268.       SETMODE(50,80)
  269.    ENDIF
  270.    nMaxRow := MAXROW()
  271.    SETBLINK(.f.)
  272.    SETCOLOR( cWindN + "*" )
  273.    CLEAR SCREEN
  274.    SETCOLOR( cNormN )
  275.    @ nMaxRow, 0
  276.    @ nMaxRow, 0 SAY " FT_MENU1 1.0 │ "
  277.    @ NMAXROW,16 SAY "WRITTEN BY PAUL FERRARA [76702,556] FOR NANFORUM.LIB"
  278.    @ NMAXROW,69 SAY "│ "+DTOC( DATE() )
  279.  
  280.    SETCOLOR( cErrH )
  281.    @ nMaxRow-11, 23, nMaxRow-3, 56 BOX "┌─┐│┘─└│ "
  282.    @ nMaxRow- 9,23 SAY "├────────────────────────────────┤"
  283.    SETCOLOR( cErrN )
  284.    @ nMaxRow-10,33 SAY "Navigation Keys"
  285.    @ nMaxRow- 8,25 SAY "LeftArrow   RightArrow   Alt-E"
  286.    @ nMaxRow- 7,25 SAY "Home        End          Alt-R"
  287.    @ nMaxRow- 6,25 SAY "Tab         Shift-Tab    Alt-D"
  288.    @ nMaxRow- 5,25 SAY "PgUp        PgDn         Alt-M"
  289.    @ nMaxRow- 4,25 SAY "Enter       ESCape       Alt-Q"
  290.    SETCOLOR( cNormN )
  291.  
  292.    FT_MENU1( aBar, aOptions, aColors )
  293.  
  294.    SETCOLOR( "W/N" )
  295.    SETCURSOR( SCNORMAL )
  296.    SETBLINK(.t.)
  297.    IF "VGA" $ UPPER( cCmdLine )
  298.       SETMODE(25,80)
  299.    ENDIF
  300.    RESTORE SCREEN FROM sDosScrn
  301.    SETPOS(nDosRow, nDosCol)
  302.    QUIT
  303.  
  304.    FUNCTION fubar()
  305.    LOCAL OldColor:= SETCOLOR( "W/N" )
  306.    CLEAR SCREEN
  307.    Qout( "Press Any Key" )
  308.    INKEY(0)
  309.    SETCOLOR( OldColor )
  310.    RETURN .t.
  311. #endif
  312. // end of demo program
  313.  
  314.  
  315. FUNCTION FT_MENU1( aBar, aOptions, aColors, nTopRow, lShadow )
  316.    LOCAL nTtlWid, nTtlUsed, i, j, nPad
  317.    LOCAL sMainScrn, lCancMode, lLooping := .t.
  318.  
  319.    // column position for each item on the menu bar
  320.    LOCAL aBarCol[LEN(aBar)]
  321.  
  322.    // inkey code for each item on menu bar
  323.    LOCAL aBarKeys[ LEN( aBar ) ]
  324.  
  325.    // inkey codes for A - Z
  326.    LOCAL aKeyCodes := { 286, 304, 302, 288, 274, 289, 290, 291, 279, ;
  327.                         292, 293, 294, 306, 305, 280, 281, 272, 275, ;
  328.                         287, 276, 278, 303, 273, 301, 277, 300 }
  329.  
  330.    // LEN() of widest array element for for each pulldown menu
  331.    LOCAL aBarWidth[LEN(aBar)]
  332.  
  333.    // starting column for each box
  334.    LOCAL aBoxLoc[LEN(aBar)]
  335.  
  336.    // last selection for each element
  337.    LOCAL aLastSel[LEN(aBar)]
  338.  
  339.    // color memvars
  340.    LOCAL cBorder  := aColors[1]
  341.    LOCAL cBox     := aColors[2]
  342.    LOCAL cBar     := aColors[3]
  343.    LOCAL cCurrent := aColors[4]
  344.    LOCAL cUnSelec := aColors[5]
  345.  
  346.    nMaxRow := MAXROW()
  347.    nMaxCol := MAXCOL()
  348.  
  349.    // row for menu bar
  350.    nTopRow := IF( nTopRow == NIL, 0, nTopRow )
  351.  
  352.    AFILL(aLastSel,1)
  353.    aChoices := aOptions
  354.  
  355.    // this is the routine that calculates the position of each item
  356.    // on the menu bar.
  357.    nTtlWid := 0
  358.    aBarCol[1] := 0
  359.    nTtlUsed := LEN( aBar[1] ) + 1
  360.    AEVAL( aBar, ;
  361.           {|x,i| aBarcol[i]:= nTtlUsed,nTtlUsed+= (LEN(aBar[i]) +1 )}, ;
  362.           2, LEN(aBar) -1 )
  363.  
  364.    // calculates widest element for each pulldown menu
  365.    // see below for _ftWidest()
  366.    AFILL(aBarWidth,1)
  367.    AEVAL( aChoices, { |x,i| _ftWidest( @i, aChoices, @aBarWidth ) } )
  368.  
  369.    // box location for each pulldown menu
  370.    // see below for _ftLocat()
  371.    AEVAL( aChoices, { |x,i| _ftLocat( i, aBarCol, aBarWidth, @aBoxLoc, nMaxCol ) } )
  372.  
  373.    // valid keys for each pulldown menu
  374.    // see below for _ftValKeys()
  375.    AEVAL( aChoices,{|x,i| AADD( aValidkeys,"" ),;
  376.                           _ftValKeys( i,aChoices,@aValidKeys ) } )
  377.  
  378.    // display the menu bar
  379.    SETCOLOR( cBar )
  380.    @ nTopRow, 0
  381.    AEVAL( aBar, { |x,i| Devpos(nTopRow, aBarCol[i]), Devout(aBar[i]) })
  382.  
  383.    // store inkey code for each item on menu bar to aBarKeys
  384.    AEVAL( aBarKeys, {|x,i| aBarKeys[i] := ;
  385.           aKeyCodes[ ASC( UPPER( LTRIM( aBar[i] ) ) ) - 64 ] } )
  386.  
  387.    // disable Alt-C and Alt-D
  388.    lCancMode := SETCANCEL( .f. )
  389.    AltD( DISABLE )
  390.  
  391.    // main menu loop
  392.    SAVE SCREEN TO sMainScrn
  393.    // which menu and which menu item
  394.    nHpos := 1; nVpos := 1
  395.    DO WHILE lLooping
  396.       RESTORE SCREEN FROM sMainScrn
  397.       SETCOLOR( cCurrent )
  398.       @  nTopRow, aBarCol[nHpos] SAY aBar[nHpos]
  399.       IF lShadow == NIL .OR. lShadow
  400.          FT_SHADOW( nTopRow+1, aBoxLoc[nHpos], LEN(aChoices[nHpos,1])+nTopRow+2, aBarWidth[nHpos]+3+aBoxLoc[nHpos] )
  401.       ENDIF
  402.       SETCOLOR( cBorder )
  403.       @  nTopRow+1, aBoxLoc[nHpos], LEN(aChoices[nHpos,1])+nTopRow+2, aBarWidth[nHpos]+3+aBoxLoc[nHpos] BOX "╔═╗║╝═╚║ "
  404.       SETCOLOR( cBox +","+ cCurrent +",,,"+ cUnselec )
  405.       nVpos := ACHOICE( nTopRow+2, aBoxLoc[nHpos]+2, LEN(aChoices[nHpos,1])+nTopRow+2, aBarWidth[nHpos]+1+aBoxLoc[nHpos], aChoices[nHpos,1], aChoices[nHpos,3], "__ftAcUdf", aLastSel[nHpos])
  406.       DO CASE
  407.       CASE LASTKEY() == RIGHTARROW .OR. LASTKEY() == TAB
  408.          IF( nHpos == LEN( aChoices ), nHpos := 1, nHpos := nHpos + 1 )
  409.       CASE LASTKEY() == LEFTARROW .OR. LASTKEY() == SHIFTTAB
  410.          IF( nHpos == 1, nHpos := LEN( aChoices ), nHpos := nHpos - 1 )
  411.       CASE LASTKEY() == ESCAPE
  412.          lLooping := _ftBailOut( cBorder, cBox )
  413.       CASE LASTKEY() == HOME
  414.          nHpos := 1
  415.       CASE LASTKEY() == END
  416.          nHpos := LEN( aChoices )
  417.       CASE LASTKEY() == ENTER
  418.          aLastSel[nHpos] := nVpos
  419.          IF aChoices[nHpos,2,nVpos] != NIL
  420.             SETCANCEL( lCancMode )
  421.             ALTD( ENABLE )
  422.             lLooping := EVAL( aChoices[nHpos,2,nVpos] )
  423.             ALTD( DISABLE )
  424.             SETCANCEL( .f. )
  425.          ENDIF
  426.       CASE ASCAN( aBarKeys, LASTKEY() ) > 0
  427.          nHpos := ASCAN( aBarKeys, LASTKEY() )
  428.       ENDCASE
  429.    ENDDO
  430.    SETCANCEL( lCancMode )
  431.    AltD( ENABLE )
  432.    RESTORE SCREEN FROM sMainScrn
  433.    RETURN NIL
  434.  
  435. FUNCTION __ftAcUdf( nMode )
  436.    // ACHOICE() user function
  437.    LOCAL nRtnVal := RESUME
  438.    DO CASE
  439.    CASE nMode == HITTOP
  440.       KEYBOARD CHR( CTRLEND )
  441.    CASE nMode == HITBOTTOM
  442.       KEYBOARD CHR( CTRLHOME )
  443.    CASE nMode == KEYEXCEPT
  444.       IF UPPER( CHR( LASTKEY() ) ) $ aValidKeys[ nHpos ]
  445.          IF aChoices[ nHpos, 3, AT( UPPER(CHR(LASTKEY())), aValidKeys[ nHpos ] )]
  446.             KEYBOARD CHR( ENTER )
  447.             nRtnVal := NEXTITEM
  448.          ENDIF
  449.       ELSE
  450.          nRtnVal := MAKESELECT
  451.       ENDIF
  452.    ENDCASE
  453.    RETURN nRtnVal
  454.  
  455. STATIC FUNCTION _ftWidest( i, aChoices, aBarWidth )
  456.    AEVAL(aChoices[i,1],{|a,b| aBarWidth[i] := ;
  457.             MAX( aBarWidth[i],LEN(aChoices[i,1,b])) })
  458.    RETURN NIL
  459.  
  460. STATIC FUNCTION _ftLocat( i, aBarCol, aBarWidth, aBoxLoc, nMaxCol )
  461.    aBoxLoc[i] := IF( aBarCol[i] + aBarWidth[i] + 4 > nMaxCol + 1, ;
  462.                  nMaxCol - 3 - aBarWidth[i], aBarCol[i] )
  463.    RETURN NIL
  464.  
  465. STATIC FUNCTION _ftBailOut( cBorder, cBox )
  466.    LOCAL cOldColor, sOldScreen, nKeyPress, nOldCursor, nCenter
  467.    nOldCursor := SETCURSOR( SCNONE )
  468.    sOldScreen := SAVESCREEN(nMaxRow/2-1, 24, nMaxRow/2+2, 55)
  469.    cOldColor := SETCOLOR( cBorder )
  470.    FT_SHADOW( nMaxRow/2-1, 24, nMaxRow/2+2, 55 )
  471.    @ nMaxRow/2-1, 24, nMaxRow/2+2, 55 BOX "╔═╗║╝═╚║ "
  472.    SETCOLOR( cBox )
  473.    @ nMaxRow/2,  26 SAY "Press ESCape To Confirm Exit"
  474.    @ nMaxRow/2+1,27 SAY "Or Any Other Key To Resume"
  475.    nKeyPress := INKEY(0)
  476.    SETCOLOR( cOldColor )
  477.    RESTSCREEN(nMaxRow/2-1, 24, nMaxRow/2+2, 55,sOldScreen )
  478.    SETCURSOR( nOldCursor )
  479.    RETURN !(nKeyPress == ESCAPE)
  480.  
  481. STATIC FUNCTION _ftValKeys( nNum,aChoices,aValidkeys )
  482.    AEVAL( aChoices[nNum,1], {|x| aValidKeys[nNum] += LEFT( x, 1)} )
  483.    RETURN NIL
  484.  
  485. /*  $DOC$
  486.  *  $FUNCNAME$
  487.  *     FT_FILL()
  488.  *  $CATEGORY$
  489.  *     Menus/Prompts
  490.  *  $ONELINER$
  491.  *     Declare menu options for FT_MENU1()
  492.  *  $SYNTAX$
  493.  *     FT_FILL( <aSubArrayName>, <cMenuSelection>, <bFunction>,
  494.  *              <lSelectable> ) -> NIL
  495.  *  $ARGUMENTS$
  496.  *     <aSubArrayName> is a sub-array of <acOptions> in FT_MENU1()
  497.  *     denoting the group in which to include the selection -- 
  498.  *     e.g., acOptions[1]
  499.  *
  500.  *     <cMenuSelection> is the character string that will appear on
  501.  *     the menu.
  502.  *
  503.  *     <bFunction> is the code block to be executed when that menu
  504.  *     option is selected.  i.e. {|| MyFunction() } would execute
  505.  *     the function called MyFunction().  {|| .f.} would exit the
  506.  *     FT_MENU1 and return to the calling routine.   {|| .T.} would
  507.  *     do nothing.
  508.  *
  509.  *     <lSelectable> is a logical variable that determines whether
  510.  *     the corresponding menu option is selectable or not.
  511.  *  $RETURNS$
  512.  *     NIL
  513.  *  $DESCRIPTION$
  514.  *     FT_FILL() is a function used to set up the menu options prior
  515.  *     to calling FT_MENU1().
  516.  *  $EXAMPLES$
  517.  *  FT_FILL( aOptions[1], 'A. Execute A Dummy Procedure' , {|| fubar()}, .t. )
  518.  *
  519.  *  The above would be added to the sub-menu associated with the first menu
  520.  *  bar item, would execute the function FUBAR() when that option was
  521.  *  selected, and would be selectable.
  522.  *
  523.  *
  524.  *  FT_FILL( aOptions[3], 'B. Enter Daily Charges'       , {|| .t.},     .f. )
  525.  *
  526.  *  The above would be added to the sub-menu associated with the third menu
  527.  *  bar item, and would be unselectable.
  528.  *
  529.  *
  530.  *  FT_FILL( aOptions[2], 'C. Enter Payments On Accounts', {|| .t.},     .t. )
  531.  *
  532.  *  The above would be added to the sub-menu associated with the second menu
  533.  *  bar item, and would be selectable, but would do nothing when selected.
  534.  *
  535.  *
  536.  *  FT_FILL( aOptions[4], 'C. Exit'                      , {|| .f.},     .t. )
  537.  *
  538.  *  The above would be added to the sub-menu associated with the fourth menu
  539.  *  bar item, and would be selectable, and would exit FT_MENU1() when chosen.
  540.  *  $SEEALSO$
  541.  *     FT_MENU1()
  542.  *  $END$
  543.  */
  544.  
  545. FUNCTION FT_FILL( aArray, cMenuOption, bBlock, lAvailable )
  546.    AADD( aArray[1], cMenuOption )
  547.    AADD( aArray[2], bBlock )
  548.    AADD( aArray[3], lAvailable )
  549.    RETURN NIL
  550.  
  551. 
  552.