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

* Program-id.....: LaserPro.PRG
* Author.........: Pinter Consulting Staff (Originally LASERLIB.PRG)
* Revised........: 2/28/91 by Richard Elliott, Ferret Software
* Purpose........: HP LaserJet II Procedure Library for Foxpro
* Usage..........: SET PROCEDURE TO LaserPro

* ---------------------------------------------------------

PROCEDURE Init_Print

* PRINTER CONTROL VARIABLES
* Usage: ??? variable_name
* DO Init_Print first to set global variables

PUBLIC ESC, reset, clearfonts, portrait, landscape, uline_on, uline_off, pop, push
PUBLIC bold_on, bold_off, ital_on, ital_off, courier, lineprint
PUBLIC sym_pc8, sym_pc8dn, sym_pc850, sym_rm8, sym_ecma
PUBLIC pitch_10, pitch_12, pitch_17, tmargin, lmargin, printport

ESC = CHR(27)
reset = ESC + 'E' && Reset printer
clearfonts = ESC + '*c0F' && Clear ALL fonts
portrait = ESC + "&l0O" && Portrait page orientation
landscape = ESC + "&l1O" && Landscape page orientation
uline_on = ESC + "&d1D" && Underline, fixed, on
uline_off = ESC + "&d@" && Underline off
pop = ESC + "&f1S"
push = ESC + "&f0S"
bold_on = ESC + "(s3B" && Bold type
bold_off = ESC + "(s0B" && Normal type
ital_on = ESC + "(s1S" && Italics on
ital_off = ESC + "(s0S" && Normal upright font
courier = ESC + "(s3T" && Courier typeface
lineprint = ESC + "(s0T" && Lineprinter typeface
sym_pc8 = ESC + "(10U" && PC-8 symbol set
sym_pc8dn = ESC + "(11U" && PC-8DN symbol set
sym_pc850 = ESC + "(12U" && PC-850 symbol set
sym_rm8 = ESC + "(8U" && ROMAN-8 symbol set
sym_ecma = ESC + "(0N" && ECMA symbol set
pitch_10 = ESC + "(s10h12V" && Includes 12 point height
pitch_12 = ESC + "(s12h10V" && Includes 10 point height
pitch_17 = ESC + "(s16.66h8.5V" && Includes 8.5 point height

** SYSTEM PRINTING VARIABLES

tmargin = 0 && In inches, change as needed
lmargin = 0 && In inches, change as needed
printport = "LPT1" && Assign default printer port

RETURN

* ---------------------------------------------------------

FUNCTION Box
PARAMETERS top_row , bottom_row, left_col, right_col , _thick

** Use as: ??? BOX(top_row, botom_row, left_col, right_col, thickness)
** First four parameters are in inches from top or left of page.
** The last parameter is thickness in decipoints (720 decipoints = 1 inch!)

_height = (bottom_row - top_row ) && determine line lengths
_width = (right_col - left_col) + (_thick/720) && Adjustment for corner

top_ = HLINE( top_row , left_col , _width , _thick )
left_ = VLINE( top_row , left_col , _height , _thick )
bottom_ = HLINE( bottom_row , left_col , _width , _thick )
right_ = VLINE( top_row , right_col , _height , _thick )

RETURN top_ + left_ + bottom_ + right_

* ---------------------------------------------------------

FUNCTION Copies
PARAMETERS num_copies

** Use as: ??? COPIES(number_of_copies)

RETURN ESC+"&l"+ALLTRIM(STR(num_copies))+"X"

* ---------------------------------------------------------

FUNCTION Internal
PARAMETERS _font

** Use as: ??? INTERNAL(font_number)
** Modify to add any other internal font available

DO CASE
CASE _font = 1 && PORTRAIT COURIER
string_= portrait+ESC+"(10U"+ESC+"(s0p10h12v0s0b3T"
CASE _font = 2 && PORTRAIT COMPRESSED
string_= portrait+ESC+"(10U"+ESC+"(s0p16.66h8.5v0s0b0T"
CASE _font = 3 && PORTRAIT BOLD
string_= portrait+ESC+"(10U"+ESC+"(s0p10h12v0s3b3T"
CASE _font = 4 && LANDSCAPE COURIER
string_= landscape+ESC+"(10U"+ESC+"(s0p10h12v0s0b3T"
CASE _font = 5 && LANDSCAPE COMPRESSED
string_= landscape+ESC+"(10U"+ESC+"(s0p16.66h8.5v0s0b0T"
CASE _font = 6 && LANDSCAPE BOLD
string_= landscape+ESC+"(10U"+ESC+"(s0p10h12v0s3b3T"
ENDCASE

RETURN string_

* ---------------------------------------------------------

FUNCTION Lpi
PARAMETERS lpi_num

** Use as: ??? LPI(lpi_number)

RETURN ESC + '&l' + ALLTRIM(STR(lpi_num)) + 'D'

* ---------------------------------------------------------

FUNCTION VLine
PARAMETERS _line , _col , _len , _thick

** Use as: ??? VLINE(start_line_number, start_column_number, length, thickness)
** Line, column and length number are in inches
** Top line is 0, to column is 0

line_ = STR(( 720 * (_line + tmargin )) , 4 ) && Les has a 75 dot adjustment
col_ = STR(( 720 * (_col + lmargin )) , 4 ) && I removed and use margin vars.
len_ = STR(( 720 * _len ) , 4 ) && Pesonal preference, I prefer
thick_ = STR( _thick , 4 ) && absolute measures where possible

curs_ = ESC + '&a' + line_ + "v" + col_ + "H"
spec_ = ESC + "*c" + len_ + "v" + thick_ + "H"
prin_ = ESC + "*c" + "0P"

RETURN curs_ + spec_ + prin_

* ---------------------------------------------------------

FUNCTION HLine
PARAMETERS _line , _col , _len , _thick

** Use as: ??? HLINE(start_line_number, start_column_number, length, thickness)

line_ = STR(( 720 * _line ) , 4 ) && Convert inches to decipoints
col_ = STR(( 720 * _col ) , 4 ) && etc.
len_ = STR(( 720 * _len ) , 4 ) && etc.
thick_ = STR( _thick , 4 )

curs_ = ESC + "&a" + line_ + "v" + col_ + "H"
spec_ = ESC + "*c" + thick_ + "v" + len_ + "H"
prin_ = ESC + "*c" + "0P"

RETURN curs_ + spec_ + prin_

* ---------------------------------------------------------

FUNCTION Grid
PARAMETERS top_row , bottom_row, left_col, right_col , _grid

** Use as: ??? GRID(top_row_start, bottom_row_start, left_column, ;
** right_column, type_of_grid)
**
** Avilable grid types: 1 = Horizontal lines
** 2 = Vertical lines
** 3 = Diagonal lines 1
** 4 = Diagonal lines 2
** 5 = Square grid
** 6 = Diagonal grid
** See BOX() explanation for more info

_height = (bottom_row - top_row )
_width = (right_col - left_col)

_row_ = LTRIM(STR((( top_row + tmargin ) * 720 ) , 4 ))
_col_ = LTRIM(STR((( left_col + lmargin ) * 720 ) , 4 ))
_high_ = LTRIM(STR(( _height * 720 ) , 4 ))
_len_ = LTRIM(STR(( _width * 720 ) , 4 ))

loc_ = ESC + "&a" + _row_ + "v" + _col_ + "H"
info_ = ESC + "*c" + _high_ + "v" + _len_ + "H"
grid_ = ESC + "*c" + STR(_grid,2) + "G"
last_ = ESC + "*c" + "3P"

RETURN loc_ + info_ + grid_ + last_

* ---------------------------------------------------------

FUNCTION Shading
PARAMETERS top_row , bottom_row, left_col, right_col , _shading

** Use as: ??? SHADING(top_row_start, bottom_row_start, left_column, ;
** right_column, %_shading)

_height = (bottom_row - top_row )
_width = (right_col - left_col)

_row_ = LTRIM(STR((( top_row + tmargin ) * 720 ) , 4 ))
_col_ = LTRIM(STR((( left_col + lmargin ) * 720 ) , 4 ))
_high_ = LTRIM(STR(( _height * 720 ) , 4 ))
_len_ = LTRIM(STR(( _width * 720 ) , 4 ))

loc_ = ESC + "&a" + _row_ + "v" + _col_ + "H"
info_ = ESC + "*c" + _high_ + "v" + _len_ + "H"
shad_ = ESC + "*c" + STR(_shading,2) + "G"
last_ = ESC + "*c" + "2P"

RETURN loc_ + info_ + shad_ + last_

* ---------------------------------------------------------

FUNCTION SoftFont
PARAMETERS _font_

** Use as: ??? SOFTFONT(font_id_number)
** Fonts must be preloaded with FontLoad() or external program

RETURN ESC + "(" + RIGHT(STR(100000+_font_,6),5) + "X"


* ---------------------------------------------------------

FUNCTION FontLoad
PARAMETERS font_name,_font_,print_port

** Use as: ??? FONTLOAD(font_file,font_id_number,printer_port)

??? ESC + "*c" + RIGHT(STR(100000+_font_,6),5) + "D" &&
!COPY &font_name /B &print_port /B > nul && font_name may include path
??? ESC + "*c5F" && Make font "permanent"

RETURN ''

* ---------------------------------------------------------

FUNCTION SayIt
PARAMETERS _down , _over , _text, _pict

** Use as: ??? SayIt(inches_down, inches_over, text_to_print, picture_clause)

_type = TYPE("_text")
DO CASE
CASE _type = "C" .OR. _type = "D" .OR. _type = "L"
DO CASE
CASE _type = "D"
text_ = DTOC(_text)
CASE _type = "L"
IF _text
text_ = "Y"
ELSE
text_ = "N"
ENDIF
OTHERWISE
text_ = _text
ENDCASE
CASE _type = "N"
text_ = LTRIM(TRANSFORM(_text,_pict))
OTHERWISE
text_ = 'TYPE ERROR'
ENDCASE

_row = STR(( 720 * ( _down + tmargin )) , 4 )
_col = STR(( 720 * ( _over + lmargin )) , 4 )

RETURN ESC + "&a" + _row + "v" + _col + "H" + text_

* ---------------------------------------------------------

FUNCTION MacroID
PARAMETERS id_

** Use as: ??? MACROID(macro_id_number)

RETURN ESC + "&f" + LTRIM(STR(id_,10)) + CHR(89)

* ---------------------------------------------------------

FUNCTION MacroCtl
PARAMETERS func_

*0 Start macro definition
*1 Stop macro definition
*2 Execute macro
*3 Call macro
*4 Enable auto overlay
*5 Disable auto overlay
*6 Delete all macros
*7 Delete all temp macros
*8 Delete macro
*9
*10 Make macro perm

RETURN ESC + "&f" + LTRIM(STR(func_,10)) + CHR(88)

* ---------------------------------------------------------

PROCEDURE LineLoop
PARAMETERS LineMax, StartLine, StartCol, LineWidth, _Lpi

** Use as: DO LineLoop WITH max_lines, start_line, start_column,
** line_width, lines_per_inch

i = 1
height_ = ROUND(1/_lpi,3)
DO WHILE (i*height_) <= LineMax
??? HLINE ( ( (i*height_) + StartLine) , StartCol , LineWidth, 1 )
i = i + 1
ENDDO

RETURN

* ---------------------------------------------------------