Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : LASER.ZIP
Filename : LASER.PRG

*********
*
* laser.prg
*
* HP LaserJet Routines to draw lines and boxes.
*
* Written 12/89 by
* Kevin Talbot
* KJT enterprises
* 7632 SE 37th Place
* Mercer Island, WA 98040
* (206) 236-1060
* Compuserve ID: 75706,316
*
* These are "public domain" and are free for anyone to use or modify.
* Acknowledgement of the author would be appreciated.


* Notes:
*
* All coordinates, lengths, widths, etc., for functions assume INCHES.
*
* All "drawing" functions start with the current cursor position, so be
* sure to "lj_gotoxy()" before calling a "draw" function.
*
* All functions assume that "set print on" has been set previously as they
* all use the "??" command to send data to the printer. You may also want to
* "set console off" so the screen is not filled with lots of funny escape
* codes.
*
* All functions save and restore the current prow() and pcol() values so
* accuracy of "@ r,c" commands directed to the printer is maintained. These
* functions all send tons of escape codes to the printer which really fouls
* up the interal printer cursor positon pointer in Clipper! I have found
* it MUCH easier to dispense with '@ r,c' when using a laser printer and
* use the 'lj_say()' function instead. Since the LaserJet is a page printer,
* you can move the printer cursor anywhere you want without triggering a
* form feed from Clipper just because you moved the printe cursor 'back' or
* 'up' from the present position.
*
* The LaserJet fill patterns are specified as strings just as they
* are defined in the LaserJet technical manual. The fill pattern can be
* one of 7 shades of gray plus white and black or one of six regular line
* patterns. These routines differentiate between "gray" and "pattern" by
* having a pattern number prefix with a "#".
*
* Gray shades are specified as follows:
* "0" = 0% gray (white, only supported on the new LaserJet IIP!)
* "1".."2" = 2% gray
* "3".."10" = 10% gray
* "11".."20" = 20% gray
* "21".."35" = 30% gray
* "36".."55" = 45% gray
* "56".."80" = 70% gray
* "81".."99" = 90% gray
* "100" = 100% gray (black)
*
* Patterns are specified as follows:
* "#1" = horizontal lines
* "#2" = vertical lines
* "#3" = diagonal lines running from lower left to upper right
* "#4" = diagonal lines running from upper left to lower right
* "#5" = orthogonal crosshatch (like #1 and #2 combined)
* "#6" = diagonal crosshatch (like #3 and #4 combined)
*
******************************************************************************
******************************************************************************


* Function summary:

* lj_inch2dots(inches) Convert inches to printer dots
* lj_gotoxy(x,y) Absolute position in inches
* lj_gotorc(r,c) Absolute position in columns
* lj_move(delta_x,delta_y) Relative move
* lj_fill(width,height,fill) Fills rectangular area
* lj_line(length,thickness,orientation,fill) Draws lines
* lj_box(width,height,thickness,fill) Draws boxes
* lj_say(row,col,string) Just like "@ R,C say..."

* These arguments are real numbers (inches:
* width, length, thickness, height, x, y, delta_x, delta_y, inches

* These arguments are character strings:
* fill, orientation, string

* These arguments are integers:
* row, col



*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* FUNCTION NAME: lj_inch2dots ³
* PARAMETERS: inches ³
* RETURNS: Character string of the integer equivalent printer dots ³
* at 300 DPI. ³
* DESCRIPTION: Obvious. Mainly intended for internal use. ³
* EXAMPLE: foo = lj_inch2dots(3.56) [returns the string "1068"] ³
*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

function lj_inch2dots
parameters inches
return alltrim(str(300.0 * inches,10))




*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* FUNCTION NAME: lj_gotoxy ùÄÄ> +x ³
* PARAMETERS: x & y location in inches ³ ³
* RETURNS: Nothing. V +y ³
* DESCRIPTION: Moves LJ cursor to the absolute x and y values passed. ³
* EXAMPLE: lj_gotoxy(4.25,5.5) [about the middle of the page] ³
*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

function lj_gotoxy
parameters x, y && real numbers in inches
private null, row
null = ""
** save Clipper printer position pointer
row = prow()
col = pcol()
?? chr(27) + "*p" + lj_inch2dots(x) + "x" + lj_inch2dots(y) + "Y"
** restore Clipper printer position pointer
setprc(row,col) && restore printer row and col
return null




*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* FUNCTION NAME: lj_move ùÄÄ> +x ³
* PARAMETERS: deltax, deltay (in inches) ³ ³
* RETURNS: Nothing. V +y ³
* DESCRIPTION: Moves LJ "cursor" a relative amount. ³
* EXAMPLE: lj_move(1.0,-2.5) moves the cursor right 1.0" and up 2.5" ³
* NOTE: Positive amounts move the cursor right or down, negative ³
* move the cursor left or up. ³
*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ


function lj_move
parameters dx, dy && real numbers in inches
private null, row, col
null = ""
** save Clipper printer position pointer
row = prow()
col = pcol()
?? chr(27) + "*p" + if(dx >= 0.0,"+","") + lj_inch2dots(dx) + "x" + ;
if(dy >= 0.0,"+","") + lj_inch2dots(dy) + "Y"
** restore Clipper printer position pointer
setprc(row,col)
return null





*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* FUNCTION NAME: lj_fill ³
* PARAMETERS: width, height, fill ³
* RETURNS: Nothing. ³
* DESCRIPTION: Fills a rectangular area with the specified pattern at the ³
* current cursor positon. Specify a gray pattern by passing ³
* a string between "0" and "100" (0=white, 100=black, 1..99 ³
* are levels of gray) or specify a fill pattern with "#1" ³
* "#6". ³
* EXAMPLE: lj_fill(1.5, 2.5,"#6") will create a 1.5" wide by 2.5" ³
* high rectangle filled with HP pattern 6 (crosshatching). ³
*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

function lj_fill
parameters width, height, fill
private null, row, col, s
null = ""
* cleanup parameters
fill = alltrim(fill)
** save Clipper printer position pointer
row = prow()
col = pcol()
s = chr(27) + "*c" && PCL prefix for area fill
s = s + lj_inch2dots(width) + "a" && spec horizontal size....
s = s + lj_inch2dots(height) + "b" && spec vertical size....
if left(fill,1) == "#" && fixed pattern is desired
s = s + right(fill,1) + 'g3P' && so strip the "#" character
else && some shade of gray requested
if val(fill) = 0 && "white" is spec'd differently
s = s + 'g1P' && white fill is LJ IIP specific!
else && gray or black fill
s = s + fill + 'g2P'
endif
endif
?? s && now send the entire string
setprc(row,col) && restore Clipper printer position pointer
return null



*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* FUNCTION NAME: lj_line ³
* PARAMETERS: length, thickness, orientation, fill ³
* RETURNS: Nothing. ³
* DESCRIPTION: Draws lines as specified either horizontal or vertical ³
* at the current cursor position with the specified fill ³
* pattern. ³
* NOTE: A negative length will draw a line to the left ³
* or up from the current cursor position. ³
* EXAMPLE: lj_line(2.5, .01, "H", "20") ³
* ³
* ùÄÄÄÄÄÄÄ¿Â ù¿Â ³
* ÀÄÄÄÄÄÄÄÙÅ "H" orientation ³³³ ³
* ÃÄÄ L ÄÄ´³ ³³L "V" orientation ³
* À T ³³³ ³
* ÀÙÁ ³
* ÃÅÄÄÄ T ³
* ["ù" is the current cursor position] ³
*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

function lj_line
parameters length, thickness, orientation, fill
private null
null = ""
* clean up parameters
thickness = abs(thickness)
orientation = upper(left(alltrim(orientation),1))
fill = alltrim(fill)
* figure out how far (relative) we have to move first
* then use the lj_fill() function to do most of the work
do case
case orientation = "H"
if length >= 0.0
lj_fill(length, thickness, fill) && draw to the right
else
lj_move(length, 0.0) && move left first
lj_fill(abs(length), thickness, fill)
endif
case orientation = "V"
if length >= 0.0
lj_fill(thickness, length, fill) && draw downward
else
lj_move(0.0, length) && move up first
lj_fill(thickness, abs(length), fill)
endif
endcase
return null




*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* FUNCTION NAME: lj_box ³
* PARAMETERS: width, height, thickness, pattern ³
* RETURNS: Nothing. ³
* DESCRIPTION: Draws a rectangular box at the current cursor postion. ³
* The current cursor position is the uppe left hand corner. ³
* EXAMPLE: lj_box(4.0,1.0,.02,"20") will draw a box 4" wide, 1" high ³
* with .02" wide lines of 20% gray ³
* NOTE: Using a gray pattern with thin lines (2 or 3 printer dots) ³
* sometimes results in invisible lines if you happen to be ³
* filling with the "white" part of the gray pattern! ³
*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

function lj_box
parameters width, height, thickness, pattern
private null
null = ""
* cleanup parameters
width = abs(width)
height = abs(height)
thickness = abs(thickness)
pattern = upper(alltrim(pattern))
lj_line(width,thickness,"H",pattern) && draw top line first
lj_line(height,thickness,"V",pattern) && left side line
lj_move(width-thickness,0.0) && move to the right side
lj_line(height,thickness,"V", pattern) && right side line
lj_move(thickness,height-thickness) && move over and down
lj_line(-width,thickness,"H",pattern) && finally, the bottom line
return null



*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* FUNCTION NAME: lj_gotorc ³
* PARAMETERS: row and comlumn location (in characters) ³
* RETURNS: Nothing. ³
* DESCRIPTION: Moves LJ cursor to the absolute r and c values (0,0 = upper ³
* left corner of logical page ³
* EXAMPLE: lj_gotoxy(40,30) [about the middle of the page] ³
*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

function lj_gotorc
parameters r, c && assume these are integers
private null, row, rs, cs
null = ""
** save Clipper printer position pointer
row = prow()
col = pcol()
rs = ltrim(str(r,4))
cs = ltrim(str(c,4))
?? chr(27) + "&a" + rs + "r" + cs + "C"
setprc(row,col) && restore printer row and col
return null



*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* FUNCTION NAME: lj_say (as in "@ r,c say...") ³
* PARAMETERS: row, column, string (in characters) ³
* RETURNS: Nothing. ³
* ³
* DESCRIPTION: Moves LJ cursor to the absolute r and c values (0,0 = upper ³
* left corner of logical page and prints the string. ³
* EXAMPLE: lj_gotoxy(40,30,"Hello") [about the middle of the page] ³
*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

function lj_say
parameters r, c, string && integer columns
private null
null = ""
** save Clipper printer position pointer
row = prow()
col = pcol()
lj_gotorc(r,c)
?? string
** restore Clipper printer position pointer
setprc(row,col)
return null