home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / SAMPLE / CUSTLIST.PRG < prev    next >
Encoding:
Text File  |  1989-11-06  |  4.6 KB  |  183 lines
  1. * ┌─────────────────────────────────────────────────────────────────────┐ *
  2. * │  CUSTLIST.PRG: CUSTOMER LIST                                        │ *
  3. * │  Copyright (c) 1989 Tech III, Inc. All rights reserved.             │ *
  4. * │  Tech III of San Pedro, California      (213) 547-2191.             │ *
  5. * │  "The bridge connecting people and technology."(tm)                 │ *
  6. * └─────────────────────────────────────────────────────────────────────┘ *
  7. * FILE HANDLING
  8. @ 00,00 SAY WINTITLE(PROMPT())
  9.  
  10. SELECT customer
  11.  
  12. DEFINE POPUP company FROM 10,20 PROMPT FIELD company
  13. ON SELECTION POPUP company DEACTIVATE POPUP
  14.  
  15. * INITIALIZE VARIABLES
  16. SET ORDER TO cus_com   && Company-name order
  17. GO TOP
  18. STORE company TO start_co && Top company name
  19. GO BOTTOM
  20. STORE company TO end_co && Bottom company name
  21. STORE '' TO pagestr
  22. STORE 1 TO mpage
  23. STORE .t. TO _box, _wrap, printing
  24. * Boxes, and word-wrapping ON, Printing is a control variable to allow
  25. * user to cancel the job.
  26.  
  27. STORE .f. TO done
  28. STORE SET('MEMOWIDTH') TO memocols  && Save old setting
  29. SET MEMOWIDTH TO 40
  30.  
  31. * DEFINITIONS
  32. ON ESCAPE STORE .f. TO printing
  33.  
  34. STORE 60 TO _plength
  35.  
  36. * USER INPUT: SELECT CUSTOMER RANGE TO PRINT
  37. STORE 'N' TO okay
  38. DO WHILE .NOT. okay $ 'YC'
  39.   @ 03,02 SAY 'Start with company:  '
  40.   @ 03,25 GET start_co VALID GETFIRST(start_co)
  41.   @ 05,02 SAY '  End with company:  '
  42.   @ 05,25 GET end_co   VALID GETLAST(end_co) ;
  43.   RANGE TRIM(start_co),
  44.   @ 07,02 SAY 'Okay? Yes/No/Cancel:  ' GET okay PICTURE '@M Y,N,C'
  45.   READ
  46. ENDDO
  47. IF okay = 'C' && cancel
  48.   RETURN
  49. ENDIF
  50.  
  51. IF .NOT. YESNO("System is ready to print.")
  52.   RETURN
  53. ELSE
  54.   IF .NOT. READY2PR()
  55.     STORE .f. TO printing
  56.   ENDIF
  57. ENDIF
  58.  
  59. IF .NOT. printing
  60.   DO standby WITH 'You have canceled this report.'
  61. ELSE
  62.   SEEK start_co
  63.   
  64.   * START PRINTING
  65.   SET PRINT ON
  66.   SET CONSOLE OFF
  67.   ACTIVATE WINDOW pticker
  68.   
  69.   PRINTJOB
  70.     ON PAGE
  71.     DO prn_head
  72.     SCAN REST WHILE printing .AND. company <= end_co
  73.       IF PROW() > 52
  74.         DO prn_foot
  75.       ENDIF
  76.       ?
  77.       ?? PTICKER() + cust_id AT 2
  78.       ?? PTICKER() + company AT 10
  79.       IF taxrate # 0
  80.         ?? PTICKER() + 'TAX RATE: ' + TRANSFORM(taxrate,'99.99') AT 50
  81.       ENDIF
  82.       ? PTICKER() + REPL('─',LEN(TRIM(company))) AT 10
  83.       IF PROW() > 52
  84.         DO prn_foot
  85.       ENDIF
  86.       IF .NOT. EMPTY(address1)
  87.         ? PTICKER() + address1 AT 10
  88.         IF PROW() > 52
  89.           DO prn_foot
  90.         ENDIF
  91.       ENDIF
  92.       IF .NOT. EMPTY(city + state + zip)
  93.         ? PTICKER() + TRIM(city) + ', ' + state + '  ' + zip AT 10
  94.         IF PROW() > 52
  95.           DO prn_foot
  96.         ENDIF
  97.       ENDIF
  98.       ?
  99.       IF PROW() > 52
  100.         DO prn_foot
  101.       ENDIF
  102.       IF MEMLINES(comments) # 0
  103.         IF MIN(MEMLINES(comments),7) + PROW() > 52
  104.           DO prn_foot
  105.         ENDIF
  106.         DEFINE BOX FROM 10 TO 53 HEIGHT MIN(MEMLINES(comments),7) + 2 SINGLE
  107.         FOR x = 1 TO MIN(MEMLINES(comments),7)
  108.           ? PTICKER() + MLINE(comments,x) AT 12
  109.         ENDFOR
  110.         ?
  111.       ENDIF
  112.       ? REPLICATE('─',80)
  113.     ENDSCAN
  114.     STORE .t. TO done
  115.   ENDPRINTJOB
  116.   
  117.   SET PRINTER OFF
  118.   SET CONSOLE ON
  119.   DEACTIVATE WINDOW pticker
  120.   DO standby WITH 'Your print request has been completed.'
  121. ENDIF
  122.  
  123. SET MEMOWIDTH TO memocols
  124. RETURN
  125.  
  126.  
  127. PROCEDURE prn_head   && HEADINGS
  128.   STORE 0 TO _plineno, _pcolno
  129.   DEFINE BOX FROM 00 TO 79 HEIGHT 3 AT LINE 0 DOUBLE
  130.   STORE LTRIM(STR(mpage,3)) TO pagestr
  131.   ?  "CUSTOMER LIST           This page begins with the " + UPPER(LEFT(company,1)) + "'s" + SPACE(14-LEN(pagestr)) + "PAGE:  " + pagestr AT 3
  132.   ?
  133.   ?
  134.   ? REPLICATE('─',80)
  135.   ?
  136.   RETURN
  137.   
  138. PROCEDURE prn_foot  && FOOTERS
  139.   ?
  140.   DEFINE BOX FROM 00 TO 79 HEIGHT 3 DOUBLE
  141.   ? ' CUSTOMER LIST                  ' + DTOC(DATE()) + ' @ ' + LEFT(TIME(),5) + '                 ' + SPACE(3-LEN(pagestr)) + 'PAGE:  ' + pagestr AT 3
  142.   ?
  143.   ?
  144.   EJECT
  145.   STORE mpage+1 TO mpage
  146.   STORE _pageno + 1 TO _pageno
  147.   IF printing .AND. .NOT. done
  148.     DO prn_head
  149.   ENDIF
  150.   RETURN
  151.   
  152. FUNCTION getfirst
  153.   PARAMETER a_coname
  154.   SEEK a_coname
  155.   DO WHILE .NOT. FOUND()
  156.     keyboard LEFT(a_coname,1)
  157.     ACTIVATE POPUP company
  158.     IF EMPTY(PROMPT())
  159.       LOOP
  160.     ENDIF
  161.     STORE PROMPT() TO start_co
  162.     SEEK start_co
  163.   ENDDO
  164.   RETURN .t.
  165.   
  166. FUNCTION getlast
  167.   PARAMETER a_coname
  168.   SEEK a_coname
  169.   DO WHILE .NOT. FOUND()
  170.     SET FILTER TO company >= start_co
  171.     keyboard LEFT(a_coname,1)
  172.     ACTIVATE POPUP company
  173.     IF EMPTY(PROMPT())
  174.       LOOP
  175.     ENDIF
  176.     STORE PROMPT() TO end_co
  177.     SEEK end_co
  178.   ENDDO
  179.   SET FILTER TO
  180.   RETURN .t.
  181.   
  182.   * EOF
  183.