home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / printing.swg / 0032_HP Laser Jet Functions.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  7.3 KB  |  336 lines
  1. UNIT HPUnit;
  2. { Handles all aspects of HP LASER JET PRINTERS}
  3.  
  4. INTERFACE
  5.  
  6. USES
  7.  Crt,
  8.  Dos;
  9.  
  10. CONST
  11.  Esc       = #27;
  12.  HPReset   = #27'E';
  13.  
  14. (* Page sizes... *)
  15.  Executive       = #27'&l1A';
  16.  Letter          = #27'&l2A';
  17.  Legal           = #27'&l3A';
  18.  A4              = #27'&l26A';
  19.  Monarch         = #27'&l80A';
  20.  Commercial10    = #27'&l81A';
  21.  InternationalDL = #27'&l90A';
  22.  InternationalCS = #27'&l91A';
  23.  
  24.  (* orintation *)
  25.  
  26.  Portrait  = #27'&l0O';
  27.  Landscape = #27'&l1O';
  28.  
  29.  (* symbol set... *)
  30.  
  31.  HpRoman8  = #27'(8U';
  32.  PC8       = #27'(10U';
  33.  
  34.  (* spacQcing... *)
  35.  
  36.  Fixed     = #27'(s0P';
  37.  Proportional = #27'(s1P';
  38.  
  39.  (* style... *)
  40.  
  41.  Upright   = #27'(s0S';
  42.  Italic    = #27'(s1S';
  43.  
  44.  (* stroke... *)
  45.  
  46.  Medium    = #27'(s0B';
  47.  Bold      = #27'(s1B';
  48.  
  49.  (* typeface... *)
  50.  
  51.  Lineprinter = #27'(s0T';
  52.  Courier     = #27'(s3T';
  53.  Helv        = #27'(s4T';
  54.  TmsRoman    = #27'(s5T';
  55.  LetterGothic = #27'(s6T';
  56.  Prestige    = #27'(s8T';
  57.  Presentations = #27'(s11T';
  58.  Optima      = #27'(s17T';
  59.  TCGaramond  = #27'(s18T';
  60.  CooperBlack = #27'(s19T';
  61.  CooperBold  = #27'(s20T';
  62.  Broadway    = #27'(s21T';
  63.  BauerBodoniBlackCondensed = #27'(s22T';
  64.  CenturySchoolBook         = #27'(s23T';
  65.  UniversityRoman           = #27'(s24T';
  66.  
  67.  StartUnderLine = #27'&d0D';
  68.  StopUnderLine = #27'&d@';
  69.  
  70. (*  functions and procedures ...  *)
  71.  
  72. FUNCTION  Copies (CopyCount : INTEGER) : STRING;
  73. FUNCTION  LinesPerPage (LineCount : INTEGER) : STRING;
  74. FUNCTION  LinesPerInch (LineCount : INTEGER) : STRING;
  75. FUNCTION  PrimaryPitch (Pitch : INTEGER) : STRING;
  76. FUNCTION  PointSize (Points : REAL) : STRING;
  77. FUNCTION  PitchSize (Pitch : REAL) : STRING;
  78. FUNCTION  AbsHorizPos (Inches : REAL) : STRING;
  79. FUNCTION  AbsVertPos (Inches : REAL) : STRING;
  80. PROCEDURE PlotXY (VAR PrnFile : TEXT;X, Y : REAL);
  81. PROCEDURE PlotX (VAR PrnFile : TEXT; X : REAL);
  82. PROCEDURE PlotY (VAR PrnFile : TEXT;Y : REAL);
  83. FUNCTION  FontId (Id : INTEGER) : STRING;
  84. FUNCTION  FontStatus (ID : INTEGER; Status : CHAR) : STRING;
  85. FUNCTION  FontPrimORSec (ID : INTEGER; Status : CHAR) : STRING;
  86. PROCEDURE DownloadFont (FontFileName : STRING; Id : INTEGER; Status : CHAR;
  87.                         StatusX, StatusY, StatusFore, StatusBack : INTEGER);
  88. PROCEDURE EjectPage (VAR PrnFile : TEXT);
  89.  
  90. IMPLEMENTATION
  91.  
  92. CONST
  93.  BlockSize = 4096;
  94.  
  95. TYPE
  96.  BufferType = ARRAY [0..BlockSize - 1] OF BYTE;
  97.  
  98. VAR
  99.  St : STRING;
  100.  
  101. PROCEDURE WriteAT (x, y, f, b : BYTE; s : STRING);
  102.  
  103. VAR
  104.   cnter  : WORD;
  105.   vidPtr : ^WORD;
  106.   attrib : WORD;
  107.  
  108. BEGIN
  109.   attrib := SWAP ( (b SHL 4) + f);
  110.   vidptr := PTR ($B800, 2 * (80 * PRED (y) + PRED (x) ) );
  111.   IF lastmode = 7 THEN
  112.      DEC (LONGINT (vidptr), $08000000);  { MONO ?? }
  113.   FOR cnter := 1 TO LENGTH (s) DO
  114.   BEGIN
  115.     vidptr^ := attrib OR BYTE (s [cnter]);
  116.     INC (vidptr);
  117.   END;
  118. END;
  119.  
  120.  
  121. FUNCTION Realstr (Num : REAL; D : BYTE) : STRING;
  122. { Return a string value (width 'w')for the input real ('n') }
  123.   VAR
  124.     Stg : STRING;
  125.   BEGIN
  126.     STR (Num : 10 : D, Stg);
  127.     WHILE Stg [1] = #32 DO DELETE (Stg, 1, 1);
  128.     Realstr := Stg;
  129.   END;
  130.  
  131. FUNCTION IntStr (Num : LONGINT) : STRING;
  132.   VAR
  133.     Stg : STRING;
  134.   BEGIN
  135.     STR (Num : 10, Stg);
  136.     WHILE Stg [1] = #32 DO DELETE (Stg, 1, 1);
  137.     IntStr := Stg;
  138.   END;
  139.  
  140.  
  141. PROCEDURE Dta2Prn (BufferAddr : POINTER;
  142.                    BufferSize : LONGINT); EXTERNAL;
  143.  
  144. {$L Dta2Prn.OBJ}
  145.  
  146. FUNCTION Copies;
  147.  
  148. (* Get the string for the copycount...   *)
  149.  
  150. BEGIN
  151.  STR (CopyCount, St);
  152.  Copies := Esc + '&l' + St + 'X';
  153. END;
  154.  
  155. FUNCTION LinesPerPage;
  156.  
  157. BEGIN
  158.  STR (LineCount, St);
  159.  LinesPerPage := Esc + '&l' + St + 'F';
  160. END;
  161.  
  162. FUNCTION LinesPerInch;
  163.  
  164. BEGIN
  165.  STR (LineCount, St);
  166.  LinesPerInch := Esc + '&l' + St + 'D';
  167. END;
  168.  
  169. FUNCTION PrimaryPitch;
  170.  
  171. BEGIN
  172.  STR (Pitch, St);
  173.  PrimaryPitch := Esc + '(s' + St + 'H';
  174. END;
  175.  
  176. FUNCTION PointSize;
  177.  
  178. BEGIN
  179.  St := RealStr (Points, 2);
  180.  PointSize := Esc + '(s' + St + 'V';
  181. END;
  182.  
  183. FUNCTION PitchSize;
  184.  
  185. BEGIN
  186.  St := RealStr (Pitch, 2);
  187.  PitchSize := Esc + '(s' + St + 'H'
  188. END;
  189.  
  190. FUNCTION AbsHorizPos;
  191.  
  192. VAR
  193.  Dots : REAL;
  194.  DotSt : STRING;
  195.  
  196. BEGIN
  197.  Dots := Inches * 300;
  198.  STR (ROUND (Dots), DotSt);
  199.  AbsHorizPos := Esc + '*p' + DotSt + 'X';
  200. END;
  201.  
  202. FUNCTION AbsVertPos;
  203.  
  204. VAR
  205.  Dots : REAL;
  206.  DotSt : STRING;
  207.  
  208. BEGIN
  209.  Dots := Inches * 300;
  210.  STR (ROUND (Dots), DotSt);
  211.  AbsVertPos := Esc + '*p' + DotSt + 'Y';
  212. END;
  213.  
  214. PROCEDURE PlotXY (VAR PrnFile : TEXT; X, Y : REAL);
  215.  
  216. BEGIN
  217.  WRITE (PrnFile, AbsHorizPos (X) );
  218.  WRITE (PrnFile, AbsVertPos (Y) );
  219. END;
  220.  
  221. PROCEDURE PlotX (VAR PrnFile : TEXT; X : REAL);
  222.  
  223. BEGIN
  224.  WRITE (PrnFile, AbsHorizPos (X) );
  225. END;
  226.  
  227. PROCEDURE PlotY (VAR PrnFile : TEXT; Y : REAL);
  228.  
  229. BEGIN
  230.  WRITE (PrnFile, AbsVertPos (Y) );
  231. END;
  232.  
  233. FUNCTION FontID;
  234.  
  235. VAR
  236.  IdSt : STRING;
  237.  
  238. BEGIN
  239.  STR (Id, IdSt);
  240.  FontID := Esc + '*c' + IdSt + 'D';
  241. END;
  242.  
  243. FUNCTION FontPrimORSec;
  244.  
  245. (* Is the font you're about to send primary or secondary?  Send  *)
  246. (*   the function 'P' or 'S'                                     *)
  247.  
  248. VAR
  249.  IdSt : STRING;
  250.  
  251. BEGIN
  252.  Status := UPCASE (Status);
  253.  STR (Id, IdSt);
  254.  CASE Status OF
  255.   'P' : FontPrimORSec := Esc + '(' + IdSt + 'X';
  256.   'S' : FontPrimORSec := Esc + ')' + IdSt + 'X'
  257.   ELSE FontPrimORSec := '';
  258.  END; (* Case *)
  259. END;
  260.  
  261. FUNCTION FontStatus;
  262.  
  263. VAR
  264.  IdSt : STRING;
  265.  
  266. BEGIN
  267.  Status := UPCASE (Status);
  268.  STR (Id, IdSt);
  269.  CASE Status OF
  270.   'P' : FontStatus := Esc + '*c5' + 'F';       (* Permanent *)
  271.   'T' : FontStatus := Esc + '*c4' + 'F';       (* Temp      *)
  272.   ELSE FontStatus := '';
  273.  END; (* Case *)
  274. END;
  275.  
  276. PROCEDURE DownloadFont;
  277.  
  278. VAR
  279.  ListFile : TEXT;
  280.  PrnFile,
  281.  FontFile : FILE;
  282.  Buffer : BufferType;
  283.  RecsRead : INTEGER;
  284.  
  285. BEGIN
  286.  ASSIGN (FontFile, FontFileName);
  287.  RESET (FontFile, 1);
  288.  ASSIGN (PrnFile, 'PRN');
  289.  REWRITE (PrnFile, 1);
  290.  ASSIGN (ListFile, 'PRN');
  291.  REWRITE (ListFile);
  292.  WRITE (ListFile, HPReset);
  293.  WRITE (ListFile, FontID (Id) );
  294.  WHILE NOT (EOF (FontFile) ) DO
  295.   BEGIN
  296.    BLOCKREAD (FontFile, Buffer, SIZEOF (Buffer), RecsRead);
  297.    IF (StatusX <> 0) OR (StatusY <> 0) THEN
  298.     WriteAt (StatusX, StatusY, StatusFore, StatusBack,
  299.             IntStr (ROUND (FILEPOS (FontFile) / FILESIZE (FontFile) * 100) ) +
  300.             ' % downloaded...');
  301.    Dta2Prn (@Buffer, RecsRead);
  302.   END;
  303.  CLOSE (FontFile);
  304.  WRITE (ListFile, FontStatus (Id, Status) );
  305.  WRITE (ListFile, FontPrimORSec (Id, 'P') );
  306.  CLOSE (PrnFile);
  307.  CLOSE (ListFile);
  308. END;
  309.  
  310. PROCEDURE EjectPage (VAR PrnFile : TEXT);
  311.  
  312. BEGIN
  313.  WRITE (PrnFile, Esc + '&l0H');
  314. END;
  315.  
  316. END. (* unit *)
  317.  
  318. {
  319.  
  320. CUT THIS OUT TO A SEPARATE FILE .. DTA2PRN.XX, and execute XX34 D filename
  321. to create the OBJ file needed for this unit
  322.  
  323. *XX3402-000499-170789--72--85-40996-----DTA2PRN.OBJ--1-OF--1
  324. U-Q+3IAuL3FEL2x0GZl2J22mI37C9Y3HHHe65k+++3FpQa7j623nQqJhMalZQW+UJaJmQqZj
  325. PW+l9X0uW-o+ECYgHisG3IAuL3FEL2x0GZl2J22mI37C9Y3HHMa6+k-+uImK+U++O7M4++F1
  326. HoF3FNU5+0UP++6-+FeE1U+++ER2J22mI37C++++LsU3+21V4E+tW+E+E86-YMU3+21e-+-3
  327. W+U+ECAM++M+8UK60E-+slY++++Y++y60E-+slc++++Y+Eq6M+-+sY++++++++JDH2F0I+d+
  328. +U+++++5IYJIEIF2IUd+-++++++6EZJ4FYJGIpc8E+M+++++0I7JFYN3IZB3Fkd+0++++++7
  329. EZJ4FYJGHoNH0Y+8++++U+R3HYFBEJ7903O62E-+slg5HotHJ231Gkg+6+++t6US+21c+-J1
  330. CZlII3lDEYdQF3F-AZ-GHWt-IoogHisGWNEr+++-4U+++-g++E+d++A+8U+3+0o+0++i++g+
  331. A++B+16+1k+n+-2+B++H+1Q+3E+s+-Q+CE+M+2061E-+tURDHZBIEIB94kQ7W-2+ECM5F3F-
  332. AZ-GHVY+++2++0K61U-+tUFCFJVI4E+++Eo+qe+T++2++3K9v1D7Wos2WrM6Ax6qf19YnFTW
  333. y6jZLQ64+288+U++R+++
  334. ***** END OF BLOCK 1 *****
  335.  
  336.