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