home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / clipper / rlib / demo.prg < prev    next >
Encoding:
Text File  |  1989-02-18  |  32.3 KB  |  898 lines
  1. * Program.: DEMO.PRG
  2. * Author..: Richard Low
  3. * Date....: October 6, 1988
  4. * Notes...: Program to demonstrate the RLIB functions.
  5. *
  6.  
  7. PARAMETER edit
  8.  
  9. *-- the command line argument "EDIT" will allow mods to memo fields
  10. *-- (I used this flag to build the descriptions )
  11. edit = IF( PCOUNT() = 1, ( UPPER(edit) = 'EDIT' ), .F. )
  12.  
  13. IF .NOT. FILES('demo.dbf', 'demo.dbt')
  14.    ? 'This demo requires the database file DEMO.DBF and its associated memo'
  15.    ? 'file DEMO.DBT which are included in the RLIB package.  Please place'
  16.    ? 'these two files in the current default directory and try again.'
  17.    ? CHR(7)
  18.    RETURN
  19. ENDIF
  20.  
  21. SET PROCEDURE TO demoproc
  22. SAVE SCREEN TO dosscreen
  23. saverow = ROW()
  24. savecol = COL()
  25.  
  26. SET COLOR TO W/N
  27. CLEAR
  28. @ 3,0
  29.  
  30. TEXT
  31.    Welcome to the RLIB demonstration program.  The purpose of this demo is to
  32.    show what RLIB functions can do.  It can also serve as a supplement to the
  33.    documentation by providing examples of RLIB functions in use.
  34.  
  35.    The demo starts by presenting you with a menu of RLIB function categories.
  36.    Each of these categories presents a sub - menu with the available choices.
  37.    The starting menu is a BOXMENU, but you may change the style of menus used
  38.    for the demonstration at any time.   Simply select from the  Menuing Tools
  39.    menu the style of menu you want, and the demo will continue, but under the
  40.    style of menu you have chosen.
  41.  
  42. ENDTEXT
  43.  
  44. @ 1,0,18,79 BOX '┌─┐│┘─└│'
  45.  
  46. *-- first need to initialize all public variables and arrays
  47. DO initialize
  48.  
  49. CENTER( 16, 'Press any key to begin...' )
  50.  
  51. x = INKEY(30)
  52. DO WHILE x = 0
  53.    x = ASC(BOXASK('N/W','The demo will start as soon as you press a key',4))
  54.    x = IF( x = 0, INKEY(10), x )
  55. ENDDO
  56.  
  57. CLEAR
  58.  
  59. IF LASTKEY() = 27
  60.    RETURN
  61. ENDIF
  62.  
  63. SET CURSOR OFF
  64.  
  65. *-- Each active menu routine may control the whole demo.  If the user
  66. *-- selectes a different menu control, the current routine will set
  67. *-- <menustyle> accordingly and exit back to this main loop.  The
  68. *-- Summer '87 BEGIN SEQUENCE facility is used to allow conditional
  69. *-- branching back to this main routine from within the other procs.
  70.  
  71. PUBLIC menustyle, showtime, dummy, single, double
  72.  
  73. menustyle = 2                      && start off with BOXMENU
  74. showtime  = 2                      && seconds to pause while showing syntax
  75. dummy     = ''                     && global DUMMY parameter
  76. single    = '┌─┐│┘─└│'             && used for single line boxes
  77. double    = '╔═╗║╝═╚║'             && used for double line boxes
  78.  
  79.  
  80. *-- open the demo database so quickley retrieve syntax descriptions
  81. USE demo INDEX demo
  82.  
  83.  
  84. *-- each routine will set menustyle to 0 to quit
  85. DO WHILE menustyle > 0
  86.    BEGIN SEQUENCE
  87.       DO CASE
  88.          CASE menustyle = 1
  89.             DO bardemo
  90.  
  91.          CASE menustyle = 2
  92.             DO boxdemo
  93.  
  94.          CASE menustyle = 3
  95.             DO multdemo
  96.  
  97.          CASE menustyle = 4
  98.             DO pulldemo
  99.       ENDCASE
  100.    END
  101. ENDDO
  102.  
  103. RESTORE SCREEN FROM dosscreen
  104. @ saverow,savecol SAY ''
  105. CLOSE DATABASES
  106. SET CURSOR ON
  107. SET COLOR TO
  108. CLEAR ALL
  109. RETURN
  110.  
  111. *-- End of main program.
  112.  
  113.  
  114.  
  115. *----------------------------------------------------------------------------
  116. * Procedure: INITIALIZE
  117. * Notes....: Procedure to initialize demo procedure names into a PUBLIC
  118. *            array to be later referenced via the DIM2() UDF.
  119. *            These demo procedures are called via macro substitution at
  120. *            run time by first retrieving the name of the demo procedure
  121. *            to run from the combination of menu options chosen.  These
  122. *            options pair correspond to the DIM2 location of the procedure
  123. *            name in the <demos> array, which, thanks to the DIM@() UDF,
  124. *            looks and acts like a two dimensional array.
  125. *----------------------------------------------------------------------------
  126. PROCEDURE initialize
  127.  
  128. *-- set color variables and arrays for the demo
  129. PUBLIC democolor, syntaxcolor, background
  130.  
  131. IF ISCOLOR()
  132.    PUBLIC boxcolors[5], barcolors[5], pullcolors[6], multicolors[5]
  133.  
  134.    democolor   = 'W/B,N/W,N,N,N/BG'
  135.    syntaxcolor = 'N/BG,W/B,N,N,N/B'
  136.    background  = 'W/N,N/W,N,N,N/W'
  137.  
  138.    boxcolors[1] = 'W/B'                 && White on Blue display
  139.    boxcolors[2] = 'N/BG'                && Black on Cyan menu bar
  140.    boxcolors[3] = 'BG+/B'               && Bright Cyan on Blue Active Border
  141.    boxcolors[4] = 'BG/B'                && Regular Cyan on Blue In-active Border
  142.    boxcolors[5] = 'GR+/B'               && Yellow on Blue for the selected option
  143.  
  144.    barcolors[1] = 'W/B'                 && White on Blue display
  145.    barcolors[2] = 'N/BG'                && Black on Cyan menu bar
  146.    barcolors[3] = 'BG+/B'               && Bright Cyan on Blue Active Border
  147.    barcolors[4] = 'BG/B'                && Regular Cyan on Blue In-active Border
  148.    barcolors[5] = 'GR+/B'               && Yellow on Blue for the selected option
  149.  
  150.    pullcolors[1] = 'W/B'                 && White on Blue display
  151.    pullcolors[2] = 'N/BG'                && Black on Cyan menu bar
  152.    pullcolors[3] = 'BG+/B'               && Bright Cyan on Blue Active Border
  153.    pullcolors[4] = 'BG/B'                && Regular Cyan on Blue In-active Border
  154.    pullcolors[5] = 'GR+/B'               && Yellow on Blue for the selected option
  155.    pullcolors[6] = 'GR+/B'
  156.  
  157.    multicolors[1] = 'W/B'                 && White on Blue display
  158.    multicolors[2] = 'N/BG'                && Black on Cyan menu bar
  159.    multicolors[3] = 'BG+/B'               && Bright Cyan on Blue Active Border
  160.    multicolors[4] = 'BG/B'                && Regular Cyan on Blue In-active Border
  161.    multicolors[5] = 'GR+/B'               && Yellow on Blue for the selected option
  162. ELSE
  163.    PUBLIC boxcolors, barcolors, pullcolors
  164.  
  165.    democolor   = 'W/N,N/W,N,N,U'
  166.    syntaxcolor = 'N/W,W/N,N,N,U'
  167.    background  = 'W/N,N/W,N,N,U'
  168.    STORE '' TO boxcolors, barcolors, pullcolors
  169.  
  170.    PUBLIC multicolors[5]
  171.    multicolors[1] = 'W/N'                 && White on Black display
  172.    multicolors[2] = 'N/W'                 && Black on White menu bar
  173.    multicolors[3] = ' '
  174.    multicolors[4] = ' '
  175.    multicolors[5] = 'W+/N'               && Bright White for selected option
  176. ENDIF
  177.  
  178. PUBLIC rows, cols                  && this is required by the DIM2() UDF
  179. rows = 6                           && six groups of functions
  180. cols = 7                           && maximum number in each group
  181.  
  182. PUBLIC demos[ rows * cols ]
  183.  
  184. demos[ DIM2(1,1) ] = 'd'
  185. demos[ DIM2(1,2) ] = 'd'
  186. demos[ DIM2(1,3) ] = 'd'
  187. demos[ DIM2(1,4) ] = 'd'
  188.  
  189. demos[ DIM2(2,1) ] = 'd_atinsay'             && Screen functions
  190. demos[ DIM2(2,2) ] = 'd_boxask'
  191. demos[ DIM2(2,3) ] = 'd_bright'
  192. demos[ DIM2(2,4) ] = 'd_center'
  193. demos[ DIM2(2,5) ] = 'd_multimenu'
  194. demos[ DIM2(2,6) ] = 'd_sayinbox'
  195.  
  196. demos[ DIM2(3,1) ] = 'd_filedate'            && File functions
  197. demos[ DIM2(3,2) ] = 'd_files'
  198. demos[ DIM2(3,3) ] = 'd_filetime'
  199. demos[ DIM2(3,4) ] = 'd_parent'
  200. demos[ DIM2(3,5) ] = 'd_pathto'
  201. demos[ DIM2(3,6) ] = 'd_pickfile'
  202.  
  203. demos[ DIM2(4,1) ] = 'd_decrypted'           && Character
  204. demos[ DIM2(4,2) ] = 'd_encrypted'
  205. demos[ DIM2(4,3) ] = 'd_getparm'
  206. demos[ DIM2(4,4) ] = 'd_keyinput'
  207. demos[ DIM2(4,5) ] = 'd_namesplit'
  208. demos[ DIM2(4,6) ] = 'd_rjustify'
  209.  
  210. demos[ DIM2(5,1) ] = 'd_changed'             && Database
  211. demos[ DIM2(5,2) ] = 'd_closearea'
  212. demos[ DIM2(5,3) ] = 'd_forget'
  213. demos[ DIM2(5,4) ] = 'd_markrec'
  214. demos[ DIM2(5,5) ] = 'd_memorize'
  215. demos[ DIM2(5,6) ] = 'd_mreplace'
  216. demos[ DIM2(5,7) ] = 'd_pickrec'
  217.  
  218. demos[ DIM2(6,1) ] = 'd_alphadate'           && Other
  219. demos[ DIM2(6,2) ] = 'd_beep'
  220. demos[ DIM2(6,3) ] = 'd_ntxkeyval'
  221. demos[ DIM2(6,4) ] = 'd_str2date'
  222.  
  223. USE demo
  224. INDEX ON udf_name TO demo
  225. USE
  226. RETURN
  227.  
  228.  
  229. *----------------------------------------------------------------------------
  230. * Function: DIM2
  231. * Notes...: UDF to emulate 2 dimensional arrays.
  232. *----------------------------------------------------------------------------
  233. FUNCTION dim2
  234. PARAMETERS x,y
  235. RETURN (((x - 1) * cols) + y)
  236.  
  237.  
  238.  
  239. *----------------------------------------------------------------------------
  240. * Procedure: BOXDEMO
  241. * Notes....: Sub procedure to control demo with BOXMENU(), default.
  242. * Assumes..: Nothing.
  243. *----------------------------------------------------------------------------
  244. PROCEDURE BoxDemo
  245.  
  246. *-- set up arrays to hold menu options and messages
  247. DECLARE option[7], message[7]
  248.  
  249. *-- they don't have to be the same length, just a matter of preference
  250. option[1] = ' 1.  Menuing Tools      '
  251. option[2] = ' 2.  Screen Utilities   '
  252. option[3] = ' 3.  File Functions     '
  253. option[4] = ' 4.  Character Handling '
  254. option[5] = ' 5.  Database Functions '
  255. option[6] = ' 6.  Other Functions    '
  256. option[7] = ' 7.  Quit to DOS        '
  257.  
  258. message[1] = 'Menus never were easier and more powerful!'
  259. message[2] = 'Helpful goodies for prompting and error messages'
  260. message[3] = 'Find files, get file dates and times, and other stuff'
  261. message[4] = 'Handy character string functions, all in Clipper!'
  262. message[5] = 'Make editing database files easy'
  263. message[6] = "A few UDF's to use either now and then, or all the time"
  264. message[7] = 'Before you quit, try all the neat menus'
  265.  
  266. *-- 1234567 will automatically select the choice, add 'MDFSDOQ'
  267. altkeys   = 'MSFCDOQ'
  268. topchoice = 1
  269. toprow    = 3
  270. topcol    = CENTER(option[1])        && put BOXMENU in center of screen
  271. promptrow = 24                       && menu prompts on bottom line
  272.  
  273. CLEAR
  274. DO WHILE .T.
  275.    topchoice = BOXMENU( toprow, topcol, option, topchoice, altkeys,;
  276.                         dummy, message, promptrow, boxcolors )
  277.    DO CASE
  278.       CASE topchoice = 0
  279.          topchoice = 7
  280.  
  281.       CASE topchoice = 7
  282.          menustyle = 0                     && force calling proc to terminate
  283.          BREAK
  284.  
  285.       OTHERWISE
  286.          *-- make the sub-menu one row below the selected option
  287.          nextrow = toprow + topchoice + 1
  288.  
  289.          DO SubBoxMenu WITH topchoice, nextrow
  290.  
  291.    ENDCASE
  292. ENDDO
  293. RETURN
  294.  
  295.  
  296. *----------------------------------------------------------------------------
  297. * Procedure: SubBoxMenu
  298. * Notes....: Sub procedure to control demo with BOXMENU(), default.
  299. * Assumes..: Nothing.
  300. *----------------------------------------------------------------------------
  301. PROCEDURE SubBoxMenu
  302. PARAMETER group, row
  303. PRIVATE choice, col, brow, bcol, window
  304.  
  305. DO CASE
  306.    CASE group = 1                                          && Menu
  307.       DECLARE rlib[3], mess[3]
  308.       rlib[1] = '  1.  BARMENU()    '
  309.       rlib[2] = '  2.  MULTIMENU()  '
  310.       rlib[3] = '  3.  PDOWNMENU()  '
  311.       mess[1] = 'Change style of menus used for this demo to Bar Menu style'
  312.       mess[2] = 'Demonstration of the multi column menuing function'
  313.       mess[3] = 'Change style of menus used for this demo to Pull Down Menu style'
  314.  
  315.    CASE group = 2                                          && Screen
  316.       DECLARE rlib[6], mess[6]
  317.       rlib[1] = '  1.  ATINSAY()   '
  318.       rlib[2] = '  2.  BOXASK()    '
  319.       rlib[3] = '  3.  BRIGHT()    '
  320.       rlib[4] = '  4.  CENTER()    '
  321.       rlib[5] = '  5.  MULTIMENU() '
  322.       rlib[6] = '  6.  SAYINBOX()  '
  323.       mess[1] = 'Display a string at a given screen coordinate in color provided'
  324.       mess[2] = 'Pop-up dialogue box in screen center to get user response'
  325.       mess[3] = 'Get the bright version of the current, or provided screen color'
  326.       mess[4] = 'Calculate column position to center a string, with optional display'
  327.       mess[5] = 'Another demonstration of the MULTIMENU function.  Try it!'
  328.       mess[6] = 'Easily display messages in screen centered pop-up boxes'
  329.  
  330.    CASE group = 3                                          && File
  331.       DECLARE rlib[6], mess[6]
  332.       rlib[1] = '  1.  FILEDATE()  '
  333.       rlib[2] = '  2.  FILES()     '
  334.       rlib[3] = '  3.  FILETIME()  '
  335.       rlib[4] = '  4.  PARENT()    '
  336.       rlib[5] = '  5.  PATHTO()    '
  337.       rlib[6] = '  6.  PICKFILE()  '
  338.       mess[1] = 'Get the last update date for a file'
  339.       mess[2] = 'Test for existance of multiple files at one time'
  340.       mess[3] = 'Get the last update time for a file'
  341.       mess[4] = 'Get the parent directory name for the current or indicated directory'
  342.       mess[5] = 'Search the DOS path for the path leading to the indicated file'
  343.       mess[6] = 'Pop-up a file directory listing from which to select a filename'
  344.  
  345.    CASE group = 4                                          && Character
  346.       DECLARE rlib[6], mess[6]
  347.       rlib[1] = '  1.  DECRYPTED()  '
  348.       rlib[2] = '  2.  ENCRYPTED()  '
  349.       rlib[3] = '  3.  GETPARM()    '
  350.       rlib[4] = '  4.  KEYINPUT()   '
  351.       rlib[5] = '  5.  NAMESPLIT()  '
  352.       rlib[6] = '  6.  RJUSTIFY()   '
  353.       mess[1] = 'Decrypt a character string encrypted with ENCRYPT()'
  354.       mess[2] = 'Encrypt a character string to make it un-readable'
  355.       mess[3] = 'Retrieve a comma delimited parameter from a character string'
  356.       mess[4] = 'Get keyboard input while echoing dots on screen'
  357.       mess[5] = 'Convert names in a Firstname Lastname format to Lastname first'
  358.       mess[6] = 'Right justify character strings by moving trailing blanks to the front'
  359.  
  360.    CASE group = 5                                          && Database
  361.       DECLARE rlib[7], mess[7]
  362.       rlib[1] = '  1.  CHANGED()   '
  363.       rlib[2] = '  2.  CLOSEAREA() '
  364.       rlib[3] = '  3.  FORGET()    '
  365.       rlib[4] = '  4.  MARKREC()   '
  366.       rlib[5] = '  5.  MEMORIZE()  '
  367.       rlib[6] = '  6.  MREPLACE()  '
  368.       rlib[7] = '  7.  PICKREC()   '
  369.       mess[1] = 'Check if any changes made to database fields being edited'
  370.       mess[2] = 'Close more that one database file at a time'
  371.       mess[3] = 'Release edit variables created with the MEMORIZE() function'
  372.       mess[4] = 'Select multiple database records for processing'
  373.       mess[5] = 'Save all fields to variables for editing'
  374.       mess[6] = 'Replace database fields with edited field variables created with MEMORIZE()'
  375.       mess[7] = 'Versatile method of selecting a database record to work with'
  376.  
  377.    CASE group = 6                                          && Other
  378.       DECLARE rlib[4], mess[4]
  379.       rlib[1] = '  1.  ALPHADATE() '
  380.       rlib[2] = '  2.  BEEP()      '
  381.       rlib[3] = '  3.  NTXKEYVAL() '
  382.       rlib[4] = '  4.  STR2DATE()  '
  383.       mess[1] = 'Easily print the supplied date in spelled out format'
  384.       mess[2] = 'Ring the system bell any specified number of times'
  385.       mess[3] = 'Get the index key value of the current record'
  386.       mess[4] = 'Convert date strings to date type variables'
  387.  
  388. ENDCASE
  389.  
  390. choice = 1                                      && start at first option
  391. col    = CENTER(rlib[1])                        && center in middle of screen
  392. brow   = row + LEN(rlib) + 1                    && calculate bottom row
  393. bcol   = col + LEN(rlib[1]) + 1                 && calculate bottom right col
  394. window = SAVESCREEN(row, col, brow, bcol)       && save screen underneath
  395.  
  396. DO WHILE choice > 0                             && BOXMENU returns 0 on Escape
  397.  
  398.    choice = BOXMENU( row, col, rlib, choice, dummy, dummy,;
  399.                      mess, promptrow, boxcolors )
  400.  
  401.    IF choice = 0
  402.       *-- if Escape pressed, exit to top menu
  403.       EXIT
  404.    ELSEIF group = 1
  405.       *-- if in the Menu group, calculate menustyle number
  406.       menustyle = IF( choice = 1, 1, choice + 1 )
  407.       *-- must retore screen here as the BREAK bypasses the one below
  408.       RESTSCREEN(row, col, brow, bcol, window )
  409.       BREAK
  410.    ENDIF
  411.  
  412.    *-- otherwise, get the demo procedure name from the DIM2() array
  413.    *-- based on the GROUP, CHOICE combination.
  414.  
  415.    demoproc = demos[ DIM2(group,choice) ]
  416.    SAVE SCREEN
  417.    SET COLOR TO (democolor)
  418.    DO ShowSyntax
  419.    DO &demoproc
  420.    SET COLOR TO
  421.    RESTORE SCREEN
  422.  
  423. ENDDO
  424. RESTSCREEN(row, col, brow, bcol, window )        && restore screen underneath
  425. RETURN
  426.  
  427.  
  428. *----------------------------------------------------------------------------
  429. * Procedure: BARDEMO
  430. * Notes....: Sub procedure to control demo with BARMENU(), default.
  431. * Assumes..: Nothing.
  432. *----------------------------------------------------------------------------
  433. PROCEDURE BarDemo
  434.  
  435. *-- set up arrays to hold menu options and messages
  436. DECLARE option[7], message[7]
  437.  
  438. *-- they don't have to be the same length, just a matter of preference
  439. option[1] = 'Menu '
  440. option[2] = 'Screen '
  441. option[3] = 'File '
  442. option[4] = 'Character '
  443. option[5] = 'Database '
  444. option[6] = 'Other '
  445. option[7] = 'Quit '
  446.  
  447. message[1] = 'Box Menus, Multi-Column Menus, and Pull Down menus'
  448. message[2] = 'Screen goodies for prompts and error messages'
  449. message[3] = 'Find files, get file dates and times, and other stuff'
  450. message[4] = 'Handy character string functions, all in Clipper!'
  451. message[5] = 'Make editing database files easy'
  452. message[6] = "A few UDF's to use either now and then, or all the time"
  453. message[7] = 'Before you quit, try all the neat menus'
  454.  
  455. toprow    = 1
  456. promptrow = 2
  457. topchoice = 1
  458.  
  459. CLEAR
  460. DO WHILE .T.
  461.    topchoice = BARMENU( toprow, option, dummy, topchoice, dummy,;
  462.                         dummy, message, promptrow, barcolors )
  463.    DO CASE
  464.       CASE topchoice = 0
  465.          topchoice = 7
  466.  
  467.       CASE topchoice = 7
  468.          menustyle = 0                     && force calling proc to terminate
  469.          BREAK
  470.  
  471.       OTHERWISE
  472.          *-- make the sub-menu one row below the selected option
  473.          nextrow = toprow + topchoice + 1
  474.  
  475.          DO SubBarMenu WITH topchoice
  476.    ENDCASE
  477. ENDDO
  478. RETURN
  479.  
  480.  
  481.  
  482. *----------------------------------------------------------------------------
  483. * Procedure: SubBarMenu
  484. * Notes....: Sub procedure to control demo with BARMENU().
  485. * Assumes..: Nothing.
  486. *----------------------------------------------------------------------------
  487. PROCEDURE SubBarMenu
  488. PARAMETER group
  489. PRIVATE choice
  490.  
  491. DO CASE
  492.    CASE group = 1                                          && Menu
  493.       DECLARE rlib[3], mess[3]
  494.       rlib[1] = 'BOXMENU()'
  495.       rlib[2] = 'MULTIMENU()'
  496.       rlib[3] = 'PDOWNMENU()'
  497.       mess[1] = 'Change style of menus used for this demo to Bar Menu style'
  498.       mess[2] = 'Demonstration of the multi column menuing function'
  499.       mess[3] = 'Change style of menus used for this demo to Pull Down Menu style'
  500.  
  501.    CASE group = 2                                          && Screen
  502.       DECLARE rlib[6], mess[6]
  503.       rlib[1] = 'ATINSAY()'
  504.       rlib[2] = 'BOXASK()'
  505.       rlib[3] = 'BRIGHT()'
  506.       rlib[4] = 'CENTER()'
  507.       rlib[5] = 'MULTIMENU()'
  508.       rlib[6] = 'SAYINBOX()'
  509.       mess[1] = 'Display a string at a given screen coordinate in color provided'
  510.       mess[2] = 'Pop-up dialogue box in screen center to get user response'
  511.       mess[3] = 'Get the bright version of the current, or provided screen color'
  512.       mess[4] = 'Calculate column position to center a string, with optional display'
  513.       mess[5] = 'Another demonstration of the MULTIMENU function.  Try it!'
  514.       mess[6] = 'Easily display messages in screen centered pop-up boxes'
  515.  
  516.    CASE group = 3                                          && File
  517.       DECLARE rlib[6], mess[6]
  518.       rlib[1] = 'FILEDATE()'
  519.       rlib[2] = 'FILES()'
  520.       rlib[3] = 'FILETIME()'
  521.       rlib[4] = 'PARENT()'
  522.       rlib[5] = 'PATHTO()'
  523.       rlib[6] = 'PICKFILE()'
  524.       mess[1] = 'Get the last update date for a file'
  525.       mess[2] = 'Test for existance of multiple files at one time'
  526.       mess[3] = 'Get the last update time for a file'
  527.       mess[4] = 'Get the parent directory name for the current or indicated directory'
  528.       mess[5] = 'Search the DOS path for the path leading to the indicated file'
  529.       mess[6] = 'Pop-up a file directory listing from which to select a filename'
  530.  
  531.    CASE group = 4                                          && Character
  532.       DECLARE rlib[6], mess[6]
  533.       rlib[1] = 'DECRYPTED()'
  534.       rlib[2] = 'ENCRYPTED()'
  535.       rlib[3] = 'GETPARM()'
  536.       rlib[4] = 'KEYINPUT()'
  537.       rlib[5] = 'NAMESPLIT()'
  538.       rlib[6] = 'RJUSTIFY()'
  539.       mess[1] = 'Decrypt a character string encrypted with ENCRYPT()'
  540.       mess[2] = 'Encrypt a character string to make it un-readable'
  541.       mess[3] = 'Retrieve a comma delimited parameter from a character string'
  542.       mess[4] = 'Get keyboard input while echoing dots on screen'
  543.       mess[5] = 'Convert names in a Firstname Lastname format to Lastname first'
  544.       mess[6] = 'Right justify character strings by moving trailing blanks to the front'
  545.  
  546.    CASE group = 5                                          && Database
  547.       DECLARE rlib[7], mess[7]
  548.       rlib[1] = 'CHANGED()'
  549.       rlib[2] = 'CLOSEAREA()'
  550.       rlib[3] = 'FORGET()'
  551.       rlib[4] = 'MARKREC()'
  552.       rlib[5] = 'MEMORIZE()'
  553.       rlib[6] = 'MREPLACE()'
  554.       rlib[7] = 'PICKREC()'
  555.       mess[1] = 'Check if memory field variables changed from data on disk'
  556.       mess[2] = 'Close multiple database files with one command'
  557.       mess[3] = 'Release public memory variables created with MEMORIZE()'
  558.       mess[4] = 'Select multiple records to work with from a database'
  559.       mess[5] = 'Copy database fields to memory variables fro editing'
  560.       mess[6] = 'Save field memory variables back to a database record'
  561.       mess[7] = 'Select a record to work with from a menu of records'
  562.  
  563.    CASE group = 6                                          && Other
  564.       DECLARE rlib[4], mess[4]
  565.       rlib[1] = 'ALPHADATE()'
  566.       rlib[2] = 'BEEP()'
  567.       rlib[3] = 'NTXKEYVAL()'
  568.       rlib[4] = 'STR2DATE()'
  569.       mess[1] = 'Easily print the supplied date in spelled out format'
  570.       mess[2] = 'Ring the system bell any specified number of times'
  571.       mess[3] = 'Get the index key value of the current record'
  572.       mess[4] = 'Convert date strings to date type variables'
  573.  
  574. ENDCASE
  575.  
  576. choice = 1                                      && start at first option
  577.  
  578. DO WHILE choice > 0                             && BOXMENU returns 0 on Escape
  579.  
  580.    choice = BARMENU( toprow, rlib, dummy, choice, dummy, dummy,;
  581.                      mess, promptrow, barcolors )
  582.  
  583.    IF choice = 0
  584.       *-- if Escape pressed, exit to top menu
  585.       EXIT
  586.    ELSEIF group = 1
  587.       *-- if in the Menu group, calculate menustyle number
  588.       menustyle = choice + 1
  589.       BREAK
  590.    ENDIF
  591.  
  592.    *-- otherwise, get the demo procedure name from the DIM2() array
  593.    *-- based on the GROUP,CHOICE combination.
  594.  
  595.    demoproc = demos[ DIM2(group,choice) ]
  596.    SAVE SCREEN
  597.    SET COLOR TO (democolor)
  598.    DO ShowSyntax
  599.    DO &demoproc
  600.    SET COLOR TO
  601.    RESTORE SCREEN
  602.  
  603. ENDDO
  604. RETURN
  605.  
  606.  
  607. *----------------------------------------------------------------------------
  608. * Procedure: MULTDEMO
  609. * Notes....: Sub procedure to control demo with MULTIMENU()
  610. * Assumes..: Nothing.
  611. *----------------------------------------------------------------------------
  612. PROCEDURE MultDemo
  613.  
  614. PRIVATE choice, colums, incolor, nameof_udf
  615.  
  616. *-- set up arrays to hold options and messages
  617. DECLARE items[32], mess[32]
  618.  
  619. items[ 1] = ' ALPHADATE() '
  620. items[ 2] = ' ATINSAY()   '
  621. items[ 3] = ' BARMENU()   '
  622. items[ 4] = ' BEEP()      '
  623. items[ 5] = ' BOXASK()    '
  624. items[ 6] = ' BOXMENU()   '
  625. items[ 7] = ' BRIGHT()    '
  626. items[ 8] = ' CENTER()    '
  627. items[ 9] = ' CHANGED()   '
  628. items[10] = ' CLOSEAREA() '
  629. items[11] = ' DECRYPTED() '
  630. items[12] = ' ENCRYPTED() '
  631. items[13] = ' FILEDATE()  '
  632. items[14] = ' FILES()     '
  633. items[15] = ' FILETIME()  '
  634. items[16] = ' FORGET()    '
  635. items[17] = ' GETPARM()   '
  636. items[18] = ' KEYINPUT()  '
  637. items[19] = ' MARKREC()   '
  638. items[20] = ' MEMORIZE()  '
  639. items[21] = ' MREPLACE()  '
  640. items[22] = ' MULTIMENU() '
  641. items[23] = ' NAMESPLIT() '
  642. items[24] = ' NTXKEYVAL() '
  643. items[25] = ' PARENT()    '
  644. items[26] = ' PATHTO()    '
  645. items[27] = ' PDOWNMENU() '
  646. items[28] = ' PICKFILE()  '
  647. items[29] = ' PICKREC()   '
  648. items[30] = ' RJUSTIFY()  '
  649. items[31] = ' SAYINBOX()  '
  650. items[32] = ' STR2DATE()  '
  651.  
  652. mess[ 1] = 'Easily print a date in spelled out format'
  653. mess[ 2] = 'Display a string at a given screen coordinate in color provided'
  654. mess[ 3] = 'Change style of menus used for this demo to Bar Menu style'
  655. mess[ 4] = 'Ring the system bell any specified number of times'
  656. mess[ 5] = 'Pop-up dialogue box in screen center to get user response'
  657. mess[ 6] = 'Change style of menus used for this demo to Box Menu style'
  658. mess[ 7] = 'Get the bright version of the current, or provided screen color'
  659. mess[ 8] = 'Calculate column position to center a string, with optional display'
  660. mess[ 9] = 'Check if any changes made to database fields being edited'
  661. mess[10] = 'Close more that one database file at a time'
  662. mess[11] = 'Decrypt a character string encrypted with ENCRYPT()'
  663. mess[12] = 'Encrypt a character string to make it un-readable'
  664. mess[13] = 'Get the last update date for a file'
  665. mess[14] = 'Test for existance of multiple files at one time'
  666. mess[15] = 'Get the last update time for a file'
  667. mess[16] = 'Release edit variables created with the MEMORIZE() function'
  668. mess[17] = 'Retrieve a comma delimited parameter from a character string'
  669. mess[18] = 'Get keyboard input while echoing dots on screen'
  670. mess[19] = 'Select multiple database records for processing'
  671. mess[20] = 'Save all fields to variables for editing'
  672. mess[21] = 'Replace database fields with edited field variables created with MEMORIZE()'
  673. mess[22] = 'Another demonstration of the MULTIMENU function.  Try it!'
  674. mess[23] = 'Convert names in a Firstname Lastname format to Lastname first'
  675. mess[24] = 'Get the index key value of the current record'
  676. mess[25] = 'Get the parent directory name for the current or indicated directory'
  677. mess[26] = 'Search the DOS path for the path leading to the indicated file'
  678. mess[27] = 'Change style of menus used for this demo to Pull Down Menu style'
  679. mess[28] = 'Pop-up a file directory listing from which to select a filename'
  680. mess[29] = 'Versatile method of selecting a database record to work with'
  681. mess[30] = 'Right justify character strings by moving trailing blanks to the front'
  682. mess[31] = 'Easily display messages in screen centered pop-up boxes'
  683. mess[32] = 'Convert date strings to date type variables'
  684.  
  685. CLEAR
  686. arrows  = CHR(24) + CHR(25) + CHR(27) + CHR(26)
  687. columns = 6
  688. incolor = SETCOLOR(multicolors[1])
  689.  
  690. SCROLL(16,0,22,79,0)
  691. @ 16,0,22,79 BOX single
  692. @ 17,4 SAY 'MULTIMENU() lets you select menu options by cursoring up, down, left, or'
  693. @ 18,4 SAY 'right, without having to wade through levels of menus.    From this menu'
  694. @ 19,4 SAY 'you can directly select any of the  RLIB demonstration routines,  or you'
  695. @ 20,4 SAY 'change the style of menus by selecting either  BOXMENU(),  BARMENU() or,'
  696. @ 21,4 SAY 'PDOWNMENU().  Just pick the option you desire by pressing the &arrows keys.'
  697.  
  698. @ 1,0,9,79 BOX double
  699.  
  700. DO WHILE .T.
  701.    choice = MULTIMENU( 2,1,8,78, items, columns, mess, 24, multicolors )
  702.  
  703.    SETCOLOR(incolor)
  704.    DO CASE
  705.       CASE choice = 0
  706.          *-- Escape, go back to default, BOXMENU style
  707.          menustyle = 2
  708.          BREAK
  709.  
  710.       CASE choice = 3                  && BARMENU
  711.          menustyle = 1
  712.          BREAK
  713.  
  714.       CASE choice = 6                  && BOXMENU
  715.          menustyle = 2
  716.          BREAK
  717.  
  718.       CASE choice = 27                 && PDOWNMENU
  719.          menustyle = 4
  720.          BREAK
  721.  
  722.       OTHERWISE
  723.          *-- otherwise, get the demo procedure name from the DIM2() array
  724.          *-- based on the GROUP,CHOICE combination.
  725.  
  726.          *-- the name of the procedure to call is the name of this function
  727.          *-- minus the trailing "()", with "d_" added to the front
  728.          nameof_udf = LTRIM(SUBSTR(items[choice], 1, AT("(",items[choice])-1))
  729.          demoproc = 'd_' + nameof_udf
  730.          SAVE SCREEN
  731.          SET COLOR TO (democolor)
  732.          DO ShowSyntax
  733.          DO &demoproc
  734.          SET COLOR TO
  735.          RESTORE SCREEN
  736.    ENDCASE
  737. ENDDO
  738. RETURN
  739.  
  740.  
  741.  
  742. *----------------------------------------------------------------------------
  743. * Procedure: PULLDEMO
  744. * Notes....: Sub procedure to control demo with PDOWNMENU()
  745. * Assumes..: Nothing.
  746. *
  747. *----------------------------------------------------------------------------
  748. PROCEDURE PullDemo
  749.  
  750. DECLARE menus[7], column[7], starts[7]
  751.  
  752. menus[1] = ' Menu '
  753. menus[2] = ' Screen '
  754. menus[3] = ' File '
  755. menus[4] = ' Character '
  756. menus[5] = ' Database '
  757. menus[6] = ' Other '
  758. menus[7] = ' Quit '
  759.  
  760. column[1] =  0
  761. column[2] = 10
  762. column[3] = 23
  763. column[4] = 34
  764. column[5] = 49
  765. column[6] = 63
  766. column[7] = 74
  767.  
  768. *-- set up arrays to hold menu options and messages
  769. DECLARE item[34], mess[34]
  770.  
  771. starts[1] = 1
  772. item[1] = ' BARMENU()    '
  773. item[2] = ' BOXMENU()    '
  774. item[3] = ' MULTIMENU()  '
  775. mess[1] = 'Change style of menus used for this demo to Bar Menu style'
  776. mess[2] = 'Change style of menus used for this demo to Box Menu style'
  777. mess[3] = 'Change style of menus used for this demo to Multi-column Menu style'
  778.  
  779.  
  780. starts[2] = 4
  781. item[4] = ' ATINSAY()   '
  782. item[5] = ' BOXASK()    '
  783. item[6] = ' BRIGHT()    '
  784. item[7] = ' CENTER()    '
  785. item[8] = ' MULTIMENU() '
  786. item[9] = ' SAYINBOX()  '
  787. mess[4] = 'Display a string at a given screen coordinate in color provided'
  788. mess[5] = 'Pop-up dialogue box in screen center to get user response'
  789. mess[6] = 'Get the bright version of the current, or provided screen color'
  790. mess[7] = 'Calculate column position to center a string, with optional display'
  791. mess[8] = 'Another demonstration of the MULTIMENU function.  Try it!'
  792. mess[9] = 'Easily display messages in screen centered pop-up boxes'
  793.  
  794. starts[3] = 10
  795. item[10] = ' FILEDATE()  '
  796. item[11] = ' FILES()     '
  797. item[12] = ' FILETIME()  '
  798. item[13] = ' PARENT()    '
  799. item[14] = ' PATHTO()    '
  800. item[15] = ' PICKFILE()  '
  801. mess[10] = 'Get the last update date for a file'
  802. mess[11] = 'Test for existance of multiple files at one time'
  803. mess[12] = 'Get the last update time for a file'
  804. mess[13] = 'Get the parent directory name for the current or indicated directory'
  805. mess[14] = 'Search the DOS path for the path leading to the indicated file'
  806. mess[15] = 'Pop-up a file directory listing from which to select a filename'
  807.  
  808.  
  809. starts[4] = 16
  810. item[16] = ' DECRYPTED()  '
  811. item[17] = ' ENCRYPTED()  '
  812. item[18] = ' GETPARM()    '
  813. item[19] = ' KEYINPUT()   '
  814. item[20] = ' NAMESPLIT()  '
  815. item[21] = ' RJUSTIFY()   '
  816. mess[16] = 'Decrypt a character string encrypted with ENCRYPT()'
  817. mess[17] = 'Encrypt a character string to make it un-readable'
  818. mess[18] = 'Retrieve a comma delimited parameter from a character string'
  819. mess[19] = 'Get keyboard input while echoing dots on screen'
  820. mess[20] = 'Convert names in a Firstname Lastname format to Lastname first'
  821. mess[21] = 'Right justify character strings by moving trailing blanks to the front'
  822.  
  823.  
  824. starts[5] = 22
  825. item[22] = ' CHANGED()   '
  826. item[23] = ' CLOSEAREA() '
  827. item[24] = ' FORGET()    '
  828. item[25] = ' MARKREC()   '
  829. item[26] = ' MEMORIZE()  '
  830. item[27] = ' MREPLACE()  '
  831. item[28] = ' PICKREC()   '
  832. mess[22] = 'Check if any changes made to database fields being edited'
  833. mess[23] = 'Close more that one database file at a time'
  834. mess[24] = 'Release edit variables created with the MEMORIZE() function'
  835. mess[25] = 'Select multiple database records for processing'
  836. mess[26] = 'Save all fields to variables for editing'
  837. mess[27] = 'Replace database fields with edited field variables created with MEMORIZE()'
  838. mess[28] = 'Versatile method of selecting a database record to work with'
  839.  
  840.  
  841. starts[6] = 29
  842. item[29] = ' ALPHADATE() '
  843. item[30] = ' BEEP()      '
  844. item[31] = ' NTXKEYVAL() '
  845. item[32] = ' STR2DATE()  '
  846. mess[29] = 'Easily print a date in spelled out format'
  847. mess[30] = 'Ring the system bell any specified number of times'
  848. mess[31] = 'Get the index key value of the current record'
  849. mess[32] = 'Convert date strings to date type variables'
  850.  
  851. starts[7] = 33
  852. item[33] = 'No  '
  853. item[34] = 'Yes '
  854. mess[33] = 'Do not quit just yet, return to demostration'
  855. mess[34] = 'Quit and return to DOS'
  856.  
  857. *-- start with menu number one, no drop down
  858. menu   = 1
  859. choice = 0
  860. mrow   = 1
  861. prow   = 24
  862.  
  863. *-- clear the screen, or just make sure it is the way you want it
  864. *-- to appear underneath the pull-down menu boxes
  865. CLEAR
  866. PDOWNINIT( mrow, column, menus, item, starts, mess, prow, pullcolors )
  867.  
  868. DO WHILE .T.
  869.    PDOWNMENU( @menu, @choice, menus, item, column, starts, mess )
  870.  
  871.    DO CASE
  872.       CASE menu = 0
  873.  
  874.       CASE menu = 1
  875.          menustyle = choice
  876.          BREAK
  877.  
  878.       CASE menu = 7
  879.          IF choice = 2
  880.             menustyle = 0
  881.             BREAK
  882.          ENDIF
  883.  
  884.       OTHERWISE
  885.          *-- otherwise, get the demo procedure name from the DIM2() array
  886.          *-- based on the GROUP,CHOICE combination.
  887.  
  888.          demoproc = demos[ DIM2( menu, choice ) ]
  889.          SAVE SCREEN
  890.          SET COLOR TO (democolor)
  891.          DO ShowSyntax
  892.          DO &demoproc
  893.          SET COLOR TO
  894.          RESTORE SCREEN
  895.    ENDCASE
  896. ENDDO
  897. RETURN
  898.