home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / DATABASE / LASERPRO.ZIP / LASERPRO.PRG < prev    next >
Encoding:
Text File  |  1991-05-26  |  10.4 KB  |  309 lines
  1. * Program-id.....: LaserPro.PRG
  2. * Author.........: Pinter Consulting Staff (Originally LASERLIB.PRG)
  3. * Revised........: 2/28/91 by Richard Elliott, Ferret Software
  4. * Purpose........: HP LaserJet II Procedure Library for Foxpro
  5. * Usage..........: SET PROCEDURE TO LaserPro
  6.  
  7. * ---------------------------------------------------------
  8.  
  9. PROCEDURE Init_Print
  10.  
  11. * PRINTER CONTROL VARIABLES
  12. * Usage: ??? variable_name
  13. * DO Init_Print first to set global variables
  14.  
  15.    PUBLIC ESC, reset, clearfonts, portrait, landscape, uline_on, uline_off, pop, push
  16.    PUBLIC bold_on, bold_off, ital_on, ital_off, courier, lineprint
  17.    PUBLIC sym_pc8, sym_pc8dn, sym_pc850, sym_rm8, sym_ecma
  18.    PUBLIC pitch_10, pitch_12, pitch_17, tmargin, lmargin, printport
  19.  
  20.    ESC        = CHR(27)
  21.    reset      = ESC + 'E'                && Reset printer
  22.    clearfonts = ESC + '*c0F'             && Clear ALL fonts
  23.    portrait   = ESC + "&l0O"             && Portrait page orientation
  24.    landscape  = ESC + "&l1O"             && Landscape page orientation
  25.    uline_on   = ESC + "&d1D"             && Underline, fixed, on
  26.    uline_off  = ESC + "&d@"              && Underline off
  27.    pop        = ESC + "&f1S"
  28.    push       = ESC + "&f0S"
  29.    bold_on    = ESC + "(s3B"             && Bold type
  30.    bold_off   = ESC + "(s0B"             && Normal type
  31.    ital_on    = ESC + "(s1S"             && Italics on
  32.    ital_off   = ESC + "(s0S"             && Normal upright font
  33.    courier    = ESC + "(s3T"             && Courier typeface
  34.    lineprint  = ESC + "(s0T"             && Lineprinter typeface
  35.    sym_pc8    = ESC + "(10U"             && PC-8 symbol set
  36.    sym_pc8dn  = ESC + "(11U"             && PC-8DN symbol set
  37.    sym_pc850  = ESC + "(12U"             && PC-850 symbol set
  38.    sym_rm8    = ESC + "(8U"              && ROMAN-8 symbol set
  39.    sym_ecma   = ESC + "(0N"              && ECMA symbol set
  40.    pitch_10   = ESC + "(s10h12V"         && Includes 12 point height
  41.    pitch_12   = ESC + "(s12h10V"         && Includes 10 point height
  42.    pitch_17   = ESC + "(s16.66h8.5V"     && Includes 8.5 point height
  43.  
  44.    ** SYSTEM PRINTING VARIABLES
  45.  
  46.    tmargin    = 0                        && In inches, change as needed
  47.    lmargin    = 0                        && In inches, change as needed
  48.    printport  = "LPT1"                   && Assign default printer port
  49.  
  50. RETURN
  51.  
  52. * ---------------------------------------------------------
  53.  
  54. FUNCTION Box
  55. PARAMETERS top_row , bottom_row, left_col, right_col , _thick
  56.  
  57.    ** Use as: ??? BOX(top_row, botom_row, left_col, right_col, thickness)
  58.    ** First four parameters are in inches from top or left of page.
  59.    ** The last parameter is thickness in decipoints (720 decipoints = 1 inch!)
  60.  
  61.    _height = (bottom_row - top_row )                 && determine line lengths
  62.    _width  = (right_col  - left_col) + (_thick/720)  && Adjustment for corner
  63.  
  64.    top_    = HLINE( top_row    , left_col   , _width  , _thick )
  65.    left_   = VLINE( top_row    , left_col   , _height , _thick )
  66.    bottom_ = HLINE( bottom_row , left_col   , _width  , _thick )
  67.    right_  = VLINE( top_row    , right_col  , _height , _thick )
  68.  
  69. RETURN top_ + left_ + bottom_ + right_
  70.  
  71. * ---------------------------------------------------------
  72.  
  73. FUNCTION Copies
  74. PARAMETERS num_copies
  75.  
  76.    ** Use as: ??? COPIES(number_of_copies)
  77.  
  78. RETURN ESC+"&l"+ALLTRIM(STR(num_copies))+"X"
  79.  
  80. * ---------------------------------------------------------
  81.  
  82. FUNCTION Internal
  83. PARAMETERS _font
  84.  
  85.    ** Use as: ??? INTERNAL(font_number)
  86.    ** Modify to add any other internal font available
  87.  
  88.    DO CASE
  89.       CASE _font = 1  && PORTRAIT  COURIER
  90.          string_= portrait+ESC+"(10U"+ESC+"(s0p10h12v0s0b3T"
  91.       CASE _font = 2  && PORTRAIT  COMPRESSED
  92.          string_= portrait+ESC+"(10U"+ESC+"(s0p16.66h8.5v0s0b0T"
  93.       CASE _font = 3  && PORTRAIT  BOLD
  94.          string_= portrait+ESC+"(10U"+ESC+"(s0p10h12v0s3b3T"
  95.       CASE _font = 4  && LANDSCAPE COURIER
  96.          string_= landscape+ESC+"(10U"+ESC+"(s0p10h12v0s0b3T"
  97.       CASE _font = 5  && LANDSCAPE COMPRESSED
  98.          string_= landscape+ESC+"(10U"+ESC+"(s0p16.66h8.5v0s0b0T"
  99.       CASE _font = 6  && LANDSCAPE BOLD
  100.          string_= landscape+ESC+"(10U"+ESC+"(s0p10h12v0s3b3T"
  101.    ENDCASE
  102.  
  103. RETURN string_
  104.  
  105. * ---------------------------------------------------------
  106.  
  107. FUNCTION Lpi
  108. PARAMETERS lpi_num
  109.  
  110.    ** Use as: ??? LPI(lpi_number)
  111.  
  112. RETURN ESC + '&l' + ALLTRIM(STR(lpi_num)) + 'D'
  113.  
  114. * ---------------------------------------------------------
  115.  
  116. FUNCTION VLine
  117. PARAMETERS _line , _col , _len , _thick
  118.  
  119.    ** Use as: ??? VLINE(start_line_number, start_column_number, length, thickness)
  120.    ** Line, column and length number are in inches
  121.    ** Top line is 0, to column is 0
  122.  
  123.    line_   = STR(( 720 * (_line + tmargin )) , 4 )   && Les has a 75 dot adjustment
  124.    col_    = STR(( 720 * (_col  + lmargin )) , 4 )   && I removed and use margin vars.
  125.    len_    = STR(( 720 * _len  ) , 4 )               && Pesonal preference, I prefer
  126.    thick_  = STR(  _thick        , 4 )               && absolute measures where possible
  127.  
  128.    curs_   = ESC + '&a' + line_ + "v" + col_ + "H"
  129.    spec_   = ESC + "*c" + len_ + "v" + thick_ + "H"
  130.    prin_   = ESC + "*c" + "0P"
  131.  
  132. RETURN curs_ + spec_ + prin_
  133.  
  134. * ---------------------------------------------------------
  135.  
  136. FUNCTION HLine
  137. PARAMETERS _line , _col , _len , _thick
  138.  
  139.    ** Use as: ??? HLINE(start_line_number, start_column_number, length, thickness)
  140.  
  141.    line_   = STR(( 720 * _line ) , 4 )         && Convert inches to decipoints
  142.    col_    = STR(( 720 * _col  ) , 4 )         && etc.
  143.    len_    = STR(( 720 * _len  ) , 4 )         && etc.
  144.    thick_  = STR(  _thick        , 4 )
  145.  
  146.    curs_   = ESC + "&a" + line_ + "v" + col_ + "H"
  147.    spec_   = ESC + "*c" + thick_ + "v" + len_ + "H"
  148.    prin_   = ESC + "*c" + "0P"
  149.  
  150. RETURN  curs_ + spec_ + prin_
  151.  
  152. * ---------------------------------------------------------
  153.  
  154. FUNCTION Grid
  155. PARAMETERS top_row , bottom_row, left_col, right_col , _grid
  156.  
  157.    ** Use as: ??? GRID(top_row_start, bottom_row_start, left_column, ;
  158.    **                  right_column, type_of_grid)
  159.    **
  160.    ** Avilable grid types:  1 = Horizontal lines
  161.    **                       2 = Vertical lines
  162.    **                       3 = Diagonal lines 1
  163.    **                       4 = Diagonal lines 2
  164.    **                       5 = Square grid
  165.    **                       6 = Diagonal grid
  166.    ** See BOX() explanation for more info
  167.  
  168.    _height = (bottom_row - top_row )
  169.    _width  = (right_col  - left_col)
  170.  
  171.    _row_   = LTRIM(STR(((  top_row + tmargin ) * 720 ) , 4 ))
  172.    _col_   = LTRIM(STR((( left_col + lmargin ) * 720 ) , 4 ))
  173.    _high_  = LTRIM(STR(( _height * 720 ) , 4 ))
  174.    _len_   = LTRIM(STR((  _width * 720 ) , 4 ))
  175.  
  176.    loc_    = ESC   + "&a"  + _row_  + "v" + _col_ + "H"
  177.    info_   = ESC   + "*c"  + _high_ + "v" + _len_ + "H"
  178.    grid_   = ESC   + "*c"  + STR(_grid,2) + "G"
  179.    last_   = ESC   + "*c"  + "3P"
  180.  
  181. RETURN loc_  + info_ + grid_ + last_
  182.  
  183. * ---------------------------------------------------------
  184.  
  185. FUNCTION Shading
  186. PARAMETERS top_row , bottom_row, left_col, right_col , _shading
  187.  
  188.    ** Use as: ??? SHADING(top_row_start, bottom_row_start, left_column, ;
  189.    **                  right_column, %_shading)
  190.  
  191.    _height = (bottom_row - top_row )
  192.    _width  = (right_col  - left_col)
  193.  
  194.    _row_   = LTRIM(STR(((  top_row + tmargin ) * 720 ) , 4 ))
  195.    _col_   = LTRIM(STR((( left_col + lmargin ) * 720 ) , 4 ))
  196.    _high_  = LTRIM(STR(( _height * 720 ) , 4 ))
  197.    _len_   = LTRIM(STR((  _width * 720 ) , 4 ))
  198.  
  199.    loc_    = ESC   + "&a"  + _row_  + "v" + _col_ + "H"
  200.    info_   = ESC   + "*c"  + _high_ + "v" + _len_ + "H"
  201.    shad_   = ESC   + "*c"  + STR(_shading,2) + "G"
  202.    last_   = ESC   + "*c"  + "2P"
  203.  
  204. RETURN loc_  + info_ + shad_ + last_
  205.  
  206. * ---------------------------------------------------------
  207.  
  208. FUNCTION SoftFont
  209. PARAMETERS _font_
  210.  
  211.    ** Use as: ??? SOFTFONT(font_id_number)
  212.    ** Fonts must be preloaded with FontLoad() or external program
  213.  
  214. RETURN ESC + "(" + RIGHT(STR(100000+_font_,6),5) + "X"
  215.  
  216.  
  217. * ---------------------------------------------------------
  218.  
  219. FUNCTION FontLoad
  220. PARAMETERS font_name,_font_,print_port
  221.  
  222.    ** Use as: ??? FONTLOAD(font_file,font_id_number,printer_port)
  223.  
  224.    ??? ESC + "*c" + RIGHT(STR(100000+_font_,6),5) + "D"  &&
  225.    !COPY &font_name /B &print_port /B > nul        && font_name may include path
  226.    ??? ESC + "*c5F"                                 && Make font "permanent"
  227.  
  228. RETURN ''
  229.  
  230. * ---------------------------------------------------------
  231.  
  232. FUNCTION SayIt
  233. PARAMETERS _down , _over , _text, _pict
  234.  
  235.    ** Use as: ??? SayIt(inches_down, inches_over, text_to_print, picture_clause)
  236.  
  237.    _type = TYPE("_text")
  238.    DO CASE
  239.       CASE _type = "C" .OR. _type = "D" .OR. _type = "L"
  240.          DO CASE
  241.             CASE _type = "D"
  242.                text_ = DTOC(_text)
  243.             CASE _type = "L"
  244.                IF _text
  245.                   text_ = "Y"
  246.                ELSE
  247.                   text_ = "N"
  248.                ENDIF
  249.             OTHERWISE
  250.                text_ = _text
  251.          ENDCASE
  252.       CASE _type = "N"
  253.          text_ = LTRIM(TRANSFORM(_text,_pict))
  254.       OTHERWISE
  255.          text_ = 'TYPE ERROR'
  256.    ENDCASE
  257.  
  258.    _row    = STR(( 720 * ( _down + tmargin )) , 4 )
  259.    _col    = STR(( 720 * ( _over + lmargin )) , 4 )
  260.  
  261. RETURN ESC + "&a" + _row + "v" + _col + "H" + text_
  262.  
  263. * ---------------------------------------------------------
  264.  
  265. FUNCTION MacroID
  266. PARAMETERS id_
  267.  
  268.    ** Use as: ??? MACROID(macro_id_number)
  269.  
  270. RETURN  ESC + "&f" + LTRIM(STR(id_,10)) + CHR(89)
  271.  
  272. * ---------------------------------------------------------
  273.  
  274. FUNCTION MacroCtl
  275. PARAMETERS func_
  276.  
  277.   *0 Start macro definition
  278.   *1 Stop macro definition
  279.   *2 Execute macro
  280.   *3 Call macro
  281.   *4 Enable auto overlay
  282.   *5 Disable auto overlay
  283.   *6 Delete all macros
  284.   *7 Delete all temp macros
  285.   *8 Delete macro
  286.   *9
  287.   *10 Make macro perm
  288.  
  289. RETURN ESC + "&f" + LTRIM(STR(func_,10)) + CHR(88)
  290.  
  291. * ---------------------------------------------------------
  292.  
  293. PROCEDURE LineLoop
  294. PARAMETERS LineMax, StartLine, StartCol, LineWidth, _Lpi
  295.  
  296.    ** Use as: DO LineLoop WITH max_lines, start_line, start_column,
  297.    **                          line_width, lines_per_inch
  298.  
  299.    i = 1
  300.    height_ = ROUND(1/_lpi,3)
  301.    DO WHILE (i*height_) <= LineMax
  302.       ??? HLINE ( ( (i*height_) + StartLine) , StartCol , LineWidth, 1 )
  303.       i = i + 1
  304.    ENDDO
  305.  
  306. RETURN
  307.  
  308. * ---------------------------------------------------------
  309.