home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / DEMO5.PRG < prev    next >
Encoding:
Text File  |  1991-07-25  |  20.9 KB  |  591 lines
  1. /*
  2.    Grumpfish Library 5.0 demo
  3.    Author: Greg Lief
  4.    Copyright (c) 1988-90, Greg Lief
  5.    Compile instructions: clipper demo /n/w/a
  6. */
  7.  
  8. #include "grump.ch"
  9. #include "grumpr.ch"
  10. #include "grumpm.ch"
  11. #include "inkey.ch"
  12.  
  13. #define PRIMARY_COLOR    "W/RB"
  14.  
  15. memvar getlist
  16.  
  17. //───── next two statics are used for highlighting info during GETSYS demo
  18. static ptr
  19. static verbiage_ := { ;
  20. [@ 15,0 gget y calculator picture '#####.##' message "Right-to-left entry"], ;
  21. [@ 16,0 gget team list teams message "Use spacebar or backspace to toggle"], ;
  22. [@ 17,0 gget w step color 'n/bg,+w/r' message "Use + and - keys"], ;
  23. [@ 18,0 gget pass1 message "Enter a password" password "?"], ;
  24. [@ 19,0 gget pass2 message "Enter a password" password], ;
  25. [@ 20,0 gget z proper message "This will be proper-case"], ;
  26. [@ 21,0 gget x array days picture '@!' message "Please pick a day!"] }
  27.  
  28. #command CLEARSCREEN [COLOR <color>]  => ;
  29.               dispbox(0, 0, maxrow(), maxcol(),  replicate(chr(250),9), <color>)
  30.  
  31. function main(skip_it)
  32. external soundex, helpdev
  33. local x, selected, maincolor, mfile := '!!!!!!!!.!!!', mrow, ;
  34.       mtone, any_key, msg := "The Grumpfish Library"
  35. setblink(.f.)
  36. colorinit('colors.gf')
  37. setcursor(0)
  38. set scoreboard off
  39. set wrap on
  40. SAVE_DRAPE(mfile)
  41. selected := 'i'
  42. if skip_it == NIL
  43.    setcolor('+W/N')
  44.    cls
  45.    Fallguy(03, 29, msg, 100)
  46.    SCRNCENTER(maxrow(), 'Press space bar for demo or Esc for DOS', '+BR/N')
  47.    rainbow(msg)
  48.    if lastkey () != K_ESC
  49.       lets_go()
  50.    ENDif
  51. else
  52.    lets_go()
  53. endif
  54. CLEARSCREEN COLOR "I"
  55. setcolor('W/BR')
  56. expbox(1, 6, 23, 73, 1, 30)
  57. setcolor('+W/BR')
  58. rollup("Grumpfish Library is written 99.9% in Clipper.  You get two")
  59. rollup("versions of the source code: one for Summer '87, and another")
  60. rollup("FULLY OPTIMIZED for Clipper 5.01. You also get a no-nonsense")
  61. rollup("royalty-free integration license, easy-to-read documentation,")
  62. rollup("one year free BBS technical support on the Grumpfish BBS (a")
  63. rollup("worldwide haven for Clipper expertise), and thirty days free")
  64. rollup("voice support.  Our '                   ' guarantee: if you are")
  65. rollup("not absolutely tickled pink by Grumpfish, return it within 30")
  66. rollup("days from your date of purchase for a full and courteous refund!")
  67. rollup('')
  68. rollup('Grumpfish Library is available for just $199 (shipping: $7.50')
  69. rollup("US/Canada, $20 overseas).  Order NOW by calling (503) 588-1815")
  70. rollup("or fax your order to (503) 588-1980.  MC/VISA/AMEX accepted.")
  71. rollup('')
  72. rollup(SPACE(20) + 'Grumpfish, Incorporated')
  73. rollup(SPACE(20) + 'Post Office Box 17761')
  74. rollup(SPACE(20) + 'Salem, Oregon 97305 USA')
  75. rollup('')
  76. rollup('')
  77. rollup("Tel 0268 590955         Tel 93 16 09 12         Tel 089 570 6031")
  78. rollup("Fax 0268 590005         Fax 93 88 08 90         Fax 089 570 7631")
  79. setcolor('+GR/BR')
  80. @ 4,8 SAY 'FULLY OPTIMIZED'
  81. @ 8,29 SAY 'No Grumpy Customers'
  82. @ 13,56 say "(503) 588-1815"
  83. @ 14,29 say "(503) 588-1980"
  84. @ 20,8 say "United Kingdom" color 'i'
  85. @ 20,37 say "France" color 'i'
  86. @ 20,60 say "Germany" color 'i'
  87. inkey(20)
  88. impbox(60)
  89. ferase('help.dbf')
  90. ferase('help.cfg')
  91. ferase('help.dbt')
  92. ferase('help.ntx')
  93. ferase('demo2.scr')
  94. ferase('demo3.scr')
  95. set color to
  96. any_key='fadeback.scr'
  97. if file(any_key)
  98.    fadein(any_key)
  99. else
  100.    blindopen(mfile)
  101. endif
  102. ferase(mfile)
  103. ferase('gftemp.dbf')
  104. setblink(.t.)
  105. devpos(maxrow(), 0)
  106. return nil
  107.  
  108.  
  109. function lets_go
  110. local xx, any_key, mfile, screens := {}, sel := 1, dumbo, mstate, thefiles, ;
  111.       mainmenu, buff, maincolor := if(Iscolor(), 'w/b', 'w/n'), mvar,   ;
  112.       menulist, getcolor, mdate, mnum, mpassword, mstring, mliststring, ;
  113.       mnum2
  114. local w, x, y, z, pass1, pass2, oldf1, team, teams
  115. static days := { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" }
  116. static lookup_ := { { "ABCD", "A Better Code Dollop" } , ;
  117.                     { "WXYZ", "Where's Xenia's Young Zoo?" } , ;
  118.                     { "GYRH", "Get Yer Red Hots" } , ;
  119.                     { "WITW", "What In The World!?" } , ;
  120.                     { "NOYH", "Newsprint On Your Hands" } , ;
  121.                     { "TMNB", "This Means Nothing, Bucko" } , ;
  122.                     { "YACA", "Yet Another Cryptic Acronym" } , ;
  123.                     { "DNGC", "Definitely No Grumpy Customers!" } , ;
  124.                     { "PTYF", "Please Tell Your Friends" } , ;
  125.                     { "TSFR", "This Space For Rent" } }
  126. CLEARSCREEN COLOR maincolor
  127. set message to 24
  128. set key K_F1 to helpdev
  129. Shadowbox(0,0,4,16,6,,,'w/r')
  130. @ 1,1 say 'Press F1 to' color '+w/r'
  131. @ 2,1 say 'make your own' color '+w/r'
  132. @ 3,1 say 'help screen!' color '+w/r'
  133. if ! file('demo.scr')
  134.    save_drape('demo.scr')
  135. endif
  136. /*
  137.    create phone database if it doesn't already exist - we will
  138.    need this for GrumpBrow(), POPNOTE, and SETFILT
  139. */
  140. if ! file('phone.dbf')
  141.    dbcreate("phone.dbf",    { {"FNAME",   "C", 15, 0} , ;
  142.                               {"LNAME",   "C", 15, 0} , ;
  143.                               {"PHONE_NO","C", 12, 0} , ;
  144.                               {"EXT",     "C",  4, 0} , ;
  145.                               {"COMPANY", "C", 20, 0} , ;
  146.                               {"ADDRESS", "C", 25, 0} , ;
  147.                               {"CITY",    "C", 15, 0} , ;
  148.                               {"STATE",   "C",  2, 0} , ;
  149.                               {"ZIP",     "C", 10, 0} , ;
  150.                               {"LONGDIST","L",  1, 0} } )
  151.    use phone
  152.    //----- add a dummy record, and I do mean DUMMY!
  153.    append blank
  154.    replace fname with "GREG", lname with "LIEF", phone_no with "503-588-1815", ;
  155.            company with "Grumpfish, Inc", address with "P. O. Box 17761", ;
  156.            city with "Salem", state with "OR", zip with "97305"
  157.    use
  158. endif
  159. if ! file('phone.ntx')
  160.    use phone
  161.    index on upper(phone->lname + phone->fname) to phone
  162.    use
  163. endif
  164. colorset(PRIMARY_COLOR)
  165. shadowbox(3, 31, 20, 48, 2)
  166. do while sel != 0 .and. sel != 16
  167.    /*
  168.       these @..PROMPTS and MENU TO are preprocessed into calls to the
  169.       Grumpfish LITE_MENU2() function, which permits highlighted and/or
  170.       alternate trigger letters, and different colors for each message!
  171.    */
  172.    @4,32 prompt "Calculator"    message "Pop-up calculator" messagecolor "+W/B"
  173.    @5,32 prompt "Spreadsheet"   message "Pop-up spreadsheet" ;
  174.                                 triggercolor "N/BG" messagecolor "+W/B"
  175.    @6,32 prompt "Notepad"         message "Pop-up notepad"  messagecolor "+W/B"
  176.    @7,32 prompt "Phone Directory" message "Magnetic rolodex" messagecolor "+W/B"
  177.    @8,32 prompt "Calendar/~Appts" message "Pop-up calendar" messagecolor "+W/B"
  178.    @9,32 prompt "Stop~Watch"      message "Pop-up stopwatch" messagecolor "+W/B"
  179.    @10,32 prompt "Filter Builder" message "User-definable filters"
  180.    @11,32 prompt "Grump~Browse()" message "DBF browser with a difference!" ;
  181.                                   triggercolor "N/BG" messagecolor "+W/RB"
  182.    @12,32 prompt "View PHONE.PRG" message "View code generated by GrumpBrow!" ;
  183.                                   messagecolor "+W/G"
  184.    @13,32 prompt "Grump's GETSYS" message "Explore the new Grumpfish GETs" ;
  185.                                   messagecolor "N/BG"
  186.    @14,32 prompt "Bo~x Tricks"    message "Exploding/imploding/etc." ;
  187.                                   messagecolor "W/R"
  188.    @15,32 prompt "String Tricks" message "Falling/spreading/teletype" ;
  189.                                   messagecolor "W/R"
  190.    @16,32 prompt "Screen Tric~ks" message "Peeling/folding/splitting" ;
  191.                                   messagecolor "W/R"
  192.    @17,32 prompt "User Feedback"  message "Many other useful functions"
  193.    @18,32 prompt "Color ~Management"
  194.    @19,32 prompt "Exit"
  195.    menu to sel initial sel event gfclock(,,'w/b') timeout 30
  196.    mainmenu := savescreen(0, 0, maxrow(), maxcol())
  197.    do case
  198.  
  199.    case sel == 1
  200.       popcalc()
  201.  
  202.    case sel == 2
  203.       CLEARSCREEN COLOR maincolor
  204.       colorset(C_MESSAGE)
  205.       expbox(0, 1, 8, maxcol() - 2, 1, 10, , "GrumpCalc()")
  206.       @ 1, 3 say 'GrumpCalc() is a full-featured miniature spreadsheet that you can pop up'
  207.       @ 2, 3 say 'within a numeric GET.  Press F1 from within the GET below to pop up the'
  208.       @ 3, 3 say 'spreadsheet.  Within the spreadsheet, do some calculations to derive a'
  209.       @ 4, 3 say 'value.  Then press ESC to return to the GET.  Your final value will be'
  210.       @ 5, 3 say 'pasted into the GET!'
  211.       @ 7, 3 say 'If you need help on active keys in the spreadsheet, press F1.'
  212.       w := 0
  213.       oldf1 := setkey(K_F1, { |p,l,v| grumpcalc(p, l, v) } )
  214.       colorset(maincolor)
  215.       @ 11, 10 say "This is a numeric GET - press F1" get w
  216.       setcursor(1)
  217.       read
  218.       setcursor(0)
  219.       setkey(K_F1, oldf1)
  220.       impbox(50)
  221.  
  222.    case sel == 3
  223.       use phone new
  224.       popnote()
  225.       use
  226.  
  227.    case sel == 4
  228.       CLEARSCREEN COLOR maincolor
  229.       popphone()
  230.  
  231.    case sel == 5
  232.       CLEARSCREEN COLOR "I"
  233.       popdate()
  234.  
  235.    case sel == 6
  236.       popstop()
  237.  
  238.    case sel == 7 .or. sel == 8
  239.       use phone index phone new
  240.       setcolor(maincolor)
  241.       if sel == 7
  242.          Setfilt()
  243.       else
  244.          CLEARSCREEN COLOR maincolor
  245.          colorset(C_MESSAGE)
  246.          exbox(0, 1, 8, maxcol() - 2, 6, 5, '', .t.)
  247.          @ 0, 2 say 'GrumpBrow is the last word in generic database browsers.  For starters, it'
  248.          @ 1, 2 say 'includes automatic add/edit/view/delete/QBE/search routines.  You determine'
  249.          @ 2, 2 say 'what you want the user to be able to do by passing the first letter of each'
  250.          @ 3, 2 say [option. In this example, the function call is "GRUMPBROW('AEDVQS')".]
  251.          @ 4, 2 say 'But the coup de grace is the integrated screen painter.  Press "P" from the'
  252.          @ 5, 2 say 'Browse window, and then mock up your data entry screen.  You can move'
  253.          @ 6, 2 say 'and delete fields, add static text, draw boxes, change colors.  (For a'
  254.          @ 7, 2 say 'complete list of commands, press F1 while in the screen painter.) When you'
  255.          @ 8, 2 say 'are satisfied, press Shift-F10 to generate fully-optimized 5.0 code!'
  256.          inkey(1)
  257.          grumpbrow('aedvqsp', 10, 0, maxrow(), maxcol())
  258.       endif
  259.       close data
  260.  
  261.    case sel= 9
  262.       if file( mfile := "phone.prg" )
  263.          Shadowbox(0, 0, maxrow(), maxcol(), 2, ;
  264.                    'Viewing GrumpBrow() code', , 'w/rb')
  265.          setcolor('+w/rb')
  266.          memoedit(memoread(mfile), 1, 1, maxrow() - 1, maxcol() - 1, .f.)
  267.       else
  268.          err_msg(mfile + ' not found -- visit the GrumpBrow() screen painter')
  269.       endif
  270.  
  271.    case sel == 10
  272.       CLEARSCREEN COLOR "N/BG"
  273.       colorset(C_MESSAGE)
  274.       expbox(0, 2, 9, 76, 1, 30, setcolor(), "Grumpfish GETSYS")
  275.       @ 1, 7 say "Here is the source code for the GETs at the bottom of the screen"
  276.       aeval(verbiage_, { | text | setpos(row()+1, 3), dispout(text) } )
  277.       ptr := 1         // pointer for highlighted verbiage lines
  278.       w := y := 0
  279.       x := space(10)
  280.       z := space(20)
  281.       team := space(9)
  282.       teams := "Orioles;Red Sox;Blue Jays;Indians;Tigers;Yankees"
  283.       pass1 := pass2 := space(12)
  284.       hilite_info(.t.)
  285.       @ 15, 0 gget y calculator when hilite_info() picture '#####.##' ;
  286.               message "Right-to-left entry"
  287.       @ 16, 0 gget team list teams when hilite_info() ;
  288.               message "Use spacebar or backspace to toggle team"
  289.       @ 17, 0 gget w step color 'n/bg,+w/r' when hilite_info() ;
  290.               message "Use + and - keys"
  291.       @ 18, 0 gget pass1 message "Enter a password" password "?" ;
  292.               when hilite_info()
  293.       @ 19, 0 gget pass2 message "Enter a password" password ;
  294.               when hilite_info()
  295.       @ 20, 0 gget z proper message "This will be proper-case" ;
  296.               when hilite_info() valid hilite_info( , .t.)
  297.       @ 21, 0 gget x array days picture '@!' noedit message "Please pick a day!"
  298.       setcursor(1)
  299.       read timeout 20 warning 10 exitevent blankscr3(-1)
  300.       setcursor(0)
  301.       waiton("Your passwords were '" + trim(pass1) + "' and '" + ;
  302.               trim(pass2) + "'")
  303.       inkey(2)
  304.       waitoff()
  305.       impbox(50)
  306.  
  307.    case sel == 11
  308.       any_key := 'Exploding Box'
  309.       setcolor(maincolor)
  310.       cls
  311.       Expbox(00, 00, 9, 36, 5, 20, '+w/rb', any_key)
  312.       inkey(1)
  313.       Expbox(15, 10, 23, 50, 1, 24, '+w/r', any_key+' 2')
  314.       inkey(1)
  315.       Expbox(07, 01, 16, 60, 2, 50, '+gr/n', any_key+' 3')
  316.       inkey(.4)
  317.       Expbox(12, 48, 22, 78, 3, 30, 'n/gr', any_key + ' 4')
  318.       inkey(.4)
  319.       Expbox(01, 30, 04, 78, 1, 75, '+w/g', 'Yet Another '+any_key)
  320.       inkey(2.5)
  321.       impbox(60)
  322.       inkey(.3)
  323.       impbox(60)
  324.       inkey(.3)
  325.       impbox(60)
  326.       inkey(.3)
  327.       impbox(60)
  328.       inkey(.3)
  329.       impbox(60)
  330.       inkey(1)
  331.       *** note the use of the return value and BYEBYEBOX()
  332.       setcolor('n/bg')
  333.       aadd(screens, Popbox(00, 00, 22, 40, 2, 18, .F., 'Pop-up Box 1'))
  334.       inkey(.35)
  335.       setcolor('+gr/n')
  336.       aadd(screens, Dropbox(00, 55, 18, 79, 1, 25, .F., 'Pull-down Box 1', .T.))
  337.       inkey(.35)
  338.       setcolor('n/gr')
  339.       aadd(screens, Popbox(03, 44, 20, 70, 5, 20, .F., 'Pop-up Box 2'))
  340.       inkey(.35)
  341.       setcolor('n/w')
  342.       aadd(screens, Dropbox(04, 38, 13, 60, 4, 25, .F., 'Pull-down Box 2'))
  343.       inkey(.35)
  344.       setcolor('+w/r')
  345.       aadd(screens, Popbox(12, 30, 23, 55, 2, 20, .F., 'Pop-up Box 3', .T.))
  346.       inkey(.35)
  347.       setcolor('+w/b')
  348.       aadd(screens, Popbox(03, 05, 20, 29, 2, 18, .F., 'Another Pop-up'))
  349.       inkey(.35)
  350.       setcolor('n/g')
  351.       aadd(screens, Dropbox(06, 28, 20, 66, 1, 12, .T., 'Another Pull-down Box'))
  352.       inkey(.35)
  353.       setcolor('n/r')
  354.       aadd(screens, Popbox(02, 15, 17, 45, 1, 10, .T., 'Pop-up Box w/ Crossbar', .T.))
  355.       inkey(.35)
  356.       aadd(screens, Shadowbox(09, 20, 14, 50, 2, 'Shadow Box', .T., '+w/rb'))
  357.       inkey(1)
  358.       FOR xx := 9 TO 1 STEP -1
  359.          ByeByeBox(screens[xx])
  360.          inkey(.12)
  361.       NEXT
  362.       asize(screens, 0)
  363.  
  364.    case sel == 12
  365.       setcolor(maincolor)
  366.       cls
  367.       setcolor('+w/bg')
  368.       Exbox(9, 07, 15, 71, 1, 5, '', .T., 'Silly Strings')
  369.       Spread('It is a snap to display character strings from the middle out',10,35)
  370.       Spread('as we are demonstrating here. You may also wish to use either',11,35)
  371.       Spread('of the two teletype functions, which continuously scroll your',12,35)
  372.       Spread('message across a specified row.   Perhaps you already saw the',13,35)
  373.       Spread('falling string trick, but in case you missed it,             ',14,35)
  374.       inkey(4)
  375.       FallGuy(14,58,'here it is!!')
  376.       setcolor(maincolor)
  377.       inkey(1)
  378.       tty(20, 'Copyright (C) 1988-90 Greg Lief', 35, 24)
  379.       tty2(maxrow(), 'Press any key to return to the main menu', 0, maincolor)
  380.  
  381.    case sel == 13
  382.       setcolor('W/N')
  383.       FOR xx := 1 TO 9
  384.          clrscr(xx)
  385.          inkey(.2)
  386.          if xx < 9
  387.             RESTSCREEN(0, 0, maxrow(), maxcol(), mainmenu)
  388.          ENDif
  389.          inkey(.2)
  390.       NEXT
  391.       inkey(1.5)
  392.       mfile := 'DEMO3.SCR'
  393.       PULL_DRAPE('demo.scr')
  394.       inkey(2)
  395.       cls
  396.       inkey(1)
  397.       BLINDOPEN('demo.scr')
  398.       HBLINDSAVE(mfile)
  399.       inkey(1)
  400.       BLINDCLOSE()
  401.       inkey(2)
  402.       HBLINDOPEN(mfile)
  403.       inkey(2)
  404.       HBLINDCLOS()
  405.       inkey(2)
  406.       if file("fadein.scr")
  407.          fadein("fadein.scr")
  408.          inkey(2)
  409.       endif
  410.       if file("fadeout.scr")
  411.          fadeout("fadeout.scr")
  412.          inkey(2)
  413.       endif
  414.       FOR xx := 0 TO maxrow()
  415.          @ xx, 0 say REPLICATE(CHR(xx), maxcol() + 1)
  416.       NEXT
  417.       dumbo := SAVESCREEN(0, 0, maxrow(), maxcol())
  418.       hscrnscrl('demo.scr')
  419.       inkey(.75)
  420.       RESTSCREEN(0, 0, maxrow(), maxcol(), dumbo)
  421.       inkey(.5)
  422.       hscrnscrl('demo.scr', 1)
  423.       inkey(.75)
  424.       RESTSCREEN(0, 0, maxrow(), maxcol(), dumbo)
  425.       inkey(.5)
  426.       vscrnscrl(mfile)
  427.       inkey(.75)
  428.       RESTSCREEN(0, 0, maxrow(), maxcol(), dumbo)
  429.       inkey(.5)
  430.       vscrnscrl(mfile, 1)
  431.       inkey(.75)
  432.  
  433.    case sel == 14
  434.       CLEARSCREEN COLOR maincolor
  435.       setcolor('+w/bg')
  436.       Expbox(9, 10, 15, 68, 1, 60, , 'User Feedback')
  437.       Spread('The Grumpfish Library includes many user feedback items.',10,20)
  438.       Spread('There are functions for yes/no prompts, printer status, ',11,20)
  439.       Spread('error messages, wait messages, index status graph, state',12,20)
  440.       Spread("validation, and a sleek ACHOICE() replacement.  We will ",13,20)
  441.       Spread("start out with the index graph function, IndexBar().... ",14,20)
  442.       inkey(5)
  443.       ImpBox(60)
  444.       if ! file('gftemp.dbf') .or. ! file('lookup.dbf')
  445.          waiton("Preparing temporary files... please wait")
  446.          dbcreate("lookup", { { 'code', 'C', 4, 0 } , ;
  447.                               { 'descrip', 'C', 30, 0} } )
  448.          use lookup new
  449.          for xx := 1 to 10
  450.             append blank
  451.             replace code with lookup_[xx, 1], descrip with lookup_[xx, 2]
  452.          next
  453.          dbcreate("gftemp", { { 'lastname', 'C', 30, 0 } } )
  454.          use gftemp new
  455.          for xx := 1 to 1000
  456.             append blank
  457.             replace lastname with chr(gfrand(100) + 65)
  458.          next
  459.          waitoff()
  460.       else
  461.          use lookup new
  462.          use gftemp new
  463.       endif
  464.       indexbar('lastname')
  465.       inkey(2)
  466.       indexbar('lastname','lastname', 9, .t.)
  467.       inkey(1)
  468.       if ! YES_NO('This is one of the two Grumpfish yes/no prompts',;
  469.                   'Want to see the other one')
  470.          Err_Msg("Too bad, you're going to see it anyway")
  471.       ENDif
  472.       yes_no2('Shall we zap the database now?', 12, ' OK ', ' Cancel ', .F.)
  473.       if ! yes_no2('Send the report to:', 12, ' Printer ', ' File ')
  474.          waiton("Let's assume that we are printing now")
  475.          inkey(2)
  476.          waitoff()
  477.       ENDif
  478.  
  479.       inkey(1)
  480.       if isprinter()
  481.          waiton('Please turn off your printer for this demo')
  482.          do while isprinter()
  483.          enddo
  484.          waitoff()
  485.       endif
  486.       printok()
  487.       SET DEVICE TO SCREEN
  488.       Err_msg('This is the error message function!')
  489.       CLEARSCREEN
  490.       setcolor('+w/rb')
  491.       dumbo := Exbox(11, 19, 13, 59, 1, 5, '', .T., 'GETDATE()')
  492.       Spread('Get dates the easy way with GetDate()', 12, 20)
  493.       inkey(2)
  494.       Spread('You selected ' + DTOC(GetDate(DATE(), 0, 56)), 13, 20)
  495.       inkey(3)
  496.       byebyebox(dumbo)
  497.       dumbo := Exbox(10, 15, 14, 64, 1, 5, '', .T., 'Validation')
  498.       Spread('Grumpfish Library offers validation routines for',11,21)
  499.       Spread('state abbreviations and Canadian postal codes...',12,21)
  500.       mstate := space(2)
  501.       @ 13, 21 say "Enter a state abbreviation now:" get mstate valid isstate(@mstate)
  502.       set cursor on
  503.       read
  504.       set cursor off
  505.       inkey(2)
  506.       byebyebox(dumbo)
  507.       dumbo := Exbox(10, 20, 13, 58, 1, 5, '', .T., 'APICK()')
  508.       Spread('This is an example of APICK() - the',11,20)
  509.       Spread('Grumpfish enhancement for ACHOICE()',12,20)
  510.       inkey(4)
  511.       byebyebox(dumbo)
  512.       thefiles := directory("*.*")
  513.       aeval(thefiles, { | a, x | thefiles[x] := a[1] } )
  514.       setcolor('+W/BG')
  515.       if ( sel := APICK(9, 33, 15, 46, thefiles) ) > 0
  516.          Spread('You selected ' + thefiles[sel], 15, 20)
  517.          inkey(3)
  518.       ENDif
  519.       setcolor('+W/R')
  520.       dumbo := Exbox(10, 13, 14, 66, 1, 5, '', .T., 'HELPBROW()')
  521.       Spread("Last but not least, Grumpfish has a great picklist", 11, 20)
  522.       Spread("function for data validation.  Let's give it a try", 12, 20)
  523.       inkey(1)
  524.       mvar := "JUNK"
  525.       @ 13, 15 say "Your code:" get mvar valid helpbrow("lookup", "code", ;
  526.                    "Code", "descrip", "Description", .t., "+w/b", 13, 35)
  527.       setcursor(1)
  528.       readmodal(getlist)
  529.       getlist := {}
  530.       setcursor(0)
  531.       inkey(1)
  532.       byebyebox(dumbo)
  533.       close data
  534.       ferase('lastname.ntx')
  535.  
  536.    case sel == 15
  537.       CLEARSCREEN COLOR 'w/b'
  538.       colormod()
  539.  
  540.    endcase
  541.    restscreen(0, 0, maxrow(), maxcol(), mainmenu)
  542.    colorset(PRIMARY_COLOR)
  543. enddo
  544. return NIL
  545.  
  546.  
  547. static function rollup(mtext)
  548. local xx
  549. scroll(2, 8, 22, 71, 1)
  550. @ 22,08 say padr(mtext, 64)
  551. for xx := 1 to 35
  552. next
  553. return NIL
  554.  
  555.  
  556.  
  557. static function hilite_info(restart, lastline)
  558. static buffer
  559. //───── if 1st parameter was passed, clear out old BUFFER and do nothing else
  560. if restart != NIL
  561.    buffer := NIL
  562. else
  563.  
  564.    dispbegin()
  565.  
  566.    setpos(ptr + 1, 3)
  567.    //───── restore previous line if there was one saved
  568.    if buffer != NIL
  569.       restscreen(row(), col(), row(), maxcol(), buffer)
  570.    endif
  571.  
  572.    //───── 2nd parameter passed only to force highlighting of last line
  573.    //───── necessary cause you can't use ARRAY clause in conjunction with a WHEN
  574.    if lastline != NIL
  575.       ptr := len(verbiage_)
  576.    else
  577.       ptr := ggetno()
  578.    endif
  579.  
  580.    //───── move to new position, save screen, and display text
  581.    setpos(ptr + 1, 3)
  582.    buffer := savescreen(row(), col(), row(), maxcol())
  583.    dispout(padr(verbiage_[ptr], 73), colorset(C_MESSAGEBLINK, .T.))
  584.  
  585.    dispend()
  586.  
  587. endif
  588. return .t.
  589.  
  590. * eof demo5.prg
  591.