home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / SCNDSIGN.ZIP / PRINTDWG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-03-05  |  1.8 KB  |  52 lines
  1. program printdwg;  uses printer;
  2.  
  3. { This Turbo Pascal 4.0 program dumps the rotated contents of a Hercules-    }
  4. { compatible monochrome graphics screen to a dot-matrix printer at 120 dots  }
  5. { per inch.  It is adapted from a procedure "HardCopy" contributed to        }
  6. { Compuserve by Antonio Rivera.                                              }
  7.  
  8.    const
  9. esc = #27;              {escape char}
  10. LF = #10;               {line feed}
  11. FF = #12;               {form feed}
  12. null = #0;
  13. xmax = 719; ymax = 347; {max pixel coords}
  14. mult = 2;               {no. of print dots per pixel}
  15. margin = 65;            {left margin setting}
  16. bits: array [0..7] of byte = (128, 64, 32, 16, 8, 4, 2, 1);
  17. page0base = $B000;      {start of graphics screen RAM}
  18.  
  19.    var
  20. pbyte: byte;            {byte to be sent to printer}
  21. numdots: integer;       {dots per row}
  22. low, high: char;        {constituent bytes of numdots}
  23. row, col, i: integer;   {loop counters}
  24. co: integer;
  25.  
  26. begin
  27. write (lst, LF);  {top margin}
  28. write (lst, esc, 'A', #8);  {set 8/72" LF}
  29. numdots := (ymax + 1 + margin) * mult;
  30. low := chr(lo(numdots)); high := chr(hi(numdots));
  31. for col := 0 to (xmax + 1) div 8 - 1 do
  32.    begin
  33.    write (lst, esc, 'L', low, high);  {set 120 dpi}
  34.    for i := 1 to margin * mult do
  35.       write (lst, null);  {left margin}
  36.    for row := ymax downto 0 do
  37.       {build and send the next pbyte}
  38.       begin
  39.       pbyte := 0; co := col shl 3;
  40.       for i := 0 to 7 do
  41.          if (mem[page0base:(row and 3) shl 13 + 90*(row shr 2) +
  42.               ((co+i) shr 3)] and (128 shr ((co+i) and 7))) <> 0 then
  43.             pbyte := pbyte or bits[i];
  44.       for i := 1 to mult do
  45.          write (lst, chr(pbyte))
  46.       end;
  47.    writeln (lst)
  48.    end;
  49. write (lst, esc, 'A', #12);  {set 12/72" LF}
  50. write (lst, FF)  {eject page}
  51. end .
  52.