home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB123 / prodlabl.prg < prev    next >
Text File  |  1995-05-28  |  3KB  |  130 lines
  1. * Program   : PRODLABL.PRG
  2. * Version   : V1.0
  3. * Author(s) : Joe Tomas
  4. * Date      : 09/10/86
  5. * Notice    : 
  6. * Called by : REPORTS.PRG
  7. * Call(s)   :
  8. * Notes     : ALLOWS PRINTING OF SMALL QTY OF PRODUCT LABELS AT DECUS
  9. *           : (LABEL SIZE IS 3 1/2" x 7/8")
  10. CLEAR
  11. SET CONFIRM ON
  12. CLEAR
  13. CALL PAINT WITH "PRODLABL.IMG"
  14. SET COLOR TO
  15. STORE 'Y' TO AGAIN
  16.  
  17. DO WHILE AGAIN = 'Y'
  18.    STORE '   ' TO ANS
  19.    ?? VBELL1
  20.  
  21.    @ 18,54 GET ANS PICTURE 'AAAA'
  22.    READ
  23.  
  24.    IF UPPER(SUBSTR(ANS,1,1))= 'E'
  25.       CLEAR
  26.       RETURN
  27.    ENDIF
  28.  
  29.    IF UPPER(ANS) = 'Y'
  30.       SET PRINT ON
  31.       SET CONSOLE OFF
  32.       ? 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
  33.       ? '------------------------------'
  34.       ? 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
  35.       ? '------------------------------'
  36.       ? 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
  37.       ? ' '
  38.       SET PRINT OFF
  39.       SET CONSOLE ON
  40.       STORE 'Y' TO AGAIN
  41.    ELSE
  42.       STORE 'N' TO AGAIN
  43.    ENDIF
  44.  
  45. ENDDO
  46.  
  47. @ 22,00
  48.  
  49. STORE .F. TO VALID
  50.  
  51. DO WHILE .NOT. VALID
  52.    SET INTENSITY ON
  53.    STORE .T. TO VALID
  54.    STORE SPACE(3) TO MCODE
  55.    STORE 0 TO PRICE
  56.    STORE SPACE(30) TO DESCRI
  57.    STORE '  -     -  ' TO PARTNO
  58.    STORE 0 TO LABELS
  59.  
  60.    @ 04,00 CLEAR
  61.    @ 08,20 SAY '3-DIGIT PRODUCT CODE : ' GET MCODE PICTURE '999'
  62.    @ 09,20 SAY 'DEC PART NUMBER      : ' GET PARTNO PICTURE '!!-!!!!!-!!'
  63.    @ 10,20 SAY 'ITEM DESCRIPTION     : ' GET DESCRI
  64.    @ 11,20 SAY 'DECUS SHOW PRICE     : ' GET PRICE PICTURE '99999.99'
  65.    @ 12,20 SAY '# OF LABELS TO PRINT : ' GET LABELS PICTURE '99'
  66.    SET COLOR TO I+
  67.    @ 23,22 SAY ' ENTER <999> FOR PRODUCT CODE TO EXIT '
  68.    SET COLOR TO
  69.    READ
  70.    STORE UPPER(DESCRI) TO DESCRI
  71.  
  72.    IF MCODE = '999'
  73.       CLEAR
  74.       RETURN
  75.    ENDIF
  76.  
  77.    SET COLOR TO +
  78.    @ 20,25 SAY 'PRESS ANY KEY TO START PRINTING'
  79.    SET COLOR TO
  80.  
  81.    DO WHILE INKEY() = 0
  82.       SET COLOR TO +
  83.       @ 20,31 SAY 'ANY KEY'
  84.       SET COLOR TO
  85.       @ 20,31 SAY 'ANY KEY'
  86.    ENDDO
  87.  
  88.    SET COLOR TO
  89.    STORE .F. TO VALID
  90.  
  91.    @ 04,00 CLEAR
  92.    SET COLOR TO I+*
  93.    @ 10,25 SAY ' *** PRINTING LABELS *** '
  94.    SET COLOR TO
  95.    STORE '                          ' TO PAD
  96.  
  97.    STORE 1 TO LOOP
  98.    SET PRINT ON
  99.  
  100.    SET CONSOL OFF
  101.    STORE TRIM(DESCRI) TO SHORTD
  102.    STORE LEN(SHORTD) TO L
  103.    STORE SUBSTR(PARTNO,4,8) TO SHORTP
  104.  
  105.    DO WHILE LOOP <= LABELS
  106.  
  107.        ? '        *** '+MCODE+' *** '
  108.        ? ' '
  109.  
  110.        IF SUBSTR(PARTNO,1,2)='  '
  111.          ? '          '+SHORTP
  112.        ELSE
  113.          ? '        '+PARTNO
  114.        ENDIF
  115.  
  116.        IF LEN(SHORTD) < 27
  117.          ? SUBSTR(PAD,1,14-(L/2))+SHORTD
  118.        ELSE
  119.          ? DESCRI
  120.        ENDIF
  121.  
  122.        ? '  DECUS PRICE - $ '+STR(PRICE,8,2)
  123.        STORE LOOP+1 TO LOOP
  124.        ? ' '
  125.    ENDDO
  126.    STORE 1 TO LOOP
  127.    SET PRINT OFF
  128.    SET CONSOLE ON
  129. ENDDO
  130.