home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST171.PRG < prev    next >
Encoding:
Text File  |  1989-11-20  |  13.0 KB  |  529 lines
  1. ********************
  2.  
  3. PROCEDURE Gen_report
  4.  
  5.    PARAMETERS print_way, _stayput
  6.  
  7.    IF PCOUNT() != 2
  8.       _stayput = .F.
  9.    ENDIF
  10.  
  11.    IF EMPTY(sst_t_file)
  12.       RETURN
  13.    ENDIF
  14.    SELECT &sst_t_file.
  15.    IF ALIAS() <> UPPER(sst_t_file)
  16.       @ 23,00 CLEAR
  17.       @ 24,02 SAY "The Database is no longer AVAILABLE.  Report Aborted!!  Any Key to Continue...."
  18.       INKEY(0)
  19.       RETURN
  20.    ENDIF
  21.    STORE 0.00 TO grand_tot1, grand_tot2, grand_tot3, subtot1, subtot2, subtot3
  22.    PUSHSCREEN()
  23.    print_header = .T.
  24.    row_counter = 10
  25.    STORE "0" TO sstpage
  26.    IF !_stayput
  27.       IF EMPTY(AT("EOF()", sst_filter))
  28.          sst_filter = TRIM(sst_filter) + IF(EMPTY(sst_filter), "", " .AND. ") + " !EOF() .AND. CONTINUE()"
  29.       ENDIF
  30.       IF EMPTY(AT("CONTINUE()", sst_filter))
  31.          sst_filter = TRIM(sst_filter) + " .AND. CONTINUE()"
  32.       ENDIF
  33.       sst_filter = Fill_out(TRIM(sst_filter), 100)
  34.       IF !("U"$TYPE(sst_filter))
  35.          SET FILTER TO &sst_filter.
  36.       ENDIF
  37.    ELSE
  38.       _oldfilt = TRIM(STRTRAN(sst_filter, " .AND. CONTINUE()", ""))                 && This is a new conditional!
  39.       sst_filter = ".T. .AND. CONTINUE()"
  40.    ENDIF
  41.  
  42.    IF (TYPE(sst_filter) == "U" .OR. TYPE(sst_filter) == "UE")
  43.       old_color = SETCOLOR()
  44.       new_color = REVERSE(old_color)
  45.       SETCOLOR(new_color)
  46.       Wpush(Wrow(8), 11, Wrow(8) + 8, 75)
  47.       @ Wrow(1), Wcol(1) SAY " The Condition to Generate the Report has incorrect values."
  48.       @ Wrow(3), Wcol(1) SAY "      Generating the report will give a TYPE conflict.     "
  49.       @ Wrow(5), Wcol(1) SAY "      Please check the CONDITION sub-menu and correct.     "
  50.       @ Wrow(7), Wcol(1) SAY "                  Press Any Key to Continue.              "
  51.       INKEY(0)
  52.       Wpop()
  53.       POPSCREEN()
  54.       SETCOLOR(old_color)
  55.       RETURN
  56.    ENDIF
  57.  
  58.    IF !EMPTY(sstgroup)
  59.       IF FILE(sstgname + ".grp")
  60.          IF !_stayput
  61.             get_file = sstgname + ".grp"
  62.             SET INDEX TO &get_file.
  63.             GO TOP
  64.          ENDIF
  65.       ENDIF
  66.       set_value = &sstgroup.
  67.    ELSE
  68.       set_value = ""
  69.    ENDIF
  70.  
  71.    only1_more = .F.
  72.  
  73.    sst_filter = STRTRAN(LTRIM(TRIM(STRTRAN(sst_filter, "!EOF() .AND. ", ""))), ".AND. CONTINUE()", "")
  74.    SET FILTER TO &sst_filter.
  75.    IF !_stayput
  76.       GO TOP
  77.    ENDIF
  78.  
  79.    IF TYPE("addfilter") = "C"
  80.       pointer = Parsing(@addfilter, "->(")
  81.       Rparsing(@addfilter, ")")
  82.       Op(&pointer.->(Setfilt(addfilter)))
  83.    ENDIF
  84.  
  85.    DO WHILE !EOF()    &&sst_filter.
  86.       IF !EMPTY(sstgroup)                                 && There is a grouping
  87.          only1_more = (&sstgroup. <> set_value)           && The current value of set_value is
  88.       ENDIF
  89.  
  90.       IF only1_more
  91.          IF !EMPTY(sststot1) .OR. !EMPTY(sststot2) .OR. !EMPTY(sststot3)
  92.             IF print_header
  93.                IF !PRINT_CASE()
  94.                   POPSCREEN()
  95.                   RETURN
  96.                ENDIF
  97.                row_counter = 1
  98.                P_THE_HEAD()
  99.             ENDIF
  100.             END_GROUP()
  101.          ENDIF
  102.          set_value = &sstgroup.
  103.          Beg_group()
  104.          only1_more = .F.
  105.       ENDIF
  106.  
  107.       IF print_header
  108.          IF !PRINT_CASE()
  109.             POPSCREEN()
  110.             RETURN
  111.          ENDIF
  112.          row_counter = 1
  113.          P_the_head()
  114.       ENDIF
  115.  
  116.       IF !EMPTY(sstccnt)
  117.          FOR now_try = 1 TO sstccnt
  118.             tteqww = LTRIM(TRIM(STR(now_try)))
  119.             outputstr = PRINT_STRI(TRIM(sstcon&tteqww.))
  120.  
  121.             ? IF((LEN(outputstr) > 80 .AND. print_way = 1), ;
  122.                   SUBSTR(outputstr, 1, 79), outputstr)
  123.  
  124.             row_counter = row_counter + 1
  125.  
  126.             IF print_way = 1
  127.                IF ROW() >= 20
  128.                   @ 24,00
  129.                   @ 24,00 SAY "Any key for rest..."
  130.                   INKEY(0)
  131.                   SCROLL(9,0,22,79,6)
  132.                   @ 15,00 SAY""
  133.                ENDIF
  134.             ENDIF
  135.  
  136.             FOR y = 1 TO 3
  137.                ny = TRANSFORM(y, "9")
  138.                IF !EMPTY(ssttotal&ny.)
  139.                   IF !sst_tog1  .OR. (sst_tog1 .AND. ssttotal&ny.$sstcon&tteqww.)
  140.                      the_ww_rd = ssttotal&ny.
  141.                      new_value = &the_ww_rd.
  142.                      old_value = grand_tot&ny.
  143.                      grand_tot&ny. = old_value + new_value
  144.                   ENDIF
  145.                ENDIF
  146.                IF !EMPTY(sststot&ny.)
  147.                   IF !sst_tog1  .OR. (sst_tog1 .AND. sststot&ny.$sstcon&tteqww.)
  148.                      the_ww_rd = sststot&ny.
  149.                      new_value = &the_ww_rd.
  150.                      old_value = subtot&ny.
  151.                      subtot&ny. = old_value + new_value
  152.                   ENDIF
  153.                ENDIF
  154.             NEXT
  155.  
  156.          NEXT
  157.       ENDIF
  158.  
  159.       SKIP
  160.  
  161.       End_routine()
  162.  
  163.       IF LASTKEY() = ASC("Q") .OR. LASTKEY() = ASC("q")
  164.          EXIT
  165.       ENDIF
  166.  
  167.       IF only1_more
  168.          only1_more = .F.
  169.       ENDIF
  170.  
  171.       IF _stayput
  172.          IF !EMPTY(_oldfilt)
  173.             IF !(&_oldfilt.)
  174.                EXIT
  175.             ENDIF
  176.          ENDIF
  177.       ENDIF
  178.  
  179.    ENDDO
  180.    breakpoint = 80
  181.    only1_more = .T.
  182.  
  183.    IF LASTKEY() = ASC("Q") .OR. LASTKEY() = ASC("q")
  184.    ELSE
  185.       IF only1_more .AND. (!EMPTY(sststot1) .OR. !EMPTY(sststot2) .OR. !EMPTY(sststot3))
  186.          IF print_header
  187.             IF !PRINT_CASE()
  188.                POPSCREEN()
  189.                RETURN
  190.             ENDIF
  191.             row_counter = 1
  192.             P_the_head()
  193.          ENDIF
  194.          End_group()
  195.       ENDIF
  196.       Tot_check()
  197.       IF print_way = 2
  198.          * ?? row_counter
  199.          FOR pan_on = 56 TO row_counter STEP -1
  200.             ?
  201.          NEXT
  202.          @ 10,00 CLEAR
  203.          Print_foot()
  204.       ELSE
  205.          IF print_way = 1
  206.             Print_foot()
  207.          ENDIF
  208.       ENDIF
  209.    ENDIF
  210.  
  211.    IF print_way = 3
  212.       scr_level = scr_level + 1
  213.       End_way(0,80,10,10,12,70,IF((TYPE("notag") != "U"), .F., .T.))
  214.    ELSEIF print_way = 2
  215.       End_way(0,80,10,10,12,70,IF((TYPE("notag") != "U"), .F., .T.))
  216.    ELSE
  217.       End_way(0,0,23,79)
  218.    ENDIF
  219.    SET FILTER TO
  220.  
  221. ********************
  222.  
  223. FUNCTION Print_case
  224.  
  225.     DO CASE
  226.     CASE print_way = 1
  227.        @ 0,0 CLEAR
  228.     CASE print_way = 2
  229.        SET PRINT OFF
  230.        SET CONSOLE ON
  231.        PUSHSCREEN(10,10,12,70,.F.,.T.,.T.)
  232.        IF ISPRINTER()
  233.           @ 11,25 SAY "Printing Out Report.  One Moment!"
  234.        ELSE
  235.           @ 11,18 SAY "Your Printer is OFF LINE.  Any key to Continue"
  236.           INKEY(0)
  237.           POPSCREEN(10,10,12,70)
  238.           RETURN(.F.)
  239.        ENDIF
  240.        SET CONSOLE OFF
  241.        SET PRINT ON
  242.     CASE print_way = 3
  243.        SET CONSOLE ON
  244.        @ 0,0 CLEAR
  245.        @ 10,10 TO 12,70 DOUBLE
  246.        print_file = IF(TYPE("print_file") = "U", "", print_file)
  247.        IF EMPTY(print_file)
  248.           print_file = TRIM(sstfile)                && This is for the library
  249.        ENDIF
  250.        @ 11,15 SAY "Printing Out Report ==> " + TRIM(print_file) + ".  One Moment!"
  251.        SET CONSOLE OFF
  252.        SET ALTERNATE ON
  253.        SET ALTERNATE TO (print_file)
  254.     CASE print_way = 4
  255.        Writ_it_out(" / /")
  256.     ENDCASE
  257.     RETURN(.T.)
  258.  
  259.  
  260. ********************
  261.  
  262. PROCEDURE End_routine
  263.  
  264.    DO CASE
  265.    CASE print_way = 1
  266.       IF only1_more .AND. (!EMPTY(sststot1) .OR. !EMPTY(sststot2) .OR. !EMPTY(sststot3))
  267.          bounce_off = 14
  268.       ELSE
  269.          bounce_off = 18
  270.       ENDIF
  271.  
  272.       IF row_counter >= bounce_off
  273.          print_header = .T.
  274.          Print_foot()
  275.          @ 24,00 SAY "Press Any Key or Q to Quit..."
  276.          QWAIT("Q")
  277.       ENDIF
  278.    CASE print_way = 2
  279.       IF !EMPTY(sststot1) .OR. !EMPTY(sststot2) .OR. !EMPTY(sststot3)
  280.          bounce_off = 52
  281.       ELSE
  282.          bounce_off = 58
  283.       ENDIF
  284.  
  285.       IF row_counter >= 58
  286.          print_header = .T.
  287.          Print_foot()
  288.       ENDIF
  289.    CASE print_way = 3
  290.       Print_foot()
  291.    ENDCASE
  292.  
  293. ********************
  294.  
  295. PROCEDURE Print_foot
  296.  
  297.    row_counter = row_counter + 1
  298.  
  299.    IF print_way = 1
  300.       IF ROW() >= 20
  301.          @ 24,00
  302.          @ 24,00 SAY "Any key for rest..."
  303.          INKEY(0)
  304.          SCROLL(9,0,22,79,6)
  305.          @ 15,00 SAY""
  306.       ENDIF
  307.    ENDIF
  308.  
  309.    ?
  310.    IF !EMPTY(sstfcnt)
  311.       FOR now_try = 1 TO sstfcnt
  312.          tteqww = TRANSFORM(now_try, "9")
  313.          outputstr = PRINT_STRI(TRIM(sstfoot&tteqww.))
  314.          IF LEN(outputstr) > 80 .AND. print_way = 1
  315.             ? SUBSTR(outputstr, 1, 79)
  316.          ELSE
  317.             ? outputstr
  318.          ENDIF
  319.          row_counter = row_counter + 1
  320.       NEXT
  321.    ENDIF
  322.  
  323. ********************
  324.  
  325. FUNCTION Continue
  326.  
  327.    RETURN( !(INKEY() = 27) )
  328.  
  329. ********************
  330.  
  331. FUNCTION Set_files
  332.  
  333.    PARAMETERS _howmany
  334.  
  335.    _noterror = .T.
  336.  
  337.    IF PCOUNT() = 0
  338.       _howmany = 8
  339.    ENDIF
  340.    c_nter = 1
  341.    FOR qaz = 1 TO _howmany
  342.       ext = LTRIM(TRIM(STR(qaz)))
  343.       SELECT &ext.
  344.       IF !EMPTY(ALIAS())
  345.          _noterror = .F.
  346.          sst_f_str = sst_f_str + ALIAS() + "/"
  347.          IF LEN(in_files) < c_nter
  348.             EXIT
  349.          ELSE
  350.             in_files[c_nter] = ALIAS()
  351.             c_nter = c_nter + 1
  352.          ENDIF
  353.       ENDIF
  354.    NEXT
  355.    sst_f_str = SUBSTR(sst_f_str, 1, LEN(sst_f_str) - 1)
  356.    RETURN(_noterror)
  357.  
  358. ********************
  359.  
  360. PROCEDURE Tot_check
  361.  
  362.    End_routine()
  363.    IF LASTKEY() = ASC("Q") .OR. LASTKEY() = ASC("q")
  364.       RETURN
  365.    ENDIF
  366.    IF print_header
  367.       IF !PRINT_CASE()
  368.          RETURN
  369.       ENDIF
  370.       row_counter = 1
  371.       P_the_head()
  372.    ENDIF
  373.  
  374.    ?
  375.    IF !EMPTY(grand_tot1) .OR. !EMPTY(grand_tot2) .OR. !EMPTY(grand_tot3)
  376.       ? "Totals => "
  377.    ENDIF
  378.    IF !EMPTY(grand_tot1)
  379.       ?? FILL_OUT("[" + ssttotal1 + "]", 14) + TRANSFORM(grand_tot1, "9,999,999,999,999.99")
  380.       ? "          "
  381.    ENDIF
  382.    IF !EMPTY(grand_tot2)
  383.       ?? FILL_OUT("[" + ssttotal2 + "]", 14) + TRANSFORM(grand_tot2, "9,999,999,999,999.99")
  384.       ? "          "
  385.    ENDIF
  386.    IF !EMPTY(grand_tot3)
  387.       ?? FILL_OUT("[" + ssttotal3 + "]", 14) + TRANSFORM(grand_tot3, "9,999,999,999,999.99")
  388.    ENDIF
  389.  
  390. ********************
  391.  
  392. PROCEDURE Beg_group
  393.  
  394.    IF !EMPTY(sstgroup)
  395.       ?
  396.       ? "Group is on &sstgroup. = " + set_value
  397.       ?
  398.       row_counter = row_counter + 4
  399.    ENDIF
  400.  
  401. *******************
  402.  
  403. PROCEDURE End_group
  404.  
  405.    IF !EMPTY(sstgroup)
  406.       IF !EMPTY(subtot1) .OR. !EMPTY(subtot2) .OR. !EMPTY(subtot3)
  407.          ?
  408.          ? "****  Subtotals => "
  409.          row_counter = row_counter + 2
  410.       ELSE
  411.          RETURN
  412.       ENDIF
  413.  
  414.       IF !EMPTY(sststot1)
  415.          ?? FILL_OUT("{" + sststot1 + "}", 14) + TRANSFORM(subtot1, "9,999,999,999,999.99")
  416.          ? "                   "
  417.          row_counter = row_counter + 1
  418.          subtot1 = 0.00
  419.       ENDIF
  420.       IF !EMPTY(sststot2)
  421.          ?? FILL_OUT("{" + sststot2 + "}", 14) + TRANSFORM(subtot2, "9,999,999,999,999.99")
  422.          ? "                   "
  423.          row_counter = row_counter + 1
  424.          subtot2 = 0.00
  425.       ENDIF
  426.       IF !EMPTY(sststot3)
  427.          ?? FILL_OUT("{" + sststot3 + "}", 14) + TRANSFORM(subtot3, "9,999,999,999,999.99")
  428.          subtot3 = 0.00
  429.       ENDIF
  430.       ?
  431.       ?
  432.       row_counter = row_counter + 2
  433.    ENDIF
  434.  
  435. ********************
  436.  
  437. FUNCTION Ndxstrval
  438.          
  439.    PARAMETERS showstring
  440.  
  441.    DO CASE
  442.    CASE TYPE(showstring) = "C"
  443.       RETURN('"' + showstring + '"')
  444.    CASE TYPE(showstring) = "N"
  445.       RETURN('STR("' + showstring + '")')
  446.    CASE TYPE(showstring) = "M"
  447.       RETURN(" ")
  448.    CASE TYPE(showstring) = "D"
  449.       RETURN('DTOC("' + showstring + '")')
  450.    OTHERWISE
  451.       RETURN("True")
  452.    ENDCASE
  453.    
  454. ********************
  455.  
  456. PROCEDURE Move_down
  457.  
  458.    PARAMETERS p, l, v
  459.  
  460.    move_no = VAL(IF("CON"$v, SUBSTR(v, 7), SUBSTR(v, 8, 1)))
  461.    next2 = LTRIM(TRIM(TRANSFORM(move_no+1, "99")))
  462.    next1 = LTRIM(TRIM(TRANSFORM(move_no, "99")))
  463.    DO CASE
  464.    CASE "SSTHEAD"$v
  465.       keystroke = 6
  466.       IF move_no <> 6
  467.          ssthead&next2. = ssthead&next1.
  468.          ssthead&next1. = SPACE(132)
  469.       ENDIF
  470.    CASE "SSTFOOT"$v
  471.       keystroke = 3
  472.       IF move_no <> 3
  473.          sstfoot&next2. = sstfoot&next1.
  474.          sstfoot&next1. = SPACE(132)
  475.       ENDIF
  476.    OTHERWISE
  477.       keystroke = 12
  478.       IF move_no <> 12
  479.          sstcon&next2. = sstcon&next1.
  480.          sstcon&next1. = SPACE(152)
  481.       ENDIF
  482.    ENDCASE
  483.    KEYBOARD REPLICATE(CHR(24), keystroke) + REPLICATE(CHR(5), keystroke)
  484.  
  485. ********************
  486.  
  487. PROCEDURE Yank_away
  488.  
  489.    PARAMETERS p, l, v
  490.  
  491.    &v = SPACE(132)
  492.  
  493. ********************
  494.  
  495. PROCEDURE P_the_head
  496.  
  497.    sstpage = TRANSFORM(VAL(sstpage) + 1, "9999")
  498.    IF !EMPTY(ssthcnt)
  499.        FOR now_try = 1 TO ssthcnt
  500.           tteqww = TRANSFORM(now_try, "9")
  501.           outputstr = PRINT_STRI(TRIM(ssthead&tteqww.))
  502.           IF LEN(outputstr) > 80 .AND. print_way = 1
  503.              ? SUBSTR(outputstr, 1, 79)
  504.           ELSE
  505.              ? outputstr
  506.           ENDIF
  507.        NEXT
  508.     ENDIF
  509.     row_counter = row_counter + ssthcnt
  510.     Beg_group()
  511.     print_header = .F.
  512.  
  513. ********************
  514.  
  515. PROCEDURE Setfilt
  516.  
  517.    PARAMETERS _expression
  518.  
  519.    IF !(TYPE(_expression) == "U")
  520.       SET FILTER TO &_expression.
  521.    ENDIF
  522.  
  523.  
  524.  
  525. * End of File
  526.  
  527.  
  528.  
  529.