home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / print / print.bas
Encoding:
BASIC Source File  |  1991-05-22  |  6.3 KB  |  167 lines
  1. 10 'PERSONAL COMPUTER AGE PRINTER UTILITY
  2. 20 '
  3. 30 '
  4. 40 '************************************************************************
  5. 50 '
  6. 60 DEFINT A-Z
  7. 70 CLS
  8. 80 KEY OFF
  9. 90 CLOSE
  10. 100 '
  11. 110 'DEFINE AND INTIALIZE VARIABLES USED TO PRINT BANNER
  12. 120 C = 0            ' COLUMN
  13. 130 DIM CC(9)        'CHARACTER CODE FOR EACH CHARACTER IN FILE NAME
  14. 140 CP = 0           'CHARACTER POSITION
  15. 150 D = 0            'DOT
  16. 160 DA = 0           'DOT ADDRESS
  17. 170 L = 0           ' LENGTH OF FILE NAME
  18. 180 M = 0            ' MASK
  19. 190 DIM PL(131)      'PRINT LINE
  20. 200 PS = 64          'SYMBOL TO PRINT (64 -@)
  21. 210 R = 0            'ROW
  22. 220 '
  23. 230 'DEFINE AND INITALIZE VARIABLES USED TO PRINT THE FILE
  24. 240 LINE.CTR = 0     'COUNTS LINES ON A PAGE
  25. 250 PAGE.CTR = 1     'COUNTS PAGES
  26. 260 LINES.PG = 66    'LINES ON A PAGE, TOTAL
  27. 270 LINES.PRT = 60   'LINES ON A PAGE, PRINTED
  28. 280 FIRST.LINE = 1   'FIRST LINE IN FILE TO PRINT
  29. 290 LAST.LINE = 30000' LAST LINE IN FILE TO PRINT
  30. 300 CUR.LINE = 1     'CURRENT LINE NUMBER (IN FILE) BEING PRINTED
  31. 310 '
  32. 320 'THE FOLLOWING ARE FLAGS. 1= TRUE, 0= FALSE
  33. 330 BANNER = 1       'PRINT THE FILE NAME AS A BANNER
  34. 340 PRINT.COMP = 0   'SET PRINTER TO COMPRESSED MODE
  35. 350 '
  36. 360 'CONSTANTS
  37. 370 FORM.FEED = &HC
  38. 380 '
  39. 390 '*************************************************************************
  40. 400 'PICK UP THE ATTRIBUTES
  41. 410 '
  42. 420 'FILE NAME
  43. 430 ON ERROR GOTO 450
  44. 440 GOTO 470             'JUMP OVER ERROR ROUTINE
  45. 450 PRINT "THAT FILE DOES NOT EXIST. PLEASE REENTER."
  46. 460 RESUME 490
  47. 470 PRINT TAB(20); "PRINTER UTILITY": PRINT
  48. 480 PRINT "THIS IS A PROGRAM TO PRINT A BANNER FOR A PROGRAM FILE LISTING": PRINT
  49. 490 PRINT : LINE INPUT "FILE NAME (INCLUDE EXTENSION): "; FILE.NAME$
  50. 500 OPEN FILE.NAME$ FOR INPUT AS #1
  51. 510 '
  52. 520 'FIRST LINE
  53. 530 ON ERROR GOTO 550
  54. 540 GOTO 580              'JUMP OVER ERROR MESSAGE
  55. 550 RESUME 560
  56. 560 PRINT "YOUR RESPONSE MUST BE A NUMBER BETWEEN 1 AND 30000."
  57. 570 PRINT "PLEASE REENTER."
  58. 580 PRINT : PRINT "FIRST LINE TO PRINT ("; FIRST.LINE; "): ";
  59. 590 LINE INPUT TEMP$: FIRST.LINE = VAL(TEMP$)
  60. 600 IF FIRST.LINE = 0 THEN FIRST.LINE = 1
  61. 610 IF FIRST.LINE <> 1 THEN BANNER = 0
  62. 620 IF (FIRST.LINE < 1) OR (FIRST.LINE > 30000) THEN GOTO 560
  63. 630 '
  64. 640 'LAST LINE
  65. 650 ON ERROR GOTO 670
  66. 660 GOTO 700           'JUMP OVER ERROR MESSAGE
  67. 670 RESUME 680
  68. 680 PRINT "YOUR RESPONSE MUST BE A NUMBER BETWEEN 1 AND 30000 AND MUST BE"
  69. 690 PRINT "GREATER THAN THE FIRST LINE. PLEASE REENTER."
  70. 700 PRINT : PRINT "LAST LINE TO PRINT ("; LAST.LINE; "): ";
  71. 710 LINE INPUT TEMP$: IF TEMP$ = "" THEN GOTO 730
  72. 720 LAST.LINE = VAL(TEMP$)
  73. 730 IF LAST.LINE <> 30000 THEN BANNER = 0
  74. 740 IF (LAST.LINE <= FIRST.LINE) OR (LAST.LINE > 30000) THEN GOTO 680
  75. 750 ON ERROR GOTO 0
  76. 760 '
  77. 770 'COMPRESSED PRINTING?
  78. 780 PRINT : LINE INPUT "COMPRESSED PRINTING? (N): "; TEMP$
  79. 790 IF (TEMP$ = "Y") OR (TEMP$ = "y") THEN PRINT.COMP = 1
  80. 800 '
  81. 810 'PICK UP FILE DATE
  82. 820 DEF SEG
  83. 830 DAY=PEEK(VARPTR(#1)+21)
  84. 840 YEAR=PEEK(VARPTR(#1)+22)
  85. 850 MONTH = ((YEAR AND 1) * 8) + ((DAY AND 224) / 32)
  86. 860 MONTH$ = MID$(STR$(MONTH), 2)
  87. 870 YEAR = ((YEAR AND 254) / 2) + 80
  88. 880 YEAR$ = MID$(STR$(YEAR), 2)
  89. 890 DAY = DAY AND 31
  90. 900 DAY$ = MID$(STR$(DAY), 2)
  91. 910 FILE.DATE$ = MONTH$ + "/" + DAY$ + "/" + YEAR$
  92. 920 '
  93. 930 'PICK UP FILE NAME, STRIP DEVICE, AND CONVERT TO UPPER CASE
  94. 940 L = LEN(FILE.NAME$)
  95. 950 FOR I = 1 TO LEN(FILE.NAME$)
  96. 960      TEMP = ASC(MID$(FILE.NAME$, I, 1))
  97. 970      IF TEMP = ASC(".") THEN L = I - 1
  98. 980      IF TEMP = ASC(":") THEN FILE.NAME$ = MID$(FILE.NAME$, (I + 1)): GOTO 940
  99. 990      IF TEMP > 96 THEN TEMP = TEMP - 32
  100. 1000      MID$(FILE.NAME$, I, 1) = CHR$(TEMP): NEXT I
  101. 1010 '
  102. 1020 'PRINT THE BANNER
  103. 1030 'RESTORE PRINTER DEFAULT CHARACTERISTICS
  104. 1040 LPRINT CHR$(20): LPRINT CHR$(27) + "F": LPRINT CHR$(27) + "H"
  105. 1050 IF BANNER = 0 THEN GOTO 1380
  106. 1060 'POINT DATA SEGMENT TO ROM
  107. 1070 DEF SEG = &HF000
  108. 1080 'SET PRINTER TO COMPRESSED MODE, 132 CHARACTERS PER LINE
  109. 1090 LPRINT CHR$(15); : WIDTH "LPT1:", 132
  110. 1100 'PRINT TOP BORDER
  111. 1110 LPRINT : LPRINT : LPRINT : LPRINT STRING$(131, 45)
  112. 1120 FOR I = 0 TO 2: LPRINT STRING$(131, "*"): NEXT I
  113. 1130 LPRINT : LPRINT : LPRINT
  114. 1140 'INITIALIZE CHARACTER MASK
  115. 1150 J = 256
  116. 1160 FOR I = 1 TO 8
  117. 1170      J = J / 2: M(I - 1) = J
  118. 1180      IF I <= L THEN CC(I) = ASC(MID$(FILE.NAME$, I, 1))
  119. 1190      NEXT I
  120. 1200 FOR R = 0 TO 7
  121. 1210      FOR I = 0 TO 130: PL(I) = 32: NEXT I
  122. 1220      IF L > 7 THEN CP = 66 - (L * 8) ELSE CP = 66 - (L * 9)
  123. 1230      FOR X = 1 TO L
  124. 1240            DA = &HFA6E + (CC(X) * 8)
  125. 1250            FOR C = 0 TO 14 STEP 2
  126. 1260                 D = PEEK(DA + R): IF (D AND M(C / 2)) = 0 THEN GOTO 1280
  127. 1270                 PL(CP + C) = PS: PL(CP + C + 1) = PS
  128. 1280                 NEXT C
  129. 1290            IF L > 7 THEN CP = CP + 16 ELSE CP = CP + 18: NEXT X
  130. 1300      FOR I = 0 TO 130: LPRINT CHR$(PL(I)); : NEXT I
  131. 1310      LPRINT : NEXT R
  132. 1320 LPRINT : LPRINT
  133. 1330 FOR I = 0 TO 2: LPRINT STRING$(131, "*"): NEXT I
  134. 1340 LPRINT STRING$(131, 45): LPRINT CHR$(18); : WIDTH "LPT1:", 80
  135. 1350 LPRINT : LPRINT "FILE: " + FILE.NAME$: LPRINT "DATE: " + FILE.DATE$
  136. 1360 LPRINT CHR$(FORM.FEED)
  137. 1370 '
  138. 1380 'PRINT THE FILE
  139. 1390 IF PRINT.COMP = 1 THEN LPRINT CHR$(15); : WIDTH "LPT1:", 132
  140. 1400 ON ERROR GOTO 0
  141. 1410 'PREPARE PAGE HEADER
  142. 1420 SPACES = (70 - (LEN(FILE.NAME$) + LEN(FILE.DATE$))) / 2
  143. 1430 IF PRINT.COMP = 1 THEN SPACES = SPACES + 26
  144. 1440 HEADER$ = FILE.DATE$ + SPACE$(SPACES) + FILE.NAME$ + SPACE$(SPACES) + "PAGE "
  145. 1450 'ADVANCE TO FIRST LINE TO PRINT
  146. 1460 IF FIRT.LINE = 1 THEN GOTO 1510
  147. 1470 FOR CUR.LINE = 1 TO FIRST.LINE - 1
  148. 1480     IF EOF(1) THEN GOTO 1640
  149. 1490     LINE INPUT #1, TEMP$: NEXT CUR.LINE
  150. 1500 '
  151. 1510 'PRINT TO LAST LINE
  152. 1520       PAGE = 1
  153. 1530 ON ERROR GOTO 1620
  154. 1540 FOR CUR.LINE = FIRST.LINE TO LAST.LINE
  155. 1550     IF EOF(1) THEN GOTO 1640
  156. 1560     IF LINE.CTR = 0 THEN LPRINT HEADER$; PAGE:                                        PAGE = PAGE + 1: LINE.CTR = LINE.CTR + 4: LPRINT : LPRINT : LPRINT
  157. 1570     LINE INPUT #1, TEMP$: LPRINT TEMP$: LINE.CTR = LINE.CTR + 1
  158. 1580     IF LINE.CTR < LINES.PRT THEN GOTO 1600
  159. 1590     LPRINT CHR$(FORM.FEED): LINE.CTR = 0
  160. 1600     NEXT CUR.LINE
  161. 1610  GOTO 1640                 'SKIP OVER TIMEOUT ERROR HANDLING
  162. 1620  IF ERR = 24 THEN RESUME    'ERROR 24 CAUSED BY DEVICE TIMEOUT
  163. 1630  '
  164. 1640 'CLEAN UP
  165. 1650 LPRINT CHR$(FORM.FEED): LPRINT CHR$(18); : CLOSE #1: SYSTEM
  166.  
  167.