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