home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 September
/
Simtel20_Sept92.cdr
/
msdos
/
dbase
/
shade2.arc
/
SHADE2.PRG
Wrap
Text File
|
1989-02-23
|
20KB
|
636 lines
*******************************************************************************
* Shade2.prg
*
*
*
*
* the following program was written as part of a larger system for a client
* of mine. I extracted a portion of the print routine to show some of the
* nice tricks the hp laserjet series II is capable of.
*
* Shaded Boxes are an easy answer to readability questions when you are
* creating a densly formated Form. With experimentation boxes & fill areas
* can be shaped & shaded with very little trouble.
*
* The only real problem I ran into with this was implementing it on a
* 3com network - using either CTRL-ALT-* from the keyboard or issuing a
* ESC E (printer reset) from within the program had predictable and unhappy
* consequences for subsequent pages printed in a particular job stream
*
* I got the inspiration for this from a file uploaded by:
*
* Chris Dunford
* The Cove Software Group
* CompuServe 76703,2002
*
* Prepared for:
* CompuServe IBMNET
* 02/01/89
*
*
*
* Since he explains the process much better than I could. I have included
* his file (shade.txt in DL 0 of IBMHW Forum) as part of the comments
* following.
*
*
* if you have any questions or comments you can reach me at
*
* Kevin Loucks
* CompuServe 76276,1333
*
*
*
*******************************************************************************
*___________________SHADE.TXT from DL 0 of IBMHW Forum_________________________
* "Green-bar" paper on a LaserJet II
* ----------------------------------
*
* This document explains how to shade every other line of a LaserJet
* II-printed report so that the result is similar to that produced on
* "green bar" paper stock. This makes it easier to read reports such as
* data file listings, etc., where each line is a record.
*
*
* Printer functions required
* --------------------------
* The technique involves two basic LJ functions: cursor positioning and
* rectangular area filling. These are documented in the "LaserJet Series
* II Printer Technical Reference Manual", available at extra cost from
* Hewlett-Packard (Part No. 33440-90905).
*
* The area filling functions allow you to define a rectangular box and
* fill it with the pattern or shading level of your choice. We will use a
* box that is 8.5" wide and 1/6" high--the full width of the paper by one
* line high. It is then "filled" by shading.
*
* The cursor positioning functions move the "cursor", which is the active
* printing location--where the next character will print. It is analagous
* to a screen cursor. In essence, we will start at the upper left corner
* of the page and shade every other line by moving the cursor down two
* lines after each fill.
*
*
* Algorithm
* ---------
* The basic algorithm is:
*
* Save the "cursor" position
* Move the cursor to the upper left corner of the page
* Define the box characteristics
* Do 30 times
* Shade the box
* Move the cursor down two lines
* End do
* Restore the initial cursor position
*
* At the end of this process, every other line has been shaded. The
* character data is then sent to the printer as usual for printing.
*
*
* Specific functions used
* -----------------------
* "Ec" is an ASCII ESC character (decimal code 27, hex 1B). "#" is a
* variable value that is replaced by a numeric parameter (in ASCII: for
* example, "50" is transmitted by sending the ASCII characters "5" and
* "0").
*
* Note: the LJ-II commands show below have been simplified somewhat, i.e.,
* the definitions shown don't necessarily convey all possible formats of
* the commands given.
*
* 1. Cursor positioning
*
* a. Save/restore cursor position
*
* Ec&f0S
*
* This saves the current cursor position by pushing it onto a LIFO
* stack. It can be restored (popped) by the control string
*
* Ec&f1S
*
* The stack is large enough to save 20 cursor positions.
*
* b. Set cursor position (horizontal absolute, by dots)
*
* Ec*p#X
*
* The variable value # is the horizontal dot number. The
* leftmost dot on a row is dot 0, so the control string
*
* Ec*p0X
*
* moves the cursor to the left side of the page.
*
* c. Set cursor position (vertical absolute, by dots)
*
* Ec*p#Y
*
* The variable value # is the vertical dot number. The topmost
* dot row on the page is row 0. To put the cursor at the top of
* the page:
*
* Ec*p0Y
*
* d. Set cursor position (vertical relative, by rows)
*
* Ec&a#R
*
* The variable value is preceded by a plus or minus sign to
* indicate whether the cursor is to be moved up (-) or down (+) the
* specified number of rows. This moves the cursor down two rows:
*
* Ec&a+2R
*
*
* 2. Area filling
*
* a. Define box width (in dots)
*
* Ec*c#A
*
* To define a box 8.5" wide (8.5 x 300 = 2550 dots):
*
* Ec*c2550A
*
* Note that the printer will clip the box at the left and right
* margins.
*
* b. Define box height (in dots)
*
* Ec*c#B
*
* To define a box 1/6" (one line) high:
*
* Ec*c50B
*
* 1/6" at 300 dots per inch is 50 dots.
*
* c. Define shading level
*
* Ec*c#G
*
* The variable value # represents a shading level from 2% to 100%.
* The printer can actually print eight different levels, and there
* are some discrepancies in the HP manual regarding these levels.
* However, 2, 10, 15, 30, 45, 70, 90, and 100% would seem to
* represent the real levels. To set 15% shading:
*
* Ec*c15G
*
* I suggest 10% or 15% shading for the "green bar" paper.
*
* d. Print box as currently defined
*
* Ec*c2P
*
* This control string performs the gray scale fill using the area
* dimensions and fill level currently defined. The box is printed
* at the current cursor position; the cursor position is not
* changed. As always, no physical printing occurs until the page
* is filled with text data or a formfeed is received.
*
*
* Combining functions
* -------------------
* The LJ-II allows some concatenation of control strings. Strings may be
* concatenated if the first two characters following the ESC are the same:
*
* Ec*p#X
* Ec*p#Y
*
* If strings are combined, the trailing character for all control
* strings except the last one is lowercase, and the first three characters
* are omitted after the first string. For example, the three strings
*
* Ec*c2550A
* Ec*c50B
* Ec*c15G
*
* can be combined into one string as follows:
*
* Ec*c2550a50b15G
*
*
* Margins etc.
* ------------
* This document assumes that you're using 8.5 x 11 paper at 60 lines per
* page (i.e., with the default top and bottom margins), six lines per
* inch, in portrait mode. If you use anything else, you'll need to adjust
* some of the parameters.
*
* The left/right margins have no effect on the printing of the shaded
* rectangles, but the top margin and text length do. In other words, dot
* column 0 is an absolute position on the page, but dot row 0 is relative
* to the top margin. If you print shaded boxes beyond the bottom of the
* text area, a page eject will occur (and you'll have a shaded page
* with no text).
*
*
* Sample code
* -----------
* Each of the following code samples sends the following control sequences
* to the printer:
*
* Ec&f0S ; Save curpos
* Ec*p0x0Y ; Cursor to (0,0)
* Ec*c2550a50b10G ; Define box: 8.5" x 1/6", 10% shading
* (30 times:)
* Ec*c2P ; Print box
* Ec&a+2R ; Move down two lines
* Ec&f1S ; Restore curpos
*
* Some of these have been combined for greater efficiency.
*
* This code must be executed for each page printed, of course. If you are
* going to be printing many pages, it may be faster (especially in dBASE!)
* to contatenate 30 instances of Ec*c2PEc&a+2R into one string (and print
* it once per page) than to send the string to the printer thirty times
* for each page.
*
*
* BASIC:
* 100 EC$ = CHR$(27)
* 110 LPRINT EC$ + "&f0S" + EC$ + "*p0x0Y" + EC$ + "*c2550a50b10G";
* 120 FOR I = 1 TO 30: LPRINT EC$ + "*c2P" + EC$ + "&a+2R";: NEXT
* 130 LPRINT EC$ + "&f1S";
*
* C:
* int i;
* fprintf (stdprn, "\033&f0S\033*p0x0Y\033*c2550a50b10G");
* for (i=1; i <= 30; i++)
* fprintf (stdprn, "\033*c2P\033&a+2R");
* fprintf (stdprn, "\033&f1S");
*
* dBASE III+:
* set print on
* set console off
* Ec = chr(27)
* ?? Ec + "&f0S" + Ec + "*p0x0Y" + Ec + "*c2550a50b10G"
* i = 1
* do while i <= 30
* ?? Ec + "*c2P" + Ec + "&a+2R"
* i = i+1
* enddo
* ?? Ec + "&f1S"
* set print off
* set console on
*
* dBASE IV:
* ??? "{ESC}&f0S{ESC}*p0x0Y{ESC}*c2550a50b10G"
* i = 1
* do while i <= 30
* ??? "{ESC}*c2P{ESC}&a+2R"
* i = i+1
* enddo
* ??? "{ESC}&f1S"
*
* REXX:
* Ec = '1B'x
* call charout 'prn',Ec'&f0S'Ec'*p0x0Y'Ec'*c2550a50b10G'
* do 30
* call charout 'prn',Ec'*c2P'Ec'&a+2R'
* end
* call charout 'prn',Ec'&f1S'
*
*
* ===============================================
*
* Document by:
* Chris Dunford
* The Cove Software Group
* PO Box 1072
* Columbia, MD 21044
* 301/992-9371
* CompuServe 76703,2002
*
* Prepared for:
* CompuServe IBMNET
* 02/01/89
*
*
******************************************************************************
set talk off
mttype = 'NEW CUSTOMER Transmittal'
mheader = "Working Copy"
prtcopies = .t.
t_id = "89000122"
t_name = "American Factors Inc"
t_contac = "Danforth Qualye"
t_addr = "1600 Pensylvania"
t_cphone = "(612) 871-9461"
t_city = "DC"
t_state = "DC"
t_tzone = "E"
t_zip = "01100 "
t_access = 'D'
t_o_names = "joe and ---------------------------- susy"
t_name1 = "Mutual investments"
t_serv1 = "Monthly"
t_com1 = "first comment"
t_com2 = "2nd"
t_com3 = "3rd"
t_modem = "Hayes"
t_eqbaud = "1200"
t_hdware = "ps/2 70"
t_sftware = "procomm"
t_accph = "(612) 871-9461"
t_status = "OP"
t_srep = "VVV"
t_sadmn = "WWW"
t_pmngr = "XXX"
t_padmn = "YYY"
t_padmn_a = "02/03/89"
t_cas = "ZZZ"
t_cas_a = "02/03/89"
*ROCEDURE tmprt
*ARAMETERS mheader,prtcopies
mline = REPLICATE("─",80)
mline1 = '╔'+REPLICATE("═",78)+"╗"
mline2 = '╚'+REPLICATE("═",78)+"╝"
mline3 = '╟'+REPLICATE("─",78)+"╢"
muline = REPLICATE("_",80)
mcopies = 1
@ 0,0 clear
IF prtcopies
@ 24,0 SAY SPACE(80)
@ 24,5 SAY "How many copies would you like? " GET mcopies PICTURE '9'
READ
ELSE
mcopies = 1
ENDIF
IF mcopies = 0
RETURN
ENDIF
mheader1 = "Your Company"
mheader = "Transmittal: " + TRIM(UPPER(mheader))
mttype = TRIM(mttype)
mcol = (78 - LEN(mheader))/2
ec = CHR(27)
fillprt = "2g2P"
SET CONSOLE OFF
SET DEVICE TO PRINT
SET PRINT ON
?? ec + "&l0O"
?? ec + "&l2A"
?? ec + "&l6d"
?? ec + "&l"+LTRIM(STR(mcopies,1,0))+'X'
?? ec + "*p0x0Y" + ec + "&f0S"
* position for transmittal type
?? ec + "*p26x140Y"
?? ec + "*c2350a90b" + fillprt
fillprt = "15g2P"
* position for custof bank etc
?? ec + "*p300x265Y"
?? ec + "*c1400a150b"+ fillprt
* position for date entered
?? ec + "*p2100x265Y"
?? ec + "*c240a50b" + fillprt
* position for transmittal id
?? ec + "*p2100x360Y"
?? ec + "*c270a50b" + fillprt
* position for cust name, contact,addr
?? ec + "*p300x515Y"
?? ec + "*c900a150b" + fillprt
* position for phone numbers
?? ec + "*p1925x615Y"
?? ec + "*c445a150b" + fillprt
* position for city zip
?? ec + "*p300x665Y"
?? ec + "*c600a100b" + fillprt
* position for state time zone
?? ec + "*p1200x670Y"
?? ec + "*c285a100b" + fillprt
* position for effective date
?? ec + "*p450x965Y"
?? ec + "*c260a50b" + fillprt
* position for expires date
?? ec + "*p1200x965Y"
?? ec + "*c260a50b" + fillprt
* position for oper names
?? ec + "*p30x1115Y"
?? ec + "*c2325a50b" + fillprt
* position for acct, name, plan, base, item
?? ec + "*p30x1260Y"
?? ec + "*c2325a450b"+ fillprt
* position for comments
?? ec + "*p300x1810Y"
?? ec + "*c1830a150b"+ fillprt
* position for equipment
?? ec + "*p30x2110Y"
?? ec + "*c2325a50b" + fillprt
* position for salesrep
?? ec + "*p150x2265Y"
?? ec + "*c90a50b" + fillprt
* position for sales admin
?? ec + "*p450x2265Y"
?? ec + "*c90a50b" + fillprt
* position for prod manager
?? ec + "*p720x2265Y"
?? ec + "*c90a50b" + fillprt
* position for prod admin
?? ec + "*p1050x2265Y"
?? ec + "*c90a50b" + fillprt
* position for CAS id
?? ec + "*p1800x2265Y"
?? ec + "*c90a50b" + fillprt
* position for prod approve
?? ec + "*p1410x2265Y"
?? ec + "*c240a50b" + fillprt
* position for CAS approve
?? ec + "*p2130x2265Y"
?? ec + "*c240a50b" + fillprt
?? ec + "*p0x0Y" + ec + "&f0S"
?? ec + "(s16.66H"
@ 6, 0 SAY "Customer of "
@ 6,102 SAY "Date entered: "
@ 7, 0 SAY "Credit Ref...:"
@ 8, 0 SAY "Department...:"
@ 8,100 SAY "Transmittal ID:"
@ 11, 0 SAY "Customer Name: "
@ 12, 6 SAY "Contact:"
@ 12,102 SAY "Phone Numbers"
@ 13, 6 SAY "Address:"
@ 13,87 SAY "Customer Phone #"
@ 14, 6 SAY "City...:"
@ 14,58 SAY "State:"
@ 14,87 SAY "Customer Fax #"
@ 15, 6 SAY "Zip....:"
@ 15,54 SAY "Time Zone:"
@ 15,87 SAY "Sales Rep #"
@ 20, 2 SAY "Service Effective "
@ 20,47 SAY "Service Expires"
@ 22, 2 SAY "Operator Names "
@ 25, 2 SAY "Account #"
@ 25,25 SAY "Account Name"
@ 25,78 SAY "Service/Plan Base $ Items $ Std"
@ 37, 1 SAY "Comments: 1"
@ 38,11 SAY "2"
@ 39,11 SAY "3"
@ 42, 2 SAY "Modem"
@ 42,22 SAY "Baud"
@ 42,30 SAY "Hardware"
@ 42,57 SAY "Software"
@ 42,84 SAY "Access Method"
@ 42,100 SAY "Call Back phone #"
@ 42,125 SAY "Status"
@ 45,12 SAY "Sales"
@ 45,50 SAY "SERVICE"
@ 45,99 SAY "Accounts Services"
@ 46, 2 SAY "Rep Admin"
@ 46,33 SAY "Mngr Admin Approval"
@ 46,95 SAY "Id Approval"
?? ec + "(s10H"
?? ec + "&f1S"
?? ec + "(1X" && select soft font
?? ec + "(s1S" && select italics
@ PROW() + 2,0 SAY "Y O U R C O M P A N Y" && print logo-like info
?? ec + "*p0x0Y" + ec + "&f0S" && reset cursor position
?? ec + "(10U" && reset default font
?? ec + "(s0S" && select upright
@ PROW() + 1,80 - LEN(mheader) SAY mheader
@ PROW() + 1,55 SAY "Credit Query Service"
@ PROW() + 1, 0 SAY mline1
@ PROW() + 1, 0 SAY "║"
@ PROW() ,(80 - LEN(mttype))/2 + 1 SAY mttype
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY mline2
?? ec + "(s3B"
@ PROW() + 1,10 SAY 'Mike S.'
@ PROW() ,70 SAY "02/24/89"
@ PROW() + 1,10 SAY '99999999-9'
@ PROW() ,22 SAY 'Your neighborhood credit reference'
@ PROW() + 1,10 SAY "042-88"
@ PROW() ,22 SAY "Credit Validation"
@ PROW() ,70 SAY TRANSFORM(t_id,'@r 99-999999')
@ PROW() + 2,0 SAY mline
@ PROW() + 1,10 SAY t_name
@ PROW() + 1,10 SAY t_contac
@ PROW() ,50 SAY "╔══════════ ══════════╗"
@ PROW() + 1,10 SAY t_addr
@ PROW() ,50 SAY "║"
@ PROW() ,64 SAY t_cphone
@ PROW() ,79 SAY "║"
@ PROW() + 1,10 SAY t_city
@ PROW() ,40 SAY t_state
@ PROW() ,50 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1,10 SAY t_zip
DO CASE
CASE t_tzone = 'E'
@ PROW(),40 SAY "Eastern"
CASE t_tzone = 'C'
@ PROW(),40 SAY "Central"
CASE t_tzone = 'M'
@ PROW(),40 SAY "Mountain"
CASE t_tzone = 'P'
@ PROW(),40 SAY "Pacific"
CASE t_tzone = 'H'
@ PROW(),40 SAY "Hawaii"
ENDCASE
@ PROW() ,50 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1,50 SAY "╚════════════════════════════╝"
@ PROW() + 3,0 SAY mline1
@ PROW() + 1, 0 SAY "║"
@ PROW() ,15 SAY "02/28/89"
@ PROW() ,40 SAY "09/30/92"
@ PROW() ,79 SAY "║"
@ PROW() + 1,0 SAY mline3
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() , 1 SAY t_o_names
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY mline3
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() , 1 SAY "9999999999999"
@ PROW() ,15 SAY t_name1
@ PROW() ,46 SAY t_serv1
@ PROW() ,58 SAY '999.99'
@ PROW() ,66 SAY '99.9999'
@ PROW() ,76 SAY "Y"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1,0 SAY mline2
@ PROW() + 2,10 SAY t_com1
@ PROW() + 1,10 SAY t_com2
@ PROW() + 1,10 SAY t_com3
@ PROW() + 2,0 SAY mline1
@ PROW() + 1, 0 SAY "║"
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "║"
@ PROW() , 1 SAY t_modem
@ PROW() ,13 SAY t_eqbaud
@ PROW() ,18 SAY t_hdware
@ PROW() ,34 SAY t_sftware
if t_access = 'D'
@ PROW() ,50 SAY "Direct"
endif
if t_access = 'C'
@ PROW() ,50 SAY "Call Back"
endif
@ PROW() ,60 SAY t_accph
@ PROW() ,76 SAY t_status
@ PROW() ,79 SAY "║"
@ PROW() + 1, 0 SAY "╟──────────────────┬────────────────────────────────────┬──────────────────────╢"
@ PROW() + 1, 0 SAY "║ │ │ ║"
@ PROW() + 1, 0 SAY "║ │ │ ║"
@ PROW() , 5 SAY t_srep
@ PROW() ,15 SAY t_sadmn
@ PROW() ,24 SAY t_pmngr
@ PROW() ,35 SAY t_padmn
@ PROW() ,47 SAY t_padmn_a
@ PROW() ,60 SAY t_cas
@ PROW() ,71 SAY t_cas_a
@ PROW() + 1,0 SAY mline2
@ PROW() ,19 SAY '╧'
@ PROW() ,56 SAY '╧'
?? ec + "(s0B"
eject
SET DEVICE TO SCREEN
SET PRINT OFF
SET CONSOLE ON
RETURN