home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a100 / 4.ddi / FBASE.ARC / GPRO.PRG < prev    next >
Encoding:
Text File  |  1989-03-23  |  33.9 KB  |  1,069 lines
  1. *:*********************************************************************
  2. *:
  3. *:        Program: GPRO.PRG
  4. *:
  5. *:         System: gpro.prg
  6. *:         Author: ACF
  7. *:      Copyright (c) 1989, Fox Software, Inc.
  8. *:  Last modified: 01/20/89     16:02
  9. *:
  10. *:  Procs & Fncts: MAIN
  11. *:               : HOUSEKEEP
  12. *:               : FILEMATCH
  13. *:               : HOTKEY
  14. *:               : OPENDBF
  15. *:               : OPENNDX
  16. *:               : ROWVAL
  17. *:               : COLVAL
  18. *:               : GENVAL
  19. *:               : TRACKER
  20. *:               : HELPGRAPH
  21. *:               : PROCEED
  22. *:               : ERRHAND
  23. *:               : ERRMSG
  24. *:
  25. *:          Calls: MAIN             (procedure in GPRO.PRG)
  26. *:
  27. *:     Documented: 01/24/89 at 11:14               FoxDoc version 1.0
  28. *:*********************************************************************
  29. PARAMETER loadfile
  30. DO main
  31. PROCEDURE main
  32. RELEASE ALL EXCEPT loadfile
  33. PUBLIC FOX
  34. DECLARE sum[12]
  35. DECLARE setup[32], oldval[32]
  36. **************************************************************
  37. * Save existing environment and set up FoxGraph environment  *
  38. **************************************************************
  39. IF SET('TALK') = 'ON'                  && Save TALK status & turn off
  40.    SET TALK OFF
  41.    STORE 'ON' TO save_talk
  42. ELSE
  43.    STORE 'OFF' TO save_talk
  44. ENDIF
  45. ***************************************************************************
  46. * Initialize smallest set of variables needed to access the error handler *
  47. ***************************************************************************
  48. ON ERROR DO errhand
  49. STORE SPACE(80) TO m->errmsg
  50. STORE 1 TO m->oldfld
  51. STORE .f. TO m->errflag
  52. STORE SET("CONFIRM") TO save_conf       && Save CONFIRM setting
  53. STORE SET("BELL") TO save_bell          && Save BELL setting
  54. STORE SET("STATUS") TO save_stat        && Save STATUS setting
  55. STORE SET("SCOREBOARD") TO save_score   && Save SCOREBOARD setting
  56. STORE SET("ESCAPE") TO save_escap       && Save ESCAPE setting
  57. STORE SET("FULLPATH") TO save_path      && Save FULLPATH setting
  58. STORE SET("SAFETY") TO save_safe        && Save SAFETY setting
  59. ON KEY LABEL F1 DO hotkey               && Set F1 to 'HELP' key
  60. SET CONFIRM OFF
  61. SET BELL OFF
  62. SET STATUS OFF
  63. SET SCOREBOARD OFF
  64. SET ESCAPE OFF
  65. SET TYPEAHEAD TO 128
  66. SET FULLPATH ON
  67. SET SAFETY OFF
  68. normal = IIF(SET("COLOR") = 'ON', 'n/bg, gr+/n, bg', '')
  69. inverse = IIF(SET("COLOR") = 'ON', 'GR+/N', 'N/W')
  70. SET COLOR TO &normal
  71. CLEAR
  72. RESTORE MACROS FROM foxgraph
  73. *************************
  74. * Initialize GET fields *
  75. *************************
  76. STORE IIF(LEN(DBF()) > 50, DBF(), LEFT(DBF()+SPACE(50),50)) TO setup[1]
  77. IF LEN(ORDER()) = 0             && No active indexes
  78.    STORE SPACE(50) TO setup[2]
  79.    STORE .F. TO setup[3]
  80. ELSE
  81.    STORE LEFT(ORDER()+SPACE(50),50) TO setup[2]
  82.    STORE .T. TO setup[3]
  83. ENDIF
  84. i = 4
  85. DO WHILE m->i < 30
  86.    STORE SPACE(40) TO setup[m->i]
  87.    m->i = m->i + 1
  88. ENDDO
  89. ******************************
  90. * Initialize other variables *
  91. ******************************
  92. STORE 0 TO m->macstat, m->key, m->fldnum
  93. STORE SPACE(50) TO m->filename, m->macro
  94. STORE .f. TO gotpopup
  95. STORE TRIM(m->loadfile) TO loadfile
  96. *******************************
  97. * Define menu bars and popups *
  98. *******************************
  99. DEFINE MENU main
  100. DEFINE PAD setup OF main PROMPT "Setup" AT 0,0 MESSAGE ;
  101.       "Setup parameters and values for the graph"
  102. DEFINE PAD help OF main PROMPT "Help" AT 0,10 MESSAGE ;
  103.       "Display general information about FoxGraph"
  104. DEFINE PAD draw OF main PROMPT "Draw" AT 0,20 MESSAGE ;
  105.       "Build temporary files, and display/modify graph"
  106. DEFINE PAD files OF main PROMPT "Files" AT 0,30 MESSAGE ;
  107.       "Load or save graph definition from/to file"
  108. DEFINE PAD macros OF main PROMPT "Macros" AT 0,40 MESSAGE ;
  109.       "Use or record keyboard macros from/to file"
  110. DEFINE PAD exit OF main PROMPT "Exit" AT 0,50 MESSAGE ;
  111.       "Exit FoxGraph"
  112.  
  113. ON SELECTION PAD setup OF main DO setup
  114. ON SELECTION PAD help OF main DO Help
  115. ON SELECTION PAD draw OF main DO Draw
  116. ON SELECTION PAD files OF main DO Files
  117. ON SELECTION PAD macros OF main DO Macros
  118. ON SELECTION PAD exit OF main DO Exit
  119. **************************
  120. * Main menu control loop *
  121. **************************
  122. IF LEN(m->loadfile) = 0
  123.    m->i = 1
  124.    DO WHILE m->i < 31
  125.       oldval[m->i] = setup[m->i]
  126.       m->i = m->i + 1
  127.    ENDDO
  128.    SET FUNCTION 'F10' TO CHR(27)
  129.    DO WHILE .T.
  130.       ACTIVATE MENU main
  131.       IF LEN(PROMPT()) = 0                && Escape was hit
  132.          DO exit
  133.       ENDIF
  134.       IF m->key <> -9 .AND. m->key <> 27
  135.          EXIT
  136.       ENDIF
  137.    ENDDO
  138. ELSE
  139.    filename = m->loadfile
  140.    DO getgrf
  141.    DO restoreit WITH filename
  142.    IF .NOT. m->errflag
  143.       DO draw
  144.    ENDIF
  145.    DO exit
  146. ENDIF
  147.  
  148.  
  149. *********************************************************************
  150. * SETUP - Collect information for designing the graph               *
  151. *********************************************************************
  152. PROCEDURE setup
  153. @ 0,0
  154. DEFINE POPUP dbf FROM 3,12 TO 20,25 PROMPT FILES LIKE *.dbf
  155. ON SELECTION POPUP dbf DO getpopup
  156. DEFINE POPUP ndx FROM 3,12 TO 20,25 PROMPT FILES LIKE *.ndx
  157. ON SELECTION POPUP ndx DO getpopup
  158. DEFINE POPUP style FROM 3,12 TO 20,25 PROMPT FILES LIKE 3dlooks\*.3gr
  159. ON SELECTION POPUP style DO getpopup
  160. DEFINE POPUP fields FROM 3,12 TO 20,23 PROMPT STRUCTURE
  161. ON SELECTION POPUP fields DO getpopup
  162. m->line23 = "           Position to fields - " + ;
  163.          CHR(24)+CHR(25)+CHR(26)+CHR(27) + ".  Help - F1.  Main Menu - F10."
  164. rc = '02170317041702550355045506170655075511091145120912451309134514091445'+;
  165.          '150915451609164517091745180918451909194520092045'
  166. DO redraw WITH 30, 24                 && fldno, lineno
  167. STORE 1 TO fldnum, oldfld
  168. SET FUNCTION 'F10' TO CHR(3)
  169. DO WHILE m->fldnum > 0 .AND. m->fldnum < 30
  170.    fcode = '@' + IIF(fldnum < 10, IIF(fldnum = 3, ' y', 's20'), 's30')
  171.    @ VAL(SUBSTR(rc,m->fldnum*4-3,2)),VAL(SUBSTR(rc,m->fldnum*4-1,2)) ;
  172.                     GET setup[m->fldnum] PICTURE fcode valid validate()
  173.    SET CONFIRM ON
  174.    READ
  175.    SET CONFIRM OFF
  176. ENDDO
  177. fldnum = 0
  178. @ 22,0
  179. @ 23,0
  180. SET FUNCTION 'F10' TO CHR(27)
  181. *******************************************
  182. * HELP - All about the FoxGraph interface *
  183. *******************************************
  184. PROCEDURE help
  185. CLEAR
  186. TEXT
  187. Use the SETUP menu option to specify the data you want to include in your 
  188. graph.  Graph data may be derived from database files or they may be values 
  189. that you enter directly.  When you are defining your graph, it is easiest to 
  190. think of your graph as a two-dimensional grid with rows and columns. 
  191.  
  192. Example: Using an employee file, salary and bonus amounts can be graphed for 
  193. each employee.  The following SETUP definitions are fields in the database:
  194.  
  195.                      ROW DEFINITION      = LASTNAME
  196.                      COLUMN 1 DEFINITION = SALARY
  197.                      COLUMN 2 DEFINITION = BONUS
  198.  
  199.                       ┌────────────┬────────────┐
  200.     ┌──────> Brown    │   25,000   │    3,000   <───── COLUMN VALUE
  201.     │                 ├────────────┼────────────┤
  202.    ROW       Johnson  │   36,000   │    4,500   │
  203.   VALUE               ├────────────┼────────────┤
  204.              Young    │   18,000   │    2,000   │
  205.                       └────────────┴────────────┘
  206.                      │Annual Salary   1988 Bonus │
  207.                      └─────────────┬─────────────┘
  208.                             COLUMN HEADERS
  209. ENDTEXT
  210. DO proceed WITH 2
  211. IF m->key = -9 .OR. m->key = 27            && Escape
  212.    RETURN
  213. ENDIF
  214. TEXT
  215.  The row values are determined by the ROW DEFINITION. If your graph is based on
  216.  database records, the row definition should be a character expression contain-
  217.  ing one or more database fields. When you display summary information, the row
  218.  definition should be the key upon which the file is either sorted or currently
  219.  indexed. In this case, there will be one row for each distinct key value.  If
  220.  you are not summarizing the data, there will be one row for each record in the
  221.  primary database.
  222.  
  223.  The columns are determined by the COLUMN DEFINITIONs.  These definitions must 
  224.  be numeric expressions.  Every row will contain a value for each column that
  225.  you define.  Keep in mind, column definitions may include numeric operations
  226.  for scaling or other manipulation of data values.
  227.  
  228.  When you display summary information on a database, the special expression '+'
  229.  is available in addition to normally valid numeric expressions.  The '+' ex-
  230.  pression indicates that the number of records within each key group is to be
  231.  displayed for each row value.  For example, if you had a customer database,
  232.  you could sort it by state (row definition) and use the '+' expression (column
  233.  1 definition) to graph the number of customers you have in each state. 
  234.  
  235.  Alternately, you could use the TOTAL command to build a summary database 
  236.  before performing the SETUP. In this case, you would not request SUMMARY ONLY 
  237.  and your graph would have a row for each record in the TOTALed database.
  238. ENDTEXT
  239. DO proceed WITH 2
  240. IF m->key = -9 .OR. m->key = 27            && Escape
  241.    RETURN
  242. ENDIF
  243. TEXT
  244. As you are entering information in the SETUP screen, you may press F1 at any 
  245. point to get specific HELP information.  If you press F1 while you are on the 
  246. DATABASE, INDEX, GRAPH STYLE, ROW DEFINITION or COLUMNs DEFINITION fields, a 
  247. popup menu will be displayed which contains items appropriate to that field.  
  248. You may select these items by positioning with the arrow keys and selecting 
  249. with the Return key.
  250.  
  251. When you have completed the SETUP, choose the DRAW menu option.  At this point 
  252. the data is summarized (if indicated) and written to a temporary data file for 
  253. use by FoxGraph.  FoxGraph is then invoked and an initial graph is displayed 
  254. based on your SETUP information.  You may then choose other formats for the 
  255. graph and/or select different ranges of data to display in the graph.  Once you
  256. are satisfied with the appearance of the graph you may save it and print it.   
  257.  
  258. You may also wish to save the SETUP definition so that you can more convenient-
  259. ly generate the graph again.  Use the FILES menu option to save and load graph
  260. definitions.
  261.  
  262. Sometimes it is desirable to define a canned procedure for performing a set of
  263. tasks within the graphing program itself.  With the MACROS menu option, you may
  264. either indicate that you wish to record a macro (sequence of keystrokes) while
  265. you are running FoxGraph or that you want to activate an existing macro to 
  266. control a FoxGraph session.
  267. ENDTEXT
  268. DO proceed WITH 2
  269. @ 22,0
  270. @ 23,0
  271. RETURN
  272. *************************************************************
  273. * Call FoxGraph with name of file containing graph info     *
  274. *************************************************************
  275. PROCEDURE draw
  276. ********************************
  277. * See if they want to continue *
  278. ********************************
  279. IF LEN(m->loadfile) = 0
  280.    errmsg = "Proceed with graph generation" + IIF(m->macstat = 1, ;
  281.             " - Macro Active", IIF(m->macstat = 2, " - Recording Macro", ""))
  282.    DO errmsg
  283.    DO proceed with 1
  284.    IF m->key = -9 .OR. m->key = 27
  285.       RETURN
  286.    ENDIF
  287. ENDIF
  288. m->key = 0
  289. errmsg = "Building data files - Please wait"
  290. DO errmsg
  291. **************************************************
  292. * If SETUP is not complete, just invoke FoxGraph *
  293. **************************************************
  294. IF LEN(TRIM(setup[7])) = 0
  295.    command = 'foxgraph /q'
  296.    IF LEN(TRIM(setup[6])) <> 0
  297.       command = m->command + ' ' + TRIM(setup[6])
  298.    ENDIF
  299.    IF m->macstat <> 0
  300.       command = m->command + IIF(m->macstat=1,' /r:',' /w:')+TRIM(macro)
  301.       macstat = 0
  302.    ENDIF
  303.    IF FOX
  304.       &command
  305.    ELSE
  306.       RUN foxswap &command
  307.       CLEAR
  308.    ENDIF
  309.    RETURN
  310. ENDIF
  311. *******************************************************
  312. * Create a temporary data file to be used by FoxGraph *
  313. *******************************************************
  314. STORE "3dDATA\FOXGRAPH.DAT" TO graphfile
  315. page = 1
  316. SET CONSOLE OFF
  317. SET ALTERNATE TO &graphfile
  318. **********************************************
  319. * Write general graphing information to file *
  320. **********************************************
  321. SET ALTERNATE ON
  322. ?? '"%%Upper_Top_Left: 11, 2, 1%%"'
  323. ? '"%%Title: 8, 1%%"'
  324. ? '"%%Subtitle: 8, 2%%"'
  325. ? '"%%Row_Title: 9, 1%%"'
  326. ? '"%%Column_Title: 9, 2%%"'
  327. ? '"%%Row_Headers: 11, 1%%"'
  328. ? '"%%Column_Headers: 10, 2%%"'
  329. ? '"'+TRIM(setup[4])+'" '+'"'+TRIM(setup[5])+'"'
  330. ? '"'+TRIM(setup[8])+'" '+'"'+TRIM(setup[9])+'"'
  331. lines = 9
  332. counter = 28
  333. DO WHILE m->counter > 9    && Find out how many columns are used
  334.    IF LEN(TRIM(setup[m->counter])) > 0
  335.       EXIT
  336.    ENDIF
  337.    counter = m->counter - 2
  338. ENDDO
  339. COMMAND = ","          && Print column headers
  340. I = 11
  341. DO WHILE m->i <= m->counter + 1
  342.    COMMAND = m->command + [ "] + TRIM(setup[m->i]) + ["]
  343.    I = m->i + 2
  344. ENDDO
  345. ? m->command
  346. Lines = m->lines + 1
  347. ********************
  348. * Process the data *
  349. ********************
  350. errmsg = 'Only the first 246 rows of data will be graphed'
  351. IF LEN(DBF()) <> 0
  352.    dbfopen = .T.
  353.    GO TOP
  354. ELSE
  355.    dbfopen = .F.
  356. ENDIF
  357. IF setup[3] .AND. dbfopen
  358.    I = 10
  359.    DO WHILE m->i <= m->counter
  360.       STORE 0 TO sum[m->i]
  361.       I = m->i + 2
  362.    ENDDO
  363.    STORE &setup[7] TO sum[7]         && Note current key value
  364.    DO WHILE .T.
  365.       IF sum[7] <> &setup[7] .OR. EOF()  && Group change??
  366.          I = 10          && Store group summary info in file
  367.          command = ["]+TRIM(sum[7])+["]
  368.          DO WHILE m->i <= m->counter
  369.             command = m->command + "," + STR(sum[m->i],14,2)
  370.             STORE 0 TO sum[m->i]
  371.             I = m->i + 2
  372.          ENDDO
  373.          ? m->command
  374.          Lines = m->lines + 1
  375.          STORE &setup[7] TO sum[7]     && First element of value
  376.          IF EOF()
  377.             EXIT                  && Finished last group
  378.          ELSE
  379.             IF m->lines > 255
  380.                SET ALTERNATE OFF
  381.                SET CONSOLE ON
  382.                DO errmsg
  383.                DO proceed WITH 1
  384.                SET CONSOLE OFF
  385.                SET ALTERNATE ON
  386.                EXIT
  387.             ENDIF 
  388.          ENDIF
  389.       ENDIF
  390.       I = 10
  391.       DO WHILE m->i <= m->counter && For each column, add to summary
  392.          thevalue = setup[m->i]
  393.          IF m->thevalue = '+'
  394.             STORE sum[m->i] + 1 TO sum[m->i]
  395.          ELSE
  396.             STORE sum[m->i] + &thevalue TO sum[m->i]
  397.          ENDIF
  398.          I = m->i + 2
  399.       ENDDO
  400.       SKIP
  401.    ENDDO && WHILE .T.
  402. ELSE
  403.    DO WHILE .NOT. EOF()
  404.       command = ["] + TRIM(&setup[7]) + ["]
  405.       I = 10
  406.       DO WHILE m->i <= m->counter
  407.          thevalue = setup[m->i]
  408.          IF LEN(TRIM(m->thevalue)) <> 0
  409.             IF m->thevalue = '+'
  410.                command = m->command + "," + STR(1,14,2)
  411.             ELSE
  412.                command = m->command + "," + STR(&thevalue,14,2)
  413.             ENDIF
  414.          ENDIF
  415.          I = m->i + 2
  416.       ENDDO
  417.       ? m->command
  418.       Lines = m->lines + 1
  419.       IF .NOT. dbfopen
  420.          EXIT
  421.       ELSE
  422.          IF m->lines > 255
  423.             SET ALTERNATE OFF
  424.             SET CONSOLE ON
  425.             DO errmsg
  426.             DO proceed WITH 1
  427.             SET CONSOLE OFF
  428.             SET ALTERNATE ON
  429.             EXIT
  430.          ENDIF
  431.       ENDIF
  432.       SKIP
  433.    ENDDO
  434. ENDIF && IF m->sumonly
  435. ******************************************************
  436. * Mark the end of the data, close file, and graph it *
  437. ******************************************************
  438. ? '"%%Lower_Bottom_Right: '+STR(m->lines);
  439.     +','+STR((m->counter-6)/2)+','+STR(m->page)+'%%"' 
  440. CLOSE ALTERNATE
  441. SET CONSOLE ON
  442. command = 'foxgraph '
  443. IF LEN(TRIM(setup[6])) <> 0
  444.    command = m->command + ' ' + TRIM(setup[6])
  445. ENDIF
  446. IF m->macstat <> 0
  447.    command = m->command + IIF(m->macstat=1,' /r:',' /w:')+TRIM(m->macro)
  448. ENDIF
  449. command = m->command + ' /q /d:' + graphfile
  450. IF m->key <> -9 .AND. m->key <> 27
  451.    IF FOX
  452.       &command
  453.    ELSE
  454.       RUN foxswap &command
  455.    ENDIF
  456. ENDIF
  457. CLEAR
  458. IF m->macstat = 2                 && Turn off recording mode
  459.    macstat = 0
  460. ENDIF
  461. RETURN
  462. ************************************************
  463. * FILES - Load and Save graph definition files *
  464. ************************************************
  465. PROCEDURE files
  466. @ 0,0 CLEAR TO 23,79
  467. line23 =  "            Position to options - " + CHR(24)+CHR(25) + ;
  468.           ".  Select - " + CHR(17)+CHR(217) +".  Main Menu - Esc.   "
  469. SET CONFIRM ON        
  470. DEFINE POPUP grf FROM 3,12 TO 20,25 PROMPT FILES LIKE *.gr4
  471. ON SELECTION POPUP grf DO getpopup
  472. DEFINE POPUP files FROM 1,30
  473. DEFINE BAR 1 OF files PROMPT ' ' SKIP
  474. DEFINE BAR 2 OF files PROMPT 'Load Definition' + SPACE(24) ;
  475.    MESSAGE 'Load graph definition from file'
  476. DEFINE BAR 3 OF files PROMPT 'Save Definition' + SPACE(24) ;
  477.    MESSAGE 'Save graph definition to file'
  478. DEFINE BAR 4 OF files PROMPT ' ' SKIP
  479. ON SELECTION POPUP files DO dofiles
  480. @ 23,0 SAY m->line23
  481. ACTIVATE POPUP files
  482. SET CONFIRM OFF
  483. CLEAR
  484. fldnum = 0
  485. RETURN
  486. ****************************************
  487. * Use or record keyboard macro files *
  488. ****************************************
  489. PROCEDURE macros
  490. @ 0,0 CLEAR TO 23,79
  491. line23 =  "            Position to options - " + CHR(24)+CHR(25) + ;
  492.           ".  Select - " + CHR(17)+CHR(217) +".  Main Menu - Esc.   "
  493. msg1 = 'Activate/Deactivate macro file for controlling a FoxGraph session'
  494. msg2 = 'Turn keyboard recording mode on/off during FoxGraph session'
  495. SET CONFIRM ON        
  496. DEFINE POPUP threemc FROM 3,12 TO 20,25 PROMPT FILES LIKE *.3mc
  497. ON SELECTION POPUP threemc DO getpopup
  498. DEFINE POPUP macros FROM 1,30
  499. DEFINE BAR 1 OF macros PROMPT ' ' SKIP
  500. DEFINE BAR 2 OF macros PROMPT IIF(m->macstat <> 1, 'Activate Macro' + SPACE(25), ;
  501.    LEFT('Deactivate Macro ==> '+m->macro+SPACE(19), 39)) MESSAGE msg1
  502. DEFINE BAR 3 OF macros PROMPT IIF(m->macstat <> 2, 'Start Recording' + SPACE(24), ;
  503.    LEFT('Stop Recording ==> '+m->macro+SPACE(21), 39)) MESSAGE msg2
  504. DEFINE BAR 4 OF macros PROMPT ' ' SKIP
  505. ON SELECTION POPUP macros DO domacros
  506. @ 23,0 SAY m->line23
  507. errmsg = IIF(m->macstat = 1, 'Macro active - ' + m->macro, ;
  508.    IIF(m->macstat = 2, 'Macro recording mode on - ' + m->macro, ;
  509.    'Macro inactive'))
  510. DO errmsg
  511. ACTIVATE POPUP macros
  512. SET CONFIRM OFF
  513. CLEAR
  514. fldnum = 0
  515. RETURN
  516. ********************
  517. * EXIT - All done? *
  518. ********************
  519. PROCEDURE exit
  520. IF LEN(m->loadfile) = 0
  521.    @ 0,0
  522.    DO proceed WITH 3
  523.    IF m->key = -9 .OR. m->key = 27
  524.       RETURN
  525.    ENDIF
  526. ENDIF
  527. DO housekeep
  528. DEACTIVATE MENU
  529. RETURN
  530. ******************************************
  531. * HOUSEKEEP - Try to restore environment *
  532. ******************************************
  533. PROCEDURE housekeep
  534. DEACTIVATE MENU
  535. RELEASE POPUPS
  536. RELEASE MENUS
  537. ON KEY
  538. ON ERROR
  539. SET ESCAPE &save_escap
  540. SET SCOREBOARD &save_score
  541. SET STATUS &save_stat
  542. SET BELL &save_bell
  543. SET CONFIRM &save_conf
  544. SET COLOR TO
  545. SET FULLPATH &save_path
  546. SET SAFETY &save_safe
  547. SET TALK &save_talk
  548. IF LEN(m->loadfile) = 0
  549.     SET FUNCTION 'F10' TO 'edit;'
  550. ENDIF
  551. CLEAR
  552. RETURN
  553. *********************************************************
  554. * HOTKEY - provide assistance during the READ command   *
  555. *********************************************************
  556. PROCEDURE hotkey
  557. m->pop23 = "         Position to options - " + CHR(24)+CHR(25) + ;
  558.    ".  Select - " + CHR(17)+CHR(217) +".  Abort Selection - Esc.     "
  559.  
  560. DO CASE
  561. CASE m->fldnum = 1        && Database field
  562.    ON KEY
  563.    errmsg = "Select a database for the graph"
  564.    DO errmsg
  565.    @ 23,0 SAY m->pop23
  566.    ACTIVATE POPUP dbf
  567. CASE m->fldnum = 2        && Index field
  568.    ON KEY
  569.    errmsg = "Select an index file for grouping data"
  570.    DO errmsg
  571.    @ 23,0 SAY m->pop23
  572.    ACTIVATE POPUP ndx
  573. CASE m->fldnum = 6
  574.    ON KEY
  575.    errmsg = 'Select format for initial graph display'
  576.    DO errmsg
  577.    @ 23,0 SAY m->pop23
  578.    ACTIVATE POPUP style
  579. CASE m->fldnum = 30        && Setup definition file
  580.    ON KEY
  581.    errmsg = "Select graph definition file name"
  582.    DO errmsg
  583.    @ 23,0 SAY m->pop23
  584.    ACTIVATE POPUP grf
  585.    filename = prompt()
  586. CASE m->fldnum = 31        && Macro file
  587.    ON KEY
  588.    errmsg = "Select keyboard macro file name"
  589.    DO errmsg
  590.    @ 23,0 SAY m->pop23
  591.    ACTIVATE POPUP threemc
  592.    macro = prompt()
  593. CASE m->fldnum = 7 .OR. (m->fldnum > 9 .AND. MOD(m->fldnum,2)=0)  && Row and Column values
  594.    errmsg = IIF(m->fldnum = 7, "Select an expression for the row definition",;
  595.                     "Select a numeric expression for the column definition")
  596.    DO errmsg
  597.    @ 23,0 SAY m->pop23
  598.    ACTIVATE POPUP fields
  599. CASE m->fldnum = 3
  600.    errmsg = 'Summarize data by groups (Y) or graph for all records (N)'
  601.    DO errmsg
  602.    RETURN
  603. CASE m->fldnum = 4
  604.    errmsg = 'Enter title to appear at the top of the graph display'
  605.    DO errmsg
  606.    RETURN
  607. CASE m->fldnum = 5
  608.    errmsg = 'Enter subtitle to appear at the bottom of the graph display'
  609.    DO errmsg
  610.    RETURN
  611. CASE m->fldnum = 8
  612.    errmsg = 'Enter row title to appear along the row axis of the graph'
  613.    DO errmsg
  614.    RETURN
  615. CASE m->fldnum = 9
  616.    errmsg = 'Enter column title to appear along the column axis of the graph'
  617.    DO errmsg
  618.    RETURN
  619. CASE m->fldnum > 10 .AND. MOD(m->fldnum,2) = 1
  620.    errmsg = 'Enter column header to appear below the corresponding column'
  621.    DO errmsg
  622.    RETURN
  623. OTHERWISE
  624.    RETURN
  625. ENDCASE
  626. IF gotpopup
  627.    PLAY MACRO F9
  628. ENDIF
  629. @ 23,0
  630. @ 23,0 SAY m->line23
  631. ON KEY LABEL F1 DO hotkey
  632. RETURN
  633. *********************************************************
  634. * OPENDBF - open the selected dbf                       *
  635. *********************************************************
  636. FUNCTION opendbf
  637. @ 22,0
  638. IF m->gotpopup
  639.    gotpopup = .f.
  640.    m->fldnum = 1
  641.    setup[1] = IIF(LEN(PROMPT()) > 50, PROMPT(), LEFT(PROMPT()+SPACE(50),50))
  642.    RETURN .T.
  643. ELSE
  644.    DO tracker
  645. ENDIF
  646. IF oldval[1] <> setup[1]    && value changed
  647.    USE TRIM(setup[1])
  648.    IF LEN(ALIAS())=0 .AND. LEN(TRIM(setup[1]))<>0  && dbf not successfully opened
  649.       fldnum = 1
  650.       RETURN .F.
  651.    ENDIF
  652.    oldval[1] = setup[1]
  653.    STORE SPACE(50) TO setup[2], oldval[2]    && Clear index field
  654. ENDIF
  655. RETURN .T.
  656. *************************************************************
  657. * OPENNDX - open the selected index                         *
  658. *************************************************************
  659. FUNCTION openndx
  660. @ 22,0
  661. IF m->gotpopup
  662.    gotpopup = .f.
  663.    m->fldnum = 2
  664.    setup[2] = IIF(LEN(PROMPT()) > 50, PROMPT(), LEFT(PROMPT()+space(50),50))
  665.    RETURN .T.
  666. ELSE
  667.    DO tracker
  668. ENDIF
  669. IF .NOT. (oldval[2] = setup[2])     && value changed
  670.    oldfld = 2
  671.    SET INDEX TO TRIM(setup[2])
  672.    IF LEN(TRIM(setup[2])) <> 0        && index name entered
  673.       IF LEN(ORDER())=0               && Index not successfully opened
  674.          fldnum = 2
  675.          RETURN .F.
  676.       ENDIF
  677.       GO BOTT                       && Test out the index
  678.       SKIP
  679.       IF .NOT. EOF()
  680.          fldnum = 2
  681.          RETURN .F.
  682.       ENDIF
  683.       ndxopen = .T.
  684.    ELSE                             && index name erased
  685.       ndxopen = .F.
  686.    ENDIF
  687.    oldval[2] = setup[2]
  688. *   STORE SPACE(40) TO setup[7], oldval[7]
  689.    STORE IIF(ndxopen, .T., .F.) TO setup[3], oldval[3]
  690. ENDIF
  691. RETURN .T.
  692. ***************************************************************
  693. * ROWVAL - make sure that the row value is a valid expression *
  694. ***************************************************************
  695. FUNCTION  rowval
  696. @ 22,0
  697. IF m->gotpopup
  698.    gotpopup = .f.
  699.    setup[7] = IIF(LEN(PROMPT()) > 40, PROMPT(), LEFT(PROMPT()+SPACE(40),40))
  700.    RETURN .T.
  701. ENDIF
  702. IF oldval[7] <> setup[7]
  703.    IF TYPE(setup[7]) <> 'C' .AND. LEN(TRIM(setup[7])) <> 0
  704.       errmsg = "Row definition must be a character expression"      
  705.       DO errmsg
  706.       RETURN .F.
  707.    ENDIF
  708.    oldval[7] = setup[7]
  709. ENDIF
  710. DO tracker
  711. RETURN .T.
  712. *************************************************************
  713. * COLVAL - check to see that column values are valid        *
  714. *************************************************************
  715. FUNCTION colval
  716. @ 22,0
  717. IF gotpopup
  718.    gotpopup = .f.
  719.    setup[m->fldnum] = IIF(LEN(PROMPT()) > 40, PROMPT(), LEFT(PROMPT()+SPACE(40),40))
  720.    RETURN .T.
  721. ENDIF
  722. IF oldval[m->fldnum] <> setup[m->fldnum]
  723.    IF TYPE(setup[m->fldnum]) <> 'N' .AND. setup[m->fldnum] <> '+' .AND. ;
  724.          LEN(TRIM(setup[m->fldnum])) > 0 
  725.       errmsg = 'Column definitions must be valid numeric expressions'
  726.       DO errmsg
  727.       RETURN .F.
  728.    ENDIF
  729.    oldval[m->fldnum] = setup[m->fldnum]
  730. ENDIF
  731. DO tracker
  732. RETURN .T.
  733. *************************************************************
  734. * GENVAL - general validation routine                       *
  735. *************************************************************
  736. FUNCTION genval
  737. @ 22,0
  738. IF m->gotpopup
  739.    gotpopup = .f.
  740.    m->fldnum = 6
  741.    setup[6] = IIF(LEN(PROMPT()) > 40, PROMPT(), LEFT(PROMPT()+SPACE(40),40))
  742.    RETURN .T.
  743. ENDIF
  744. oldval[m->fldnum] = setup[m->fldnum]
  745. DO tracker
  746. IF LEN(ALIAS()) = 0 .AND. fldnum = 3 .AND. oldfld = 4
  747.    fldnum = 1
  748. ENDIF
  749. RETURN .T.
  750. *************************************************************
  751. * TRACKER - track which GET field we are on currently       *
  752. *************************************************************
  753. PROCEDURE tracker
  754. key = MOD(READKEY(),256)
  755. DO CASE
  756. CASE key = 0 .OR. key = 2 .OR. key = 4    && Go back one
  757.    fldnum = m->fldnum - 1
  758. CASE key = 1 .OR. key = 3 .OR. key = 5 .OR. key = 15 .OR. key = 16
  759.    fldnum = m->fldnum + 1
  760. CASE key = 12
  761.    fldnum = 0
  762. CASE key = 14 .OR. key = 6 .OR. key = 7
  763.    fldnum = 30
  764. ENDCASE
  765. RETURN
  766. *******************************************************
  767. * PROCEED - Display message at bottom of help screen *
  768. *******************************************************
  769. PROCEDURE proceed
  770. PARAMETER mproceed
  771. @ 24,0
  772. SET COLOR TO &inverse
  773. DO CASE
  774. CASE m->mproceed = 1          && Proceed with graph generation?
  775.    @ 24,0 SAY '                   F10 - Main Menu.  Any other key - Proceed.';
  776.       + SPACE(18)
  777. CASE m->mproceed = 2          && Proceed with help screens?
  778.    @ 24,0 SAY '                   F10 - Main Menu.  Any other key - Continue.';
  779.       + SPACE(17)
  780. CASE m->mproceed = 3          && Proceed with exiting?
  781.    @ 24,0 SAY '                     F10 - Main Menu.  Any other key - Exit.';
  782.       + SPACE(19)
  783. CASE m->mproceed = 4          && Proceed with exiting?
  784.    @ 24,0 SAY '                             Press any key to exit.';
  785.       + SPACE(29)
  786. ENDCASE
  787. SET COLOR TO &normal
  788. IF m->mproceed <> 2 .AND. m->mproceed <> 3
  789.    ?? CHR(7)
  790. ENDIF
  791. m->key = INKEY(0)
  792. CLEAR
  793. RETURN
  794. *************************************************************
  795. * ERRHAND - General error handling  routine                 *
  796. *************************************************************
  797. PROCEDURE errhand
  798. m->errmsg = MESSAGE()
  799. errflag = .T.
  800. DO CASE
  801. CASE m->oldfld = 2
  802.    m->errmsg = 'Invalid index file'
  803. CASE ERROR() = 21 .OR. ERROR() = 1310
  804.    m->errmsg = m->errmsg + ' - Check CONFIG file values'
  805.    DO errmsg
  806.    DO proceed WITH 4
  807.    DO housekeep
  808.    RETURN TO MASTER
  809. ENDCASE
  810. DO errmsg
  811. RETURN
  812. *************************************************************
  813. * ERRMSG - Display an error message on line 22              *
  814. *************************************************************
  815. PROCEDURE errmsg
  816. *@ 22,0
  817. IF SET("COLOR") = 'ON'
  818.    @ 22,0 SAY SPACE((80-LEN(m->errmsg)-6)/2)+"<< " COLOR GR+*/BG
  819.    @ 22,COL() SAY m->errmsg COLOR GR+/BG
  820.    @ 22,COL() SAY " >>" COLOR GR+*/BG
  821.    @ 22,COL()
  822.    SET COLOR TO N/BG
  823. ELSE
  824.    @ 22,0 SAY SPACE((80-LEN(m->errmsg)-6)/2)+"<< " COLOR W+*/N
  825.    @ 22,COL() SAY m->errmsg COLOR W+/N
  826.    @ 22,COL() SAY " >>" COLOR W+*/N
  827.    @ 22,COL()
  828.    SET COLOR TO
  829. ENDIF
  830. RETURN
  831. ******************************************************************
  832. * GETPOPUP - The ON SELECTION routine for the hotkey popup menus *
  833. ******************************************************************
  834. PROCEDURE getpopup
  835. gotpopup = .t.
  836. DEACTIVATE POPUP
  837. RETURN
  838. ***********************************************
  839. * REDRAW - Routine to redraw the setup screen *
  840. ***********************************************
  841. PROCEDURE redraw
  842. PARAMETER fldno, lineno
  843. IF m->fldno = 30 .AND. m->lineno = 24             && Full redraw
  844. @ 0,0 CLEAR TO lineno,79
  845. @ 0,0
  846. TEXT
  847.  
  848.   Database                              Graph Title
  849.   Index                                 Graph Subtitle
  850.   Summary Only?                         Graph Style
  851.  
  852.   Row Definition                        Row Title
  853.                                         Columns Title
  854.  
  855.  
  856.   Column         Definitions                            Headers
  857.     01
  858.     02
  859.     03
  860.     04
  861.     05
  862.     06
  863.     07
  864.     08
  865.     09
  866.     10
  867. ENDTEXT
  868. @ 1,0 TO 21,79 DOUBLE
  869. ENDIF
  870. k = 1
  871. DO WHILE m->k < m->fldno
  872.    fcode = '@' + IIF(k < 10, IIF(k = 3, ' y', 's20'), 's30')
  873.    @ VAL(SUBSTR(rc,k*4-3,2)),VAL(SUBSTR(rc,k*4-1,2)) ;
  874.         GET setup[m->k] PICTURE fcode
  875.    k = k + 1
  876. ENDDO
  877. @ 23,0 SAY m->line23    
  878. CLEAR GETS
  879. RETURN
  880. ****************************************************
  881. * VALIDATE - Controlling routine to validate READs *
  882. ****************************************************
  883. FUNCTION validate
  884. DO CASE
  885. CASE m->fldnum = 1
  886.    ok = opendbf()
  887. CASE m->fldnum = 2
  888.    ok = openndx()
  889. CASE m->fldnum = 7
  890.    ok = rowval()
  891. CASE m->fldnum > 9 .AND. MOD(m->fldnum,2) = 0
  892.    ok = colval()
  893. OTHERWISE
  894.    ok = genval()
  895. ENDCASE
  896. RETURN ok
  897. ******************************************************************
  898. * GETGRF - Get user to input the name of a setup definition file *
  899. ******************************************************************
  900. PROCEDURE getgrf
  901. IF LEN(m->loadfile) = 0
  902.    line23 = "       Enter file name - Finish with " + ;
  903.               CHR(17)+CHR(217) + ".  Help - F1.  Abort Entry - Esc."
  904.    arrow = CHR(16)
  905.    @ 23,0 SAY m->line23
  906.    @ m->theitem+1,47 GET arrow
  907.    CLEAR GETS
  908.    filename = IIF(LEN(m->filename) > 50, m->filename, LEFT(m->filename+SPACE(50),50))
  909.    @ m->theitem+1,48 GET m->filename FUNCTION "s22"
  910.    fldnum = 30
  911.    READ
  912.    fldnum = 0
  913.    IF m->gotpopup
  914.       gotpopup = .f.
  915.       filename = IIF(LEN(PROMPT()) > 50, PROMPT(), LEFT(PROMPT()+SPACE(50),50))
  916.    ENDIF
  917.    key = MOD(READKEY(),256)
  918. ENDIF
  919. IF m->key <> 12 .AND. LEN(TRIM(m->filename)) > 0
  920.    I = AT('.', m->filename) + 1
  921.    filename = IIF(m->i > 1, ;
  922.         STUFF(m->filename, m->i, LEN(SUBSTR(m->filename,m->i)), 'gr4'), ;
  923.         TRIM(m->filename) + '.gr4')
  924.    command = TRIM(m->filename)
  925.    IF LEN(m->loadfile) = 0
  926.       errmsg = IIF(m->theitem = 2,"Loading ","Saving ")+m->command+" - Please wait"
  927.       DO errmsg
  928.    ENDIF
  929. ELSE
  930.    theitem = 0
  931. ENDIF
  932. RETURN
  933. *******************************************************
  934. * GET3MC - Get user to input the name of a macro file *
  935. *******************************************************
  936. PROCEDURE get3mc
  937. line23 = "       Enter file name - Finish with " + ;
  938.    CHR(17)+CHR(217) + ".  Help - F1.  Abort Entry - Esc."
  939. arrow = CHR(16)
  940. @ 23,0 SAY m->line23
  941. @ m->theitem+1,47 GET arrow
  942. CLEAR GETS
  943. macro = IIF(LEN(m->macro) > 50, m->macro, LEFT(m->macro+SPACE(50),50))
  944. @ m->theitem+1,48 GET m->macro FUNCTION "s22"
  945. fldnum = 31
  946. READ
  947. fldnum = 0
  948. IF gotpopup
  949.    gotpopup = .f.
  950.    macro = IIF(LEN(PROMPT()) > 50, PROMPT(), LEFT(PROMPT()+SPACE(50),50))
  951. ENDIF
  952. key = MOD(READKEY(),256)
  953. IF m->key <> 12 .AND. LEN(TRIM(m->macro)) > 0
  954.    I = AT('.', m->macro) + 1
  955.    macro = IIF(m->i > 1, ;
  956.       STUFF(m->macro, m->i, LEN(SUBSTR(m->macro,m->i)), '3mc'), ;
  957.       TRIM(m->macro) + '.3mc')
  958.    command = TRIM(m->macro)
  959. ELSE
  960.    theitem = 0
  961. ENDIF
  962. RETURN
  963. **********************************************************
  964. * RESTOREIT - Restore setup information from a save file *
  965. **********************************************************
  966. PROCEDURE restoreit
  967. PARAMETER savefile
  968. RESTORE FROM &savefile ADDITIVE
  969. IF m->errflag
  970.    RETURN
  971. ENDIF
  972. IF LEN(TRIM(m->filename)) <> 0       && no errors
  973.    I = 1
  974.    DO WHILE m->i < 32
  975.       setup[m->i] = oldval[m->i]
  976.       I = m->i + 1
  977.    ENDDO
  978.    USE TRIM(setup[1]) INDEX TRIM(setup[2])
  979.    @ 22,0        && Erase Please wait mssg
  980. ENDIF
  981. RETURN
  982. ***************************************************************
  983. * DOFILES - The ON SELECTION routine for the files popup menu *
  984. ***************************************************************
  985. PROCEDURE dofiles
  986. theitem = BAR()
  987. DO WHILE .T.
  988.    errflag = .F.
  989.    command = ''
  990.    DO getgrf
  991.    IF m->errflag
  992.       LOOP
  993.    ENDIF
  994.    DO CASE
  995.    CASE theitem = 2
  996.       IF LEN(m->command) > 0          && Filename was entered
  997.          DO restoreit WITH command
  998.       ENDIF
  999.    CASE theitem = 3
  1000.       IF LEN(m->command) > 0
  1001.          STORE TRIM(m->macro) TO oldval[30]
  1002.          STORE m->macstat TO oldval[31]
  1003.          SAVE TO &command ALL LIKE oldval*
  1004.       ENDIF
  1005.    ENDCASE
  1006.    IF .NOT. m->errflag
  1007.        @ 22,0
  1008.        EXIT
  1009.    ENDIF
  1010. ENDDO
  1011. RETURN
  1012. *****************************************************************
  1013. * DOMACROS - The ON SELECTION routine for the macros popup menu *
  1014. *****************************************************************
  1015. PROCEDURE domacros
  1016. theitem = BAR()
  1017. DO WHILE .T.
  1018.    IF m->theitem = 2 .AND. m->macstat = 1 .OR. m->theitem = 3 .AND. m->macstat = 2
  1019.       macstat = 0
  1020.       EXIT
  1021.    ENDIF
  1022.    errflag = .F.
  1023.    command = ''
  1024.    DO get3mc
  1025.    IF m->errflag
  1026.       LOOP
  1027.    ENDIF
  1028.    DO CASE
  1029.    CASE theitem = 2
  1030.       IF LEN(m->command) > 0          && Filename was entered
  1031.          IF FILE(m->command)
  1032.             STORE 1 TO m->macstat
  1033.          ELSE
  1034.             errmsg = m->command + ' does not exist'
  1035.             DO errmsg
  1036.             errflag = .T.
  1037.          ENDIF
  1038.       ENDIF
  1039.    CASE theitem = 3
  1040.       IF LEN(m->command) > 0
  1041.          macstat = 2
  1042.          IF FILE(m->command)
  1043.             @24,0
  1044.             @23,78
  1045.             WAIT m->command + ' already exists, overwrite it (Y/N)? ' TO m->i
  1046.             IF UPPER(m->i) <> 'Y'
  1047.                macstat = 0
  1048.                errflag = .T.
  1049.             ENDIF
  1050.             @24,0
  1051.          ENDIF
  1052.       ENDIF
  1053.    ENDCASE
  1054.    IF .NOT. m->errflag
  1055.        @ 22,0
  1056.        EXIT
  1057.    ENDIF
  1058. ENDDO
  1059. DEFINE BAR 2 OF macros PROMPT IIF(m->macstat <> 1, 'Activate Macro' + SPACE(25), ;
  1060.    LEFT('Deactivate Macro ==> '+m->macro+SPACE(19), 39)) MESSAGE msg1
  1061. DEFINE BAR 3 OF macros PROMPT IIF(m->macstat <> 2, 'Start Recording' + SPACE(24), ;
  1062.    LEFT('Stop Recording ==> '+m->macro+SPACE(21), 39)) MESSAGE msg2
  1063. errmsg = IIF(m->macstat = 1, 'Macro active - ' + m->macro, ;
  1064.    IIF(m->macstat = 2, 'Macro recording mode on - ' + m->macro, ;
  1065.    'Macro inactive'))
  1066. DO errmsg
  1067. RETURN
  1068. *: EOF: GPRO.PRG
  1069.