Liren Large Software Subsidy 5/05.iso/a/a075/1.img/TOOLKIT1.EXE/SST172.PRG

Text File | 1989-08-08 | 16.9 KB | 259 lines

********************

PROCEDURE Gen_code

   SET ALTERNATE TO &sstfile

   only1_more = .F.
   tdate = DTOC(DATE())
   ttime = TIME()
   DO Writ_it_out WITH "**************************************************", 2
   DO Writ_it_out WITH "* This procedure/program file was generated via  *", 3
   DO Writ_it_out WITH "*                                                *", 3
   DO Writ_it_out WITH "* Steve Straley's ToolkiT(tm) - Release 2        *", 3
   DO Writ_it_out WITH "* Copyright 1989 Stephen J. Straley & Associates *", 3
   DO Writ_it_out WITH "*                All Rights Reserved             *", 3
   DO Writ_it_out WITH "*                                                *", 3
   DO Writ_it_out WITH "*        This message MUST remain within the     *", 3
   DO Writ_it_out WITH "*      general location of the following coded   *", 3
   DO Writ_it_out WITH "*        portion; either in the main header      *", 3
   DO Writ_it_out WITH "*           or within the confines of this       *", 3
   DO Writ_it_out WITH "*                     procedure!                 *", 3
   DO Writ_it_out WITH "*                                                *", 3
   DO Writ_it_out WITH "* Program Name:                                  *", 3
   DO Writ_it_out WITH "*       Author:                                  *", 3
   DO Writ_it_out WITH "*         Date: &tdate.                          *", 3
   DO Writ_it_out WITH "*         Time: &ttime.                          *", 3
   DO Writ_it_out WITH "*                                                *", 3
   DO Writ_it_out WITH "**************************************************", 3

   DO Writ_it_out WITH "||PARAMETERS direction||IF PCOUNT() = 0|   print_way = " + LTRIM(TRIM(STR(print_way))), 3
   DO Writ_it_out WITH "ELSE|   IF TYPE('direction') = 'C'|      print_way = VAL(direction)", 3
   DO Writ_it_out WITH "   ELSE|      print_way = direction|   ENDIF|ENDIF", 3
   DO Writ_it_out WITH "print_file = '" + TRIM(sstfile) + "'", 3
   DO Writ_it_out WITH "IF TYPE('sstfile') = 'U'|   sstfile = print_file|ENDIF", 3
   DO Writ_it_out WITH "sststot1 = [" + sststot1 + "]|sststot2 = [" + sststot2 + "]|sststot3 = [" + sststot3 + "]", 3
   DO Writ_it_out WITH "ssttotal1 = [" + ssttotal1 + "]|ssttotal2 = [" + ssttotal2 + "]|ssttotal3 = [" + ssttotal3 + "]", 3
   DO Writ_it_out WITH "sstccnt = " + LTRIM(TRIM(STR(sstccnt))) + "|sst_tog1 = " + IF(sst_tog1, ".T.", ".F."), 3
   DO Writ_it_out WITH "sstfcnt = " + LTRIM(TRIM(STR(sstfcnt))), 3
   DO Writ_it_out WITH "ssthcnt = " + LTRIM(TRIM(STR(ssthcnt))), 3
   DO Writ_it_out WITH "sst_filter = '"  + LTRIM(TRIM(sst_filter)) + "'", 3
   DO Writ_it_out WITH "sstgroup = '" + sstgroup + "'", 3


   FOR qaz = 1 TO sstccnt
      extt = LTRIM(TRIM(STR(qaz)))
      DO Writ_it_out WITH "STORE [" + sstcon&extt. + "] TO sstcon&extt.", 3
   NEXT

   FOR qaz = 1 TO sstfcnt
      extt = LTRIM(TRIM(STR(qaz)))
      DO Writ_it_out WITH "STORE [" + sstfoot&extt. + "] TO sstfoot&extt.", 3
   NEXT

   FOR qaz = 1 TO ssthcnt
      tteqw = TRANSFORM(qaz, "9")
      DO Writ_it_out WITH "STORE [" + ssthead&tteqw. + "] TO ssthead&tteqw", 3
   NEXT

   DO Writ_it_out WITH "STORE 0.00 TO grand_tot1, grand_tot2, grand_tot3, subtot1, subtot2, subtot3", 3
   DO Writ_it_out WITH "CLEAR SCREEN| |print_header = .T.|row_counter = 10|STORE '0' TO sstpage", 3

   ret_area = LTRIM(TRIM(STR(SELECT())))
   FOR qaz = 10 TO 1 STEP -1
      extt = LTRIM(TRIM(STR(qaz)))
      SELECT &extt.
      IF !EMPTY(ALIAS())
         DO Writ_it_out WITH "SELECT &extt.|USE " + UPPERLOWER(ALIAS()), 3
         IF !EMPTY(INDEXKEY(INDEXORD()))
            thekey = INDEXKEY(INDEXORD())
            INDEX ON &thekey. TO Order&extt.
            DO Writ_it_out WITH "IF FILE('Order&extt..N*')|   SET INDEX TO Order&extt.", 3
            DO Writ_it_out WITH "ELSE|   INDEX ON &thekey. TO Order&extt.|ENDIF", 3
         ENDIF
      ENDIF
   NEXT
   SELECT &ret_area.
   DO Writ_it_out WITH "SELECT &ret_area.|SET FILTER TO &" + "sst_filter.", 3

   IF !EMPTY(sstgroup + ".grp")
      get_file = sstgname + ".grp"
      IF !EMPTY(sstgname)
         DO Writ_it_out WITH "IF FILE('" + UPPERLOWER(get_file) + "')|   SET INDEX TO " + UPPERLOWER(get_file) + "|ENDIF|set_value = " + IF(EMPTY(sstgroup), "' '", UPPERLOWER(ALIAS()) + "->" + LOWER(sstgroup)), 3
      ENDIF
      DO Writ_it_out WITH "|GO TOP", 3
   ELSE
      DO Writ_it_out WITH "set_value = ''", 3
   ENDIF
   IF EMPTY(AT("EOF()", sst_filter))
      sst_filter = TRIM(sst_filter) + IF(EMPTY(sst_filter), "", " .AND. ") + "!EOF() .AND. CONTINUE()"
   ENDIF
   IF EMPTY(AT("CONTINUE()", sst_filter))
      sst_filter = TRIM(sst_filter) + " .AND. CONTINUE()"
   ENDIF
   sst_filter = FILL_OUT(TRIM(sst_filter), 100)
   DO Writ_it_out WITH "|sstdate = '" + DTOC(DATE()) + "'|ssttime = '" + TIME() +"'", 3

   DO Writ_it_out WITH "only1_more = .F.|DO WHILE &sst_filter.", 3
   IF !EMPTY(sstgroup)
      DO Writ_it_out WITH "   only1_more = (" + UPPERLOWER(ALIAS()) + "->" + LOWER(sstgroup) + " <> set_value)", 3
   ENDIF

   DO Writ_it_out WITH "|   IF only1_more|      IF !EMPTY(sststot1) .OR. !EMPTY(sststot2) .OR. !EMPTY(sststot3)|         IF print_header", 3
   DO Writ_it_out WITH "            IF !PRINT_CASE()|               RETURN|           ENDIF|           row_counter = 1|           DO P_the_head", 3
   DO Writ_it_out WITH "         ENDIF|         DO End_group|      ENDIF|      set_value = " + IF(EMPTY(sstgroup), "' '", UPPERLOWER(ALIAS()) + "->" + LOWER(sstgroup)), 3
   DO Writ_it_out WITH "      DO Beg_group|      only1_more = .F.|   ENDIF", 3


   DO Writ_it_out WITH "|   IF print_header|      IF !PRINT_CASE()|         RETURN|      ENDIF", 3
   DO Writ_it_out WITH "|      row_counter = 1|      DO P_the_head|   ENDIF", 3

   DO Writ_it_out WITH "|   IF !EMPTY(sstccnt)|      FOR now_try = 1 TO sstccnt|          tteqww = LTRIM(TRIM(STR(now_try)))", 3
   DO Writ_it_out WITH "          outputstr = PRINT_STRI(TRIM(sstcon&tteqww.))", 3
   DO Writ_it_out WITH "          IF LEN(outputstr) > 80 .AND. print_way = 1", 3
   DO Writ_it_out WITH "             ? SUBSTR(outputstr, 1, 79)", 3
   DO Writ_it_out WITH "          ELSE|                ? outputstr|             ENDIF", 3
   DO Writ_it_out WITH "|         FOR y = 1 TO 3|            ny = TRANSFORM(y, '9')|            IF !EMPTY(ssttotal&ny.)", 3
   DO Writ_it_out WITH "               IF !sst_tog1  .OR. (sst_tog1 .AND. ssttotal&ny.$sstcon&tteqww.)", 3
   DO Writ_it_out WITH "                  the_ww_rd = ssttotal&ny.|                     new_value = &the_ww_rd.", 3
   DO Writ_it_out WITH "                  old_value = grand_tot&ny.|                     grand_tot&ny. = old_value + new_value", 3
   DO Writ_it_out WITH "               ENDIF|            ENDIF|               IF !EMPTY(sststot&ny.)", 3
   DO Writ_it_out WITH "|                  IF !sst_tog1  .OR. (sst_tog1 .AND. sststot&ny.$sstcon&tteqww.)", 3
   DO Writ_it_out WITH "                     the_ww_rd = sststot&ny.|                     new_value = &the_ww_rd.", 3
   DO Writ_it_out WITH "                     old_value = subtot&ny.|                     subtot&ny. = old_value + new_value|                  ENDIF", 3
   DO Writ_it_out WITH "               ENDIF|            NEXT|         NEXT|      ENDIF", 3


   DO Writ_it_out WITH "|   row_counter = row_counter + sstccnt| |   SKIP | |   DO End_routine", 3
   DO Writ_it_out WITH "|   IF LASTKEY() = ASC('Q') .OR. LASTKEY() = ASC('q')|      EXIT", 3
   DO Writ_it_out WITH "   ENDIF| |   IF only1_more|      only1_more = .F.|   ENDIF| |ENDDO", 3
   DO Writ_it_out WITH "|   breakpoint = 80|   only1_more = .T.||   IF LASTKEY() = ASC('Q') .OR. LASTKEY() = ASC('q')|   ELSE", 3
   DO Writ_it_out WITH "|      IF only1_more .AND. (!EMPTY(sststot1) .OR. !EMPTY(sststot2) .OR. !EMPTY(sststot3))", 3
   DO Writ_it_out WITH "|         IF print_header|            IF !PRINT_CASE()|               RETURN", 3
   DO Writ_it_out WITH "|            ENDIF|            row_counter = 1|            DO P_the_head|         ENDIF", 3
   DO Writ_it_out WITH "|         DO End_group|      ENDIF|      DO Tot_check|      IF print_way = 2", 3
   DO Writ_it_out WITH "|         FOR pan_on = 56 TO row_counter STEP -1|            ?|         NEXT", 3
   DO Writ_it_out WITH "|         @ 10,00 CLEAR|         DO Print_foot|         EJECT|      ELSE", 3
   DO Writ_it_out WITH "|         IF print_way = 1|            DO Print_foot|         ENDIF|      ENDIF|   ENDIF", 3
   DO Writ_it_out WITH "||   DO End_way2 WITH 0,0,23,79|   SET FILTER TO", 3

   Note : These are for the functions/procedures that make the above loop work!

   DO Writ_it_out WITH "|Note:  The Following functions/procedures may be already defined|Note:  if you are using SST_1 as part of your application.", 3
   DO Writ_it_out WITH "Note:  To remove the duplicate symbols at LINK time, just BLOCK|Note:  DELETE everything from this point on.  Re-compile", 3
   DO Writ_it_out WITH "Note:  and re-link the application.", 3

   *****************
   * Func Continue
   *****************

   DO Writ_it_out WITH "| |********************| |FUNCTION Continue| |   RETURN( !(INKEY() = 27) )", 3

   *******************
   * Proc End_routine
   *******************

   DO Writ_it_out WITH "| |********************| |PROCEDURE End_routine| |   DO CASE|      CASE print_way = 1", 3
   IF only1_more .AND. (!EMPTY(sststot1) .OR. !EMPTY(sststot2) .OR. !EMPTY(sststot3))
      DO Writ_it_out WITH "         bounce_off = 14|", 3
   ELSE
      DO Writ_it_out WITH "         bounce_off = 18|", 3
   ENDIF
   DO Writ_it_out WITH "         IF row_counter >= bounce_off", 3
   DO Writ_it_out WITH "            print_header = .T.|            DO Print_foot|            @ 24,00 SAY 'Press Any Key or Q to Quit...'|            QWAIT('Q')", 3
   DO Writ_it_out WITH "         ENDIF|      CASE print_way = 2", 3
   IF !EMPTY(sststot1) .OR. !EMPTY(sststot2) .OR. !EMPTY(sststot3)
      DO Writ_it_out WITH "         bounce_off = 52|", 3
   ELSE
      DO Writ_it_out WITH "         bounce_off = 58|", 3
   ENDIF
   DO Writ_it_out WITH "         IF row_counter >= 58|            print_header = .T.", 3
   DO Writ_it_out WITH "            DO Print_foot|            EJECT|         ENDIF|      CASE print_way = 3|   ENDCASE", 3

   *******************
   * Proc Print_foot
   *******************

   DO Writ_it_out WITH "| |********************| |PROCEDURE Print_foot| |   ?", 3
   DO Writ_it_out WITH "|IF !EMPTY(sstfcnt)", 3
   DO Writ_it_out WITH "|   FOR now_try = 1 TO " + LTRIM(TRIM(STR(sstfcnt))), 3
   DO Writ_it_out WITH "      tteqww = TRANSFORM(now_try, '9')", 3
   DO Writ_it_out WITH "      outputstr = PRINT_STRI(TRIM(sstfoot&tteqww.))", 3
   DO Writ_it_out WITH "      IF LEN(outputstr) > 80 .AND. print_way = 1", 3
   DO Writ_it_out WITH "            ? SUBSTR(outputstr, 1, 79)|          ELSE|             ? outputstr", 3
   DO Writ_it_out WITH "         ENDIF|    NEXT|ENDIF", 3

   *******************
   * Func Print_str
   *******************

   DO Writ_it_out WITH "| |********************| |FUNCTION Print_stri| |   PARAMETER ye_old_it| |   x_times = OCCURENCE(CHR(174), ye_old_it)", 3
   DO Writ_it_out WITH "|   IF EMPTY(x_times)|      RETURN(ye_old_it)|   ENDIF|   FOR go_th_it = 1 TO x_times|      f_stop = AT(CHR(174), ye_old_it)", 3
   DO Writ_it_out WITH "      b_stop = AT(CHR(175), ye_old_it)|      front_it = SUBSTR(ye_old_it, 1, f_stop-1)|      mid_it = SUBSTR(ye_old_it, f_stop  + 1, b_stop-1-f_stop)", 3
   DO Writ_it_out WITH "      rest_it = SUBSTR(ye_old_it, b_stop+1)|      IF '->'$mid_it|         new_it = &" + "mid_it|         ye_old_it = front_it + STRVALUE(new_it) + rest_it", 3
   DO Writ_it_out WITH "      ELSE|         ye_old_it = front_it +  STRVALUE(&" + "mid_it) +  rest_it|      ENDIF|   NEXT|   RETURN(ye_old_it)| |********************", 3

   *******************
   * Func Occurence
   *******************

   DO Writ_it_out WITH "| |FUNCTION Occurence| |   PARAMETERS astring, bstring| |   return_cnt = 0| |   DO WHILE !EMPTY(AT(astring, bstring))", 3
   DO Writ_it_out WITH "      return_cnt = return_cnt + 1|      bstring = SUBSTR(bstring, AT(astring, bstring) + 1)|   ENDDO| |   RETURN(return_cnt)", 3

   ******************
   * Func Strvalue
   ******************

   DO Writ_it_out WITH "| |********************| |FUNCTION Strvalue| |   PARAMETERS showstring| |   DO CASE|   CASE TYPE('showstring') = 'C'", 3
   DO Writ_it_out WITH "      RETURN(showstring)|   CASE TYPE('showstring') = 'N'|      RETURN(STR(showstring))|   CASE TYPE('showstring') = 'M'|      RETURN(' ')", 3
   DO Writ_it_out WITH "   CASE TYPE('showstring') = 'D'|      RETURN(DTOC(showstring))|   OTHERWISE|      RETURN(IF(showstring, 'True', 'False'))|   ENDCASE", 3

   ******************
   * Func Print_case
   ******************

   DO Writ_it_out WITH "| |********************| |FUNCTION Print_case| |    DO CASE|       CASE print_way = 1", 3
   DO Writ_it_out WITH "|          @ 0,0 CLEAR|       CASE print_way = 2|          SET PRINT OFF|          SET CONSOLE ON", 3
   DO Writ_it_out WITH "|          IF TYPE('_a_scr') = 'U'|             PUBLIC _a_scr|             _a_scr = SAVESCREEN(10,10,12,70)|          ELSE", 3
   DO Writ_it_out WITH "|             RESTSCREEN(10,10,12,70,_a_scr)|          ENDIF|          @ 10,10 CLEAR TO 12,70", 3
   DO Writ_it_out WITH "|          @ 10,10 TO 12,70 DOUBLE|          IF ISPRINTER()|             @ 11,25 SAY 'Printing Out Report.  One Moment!'|          ELSE", 3
   DO Writ_it_out WITH "|             @ 11,18 SAY 'Your Printer is OFF LINE.  Any key to Continue'|             INKEY(0)|             RESTSCREEN(10,10,12,70,_a_scr)", 3
   DO Writ_it_out WITH "|             RETURN(.F.)|          ENDIF|          SET CONSOLE OFF|          SET PRINT ON|       CASE print_way = 3|          SET CONSOLE ON", 3
   DO Writ_it_out WITH "|          @ 0,0 CLEAR|          @ 10,10 TO 12,70 DOUBLE|          @ 11,15 SAY 'Printing Out Report ==> ' + TRIM(sstfile) + '.  One Moment!'", 3
   DO Writ_it_out WITH "|          print_file = TRIM(sstfile)|          SET CONSOLE OFF|          SET ALTERNATE ON|          SET ALTERNATE TO &print_file.|    ENDCASE|    RETURN(.T.)", 3


   ********************
   * Func Parsing
   ********************

   DO Writ_it_out WITH "|********************||FUNCTION Parsing||   PARAMETERS getstring, for_code||   IF PCOUNT() = 1", 3
   DO Writ_it_out WITH "      for_code = .F.|   ENDIF||   IF for_code|      whereat   = AT(CHR(124), getstring)|   ELSE", 3
   DO Writ_it_out WITH "|      whereat   = IF(EMPTY(AT('+', getstring)), AT('/', getstring), AT('+', getstring))", 3
   DO Writ_it_out WITH "|   ENDIF|   newstring = IF(!EMPTY(whereat), SUBSTR(getstring, 1, whereat - 1), getstring)", 3
   DO Writ_it_out WITH "|   getstring = IF(!EMPTY(whereat), SUBSTR(getstring, whereat + 1), '')", 3
   DO Writ_it_out WITH "|   RETURN(newstring)", 3

   ********************
   * Proc End_way2
   ********************

   DO Writ_it_out WITH "********************|PROCEDURE End_way2||   PARAMETERS line_no, the_cent, a_row, a_col, a_row2, a_col2", 3
   DO Writ_it_out WITH "   IF PCOUNT() = 4|      a_row2 = a_row|      a_col2 = a_col|   ENDIF||   DO CASE|   CASE print_way = 1", 3
   DO Writ_it_out WITH "      @ 24,00 SAY 'End of Report.  Press Any key to RETURN               '|      INKEY(0)|   CASE print_way = 2", 3
   DO Writ_it_out WITH "      SET CONSOLE OFF|      SET PRINT ON|      IF the_cent > 0|         skipping = breakpoint|         DO WHILE skipping <= 55", 3
   DO Writ_it_out WITH "            ?|            skipping = skipping + 1|         ENDDO|         IF LASTKEY() = 27|            ? MESS_CENT('Partial Report Printed', the_cent)", 3
   DO Writ_it_out WITH "         ELSE|            ? MESS_CENT('End of Report', the_cent)|         ENDIF|         EJECT|         IF screject", 3
   DO Writ_it_out WITH "            EJECT|         ENDIF|      ENDIF|      SET CONSOLE ON|      SET PRINT OFF|      DO Clear_area WITH a_row-1, a_col-5, a_row+3, a_col+65", 3
   DO Writ_it_out WITH "      SAVE SCREEN|      @ a_row, a_col - 5 TO a_row + 2, a_col + 60 DOUBLE|      @ a_row + 1, a_col SAY 'Requested Information has been Printed.  Any Key to RETURN'", 3
   DO Writ_it_out WITH "      INKEY(0)|      RESTORE SCREEN|   OTHERWISE|      IF TYPE('the_cent') = 'U'|         the_cent = 0|      ENDIF", 3
   DO Writ_it_out WITH "      IF the_cent > 0|         ?|         ?|         ? MESS_CENT('End of Report', the_cent)|      ENDIF||      SET ALTERNATE OFF", 3
   DO Writ_it_out WITH "      SET ALTERNATE TO|      CLOSE ALTERNATE|      SET CONSOLE ON|      SAVE SCREEN|      SCROLL(a_row, a_col, a_row + 2, a_col + 60, 0)", 3
   DO Writ_it_out WITH "      @ a_row, a_col TO a_row + 2, a_col + 60 DOUBLE|      say_what = TRIM(print_file) + ' is now on the disk.  Any key to RETURN'", 3
   DO Writ_it_out WITH "      @ a_row + 1, CENTER(say_what, 30) + a_col SAY say_what|      INKEY(0)|      RESTORE SCREEN|   ENDCASE", 3

   DO Writ_it_out WITH "", 4   && Close the window display
   CLOSE ALTERNATE

* End of File