home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / HC.ZIP / HC.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1986-06-29  |  7.8 KB  |  237 lines
  1.  
  2. {HC:  HardCopy  by Craig S. Steinberg, O.D.
  3. Compuserve ID: 70166,337
  4. IBMSW Sig and Ashton-Tate Sig  (go ibmsw, go ash-18)
  5. Public Domain.  Feel free to copy, transfer and improve!
  6. Author takes no responsibility for use of this program.
  7.  
  8. Program for making hardcopy printouts of dBASE program files.
  9. Requires Epson or Compatible printer.
  10.  
  11.    a. 88 lines per page
  12.    b. one line double strike header line at start of each program that
  13.       gives print date and name of file being printed.
  14.    c. left margin of 5 char.
  15.    d. 12 cpi printing (elite)
  16.    e. one blank line at top of file and 6 blank lines at bottom giving
  17.       80 lines of code per page
  18.  
  19. Command line parameters:
  20. ------------------------
  21.  
  22. ? - help screen
  23. name - name of file to print, default ext = .prg
  24. name.ext - full name of file to print
  25.  
  26. If no command line parameter, prompt for name of file to print.  After
  27. printing the file, ask for the next file name.  Continue until no file name
  28. is entered (return).  Default ext = .prg.                                  }
  29.  
  30.  
  31. PROGRAM HC;
  32.  
  33. type
  34.    AnyString  = string[255];
  35.    FileName   = string[12];
  36.  
  37. var
  38.    Infile        : text;
  39.    line          : AnyString;
  40.    n,x           : integer;      {line counters}
  41.    InFileName    : FileName;
  42.    ps            : FileName;     {command line parameter}
  43.    Ioerr         : boolean;
  44.  
  45. {wait for any key to be struck to continue}
  46. PROCEDURE Wait;
  47. Var
  48.   AnyKey : Char;
  49. Begin
  50.   Read(Kbd,AnyKey);
  51. end;
  52.  
  53. {display help screen if ? is command line parameter}
  54. Procedure HelpScreen;
  55. Begin
  56.    ClrScr;
  57.    Writeln('                              HardCopy  1.0 ');
  58.    writeln;
  59.    writeln('                           by  Craig Steinberg ');
  60.    writeln;
  61.    LowVideo;
  62.    writeln('Format:   HC  [?] / [filename] [.ext]');
  63.    writeln;
  64.    writeln('          ? - displays this help screen');
  65.    writeln('   Filename - immediately prints "filename"');
  66.    writeln;
  67.    writeln('Default filename extension is ".PRG".  File must be in current directory.');
  68.    writeln('If no filename is entered you will be prompted for filename(s) to print.');
  69.    writeln('If a filename is entered on the command line you are returned to DOS ');
  70.    writeln('immediately after the file has been printed.');
  71.    writeln;
  72.    writeln('Print Parameters (Epson compatible printer): ');
  73.    writeln;
  74.    writeln('Elite print (12 characters per inch).');
  75.    writeln('88 lines per page, 80 lines of code.');
  76.    writeln('Left margin of 5 spaces on each line.');
  77.    writeln('First page header shows file being printed.');
  78.    writeln('Page eject after each file is printed.');
  79.    writeln;
  80.    writeln('Version 1.0, June 29, 1986.  Released into Public Domain by author.');
  81.    writeln;
  82.    HighVideo;
  83.    write('Press any key to return to DOS . . .');
  84.    wait;
  85.    ClrScr;
  86.    halt;
  87. end;
  88.  
  89. {check for disk/file errors, based upon IOError.pas in turbo tutor}
  90. PROCEDURE IOCheck(var IOerr : boolean);
  91. const
  92.   IOVal   : Integer = 0;
  93.   IOerror : boolean = False;
  94. var
  95.   Ch    : Char;
  96. begin
  97.   HighVideo;
  98.   IOerr   := False;
  99.   IOVal   := IOresult;
  100.   IOError := (IOVal <> 0);
  101.   if IOError then begin
  102.     IOerr := True;
  103.     GotoXY (17,12);
  104.     case IOVal of
  105.       $01  :  Write('Input file "',InFileName,'" does not exist.');
  106.       $05  :  Write('Error: Can''t read from the input file.');
  107.       $06  :  Write('Error: Can''t write to output file.');
  108.       $F0  :  Write('Error: Disk write error.');
  109.       $F1  :  Write('Error: Directory is full.');
  110.     else      Write('Unknown I/O error:  ',IOVal:3)
  111.     end;
  112.     GotoXY (17,13); Write('Press any key to continue . . . ');
  113.     write(chr(7));
  114.     LowVideo;
  115.     wait;
  116.     GotoXY (1,12); ClrEol;
  117.     GotoXY (1,13); ClrEol;
  118.   end
  119. end; { of proc IOCheck }
  120.  
  121.  
  122. {**********************************************
  123.          BEGIN MAIN PROGRAM CODE
  124. ***********************************************}
  125.  
  126. begin
  127.    ClrScr;
  128.  
  129.    { if no command line parameters make sure variables are blank }
  130.    if ParamCount < 1 then begin
  131.       ps := '';
  132.       InFileName := '';
  133.    end;
  134.  
  135.    { if ? is entered with filename display help screen and exit }
  136.    if ParamStr(1) = '?' then HelpScreen;
  137.  
  138.    { display title }
  139.    HighVideo;
  140.    GotoXY (27,4); Write('Formatted dBASE HardCopy');
  141.    GotoXY (27,5); Write('────────────────────────');
  142.    GotoXY (1,24); Write('Enter HC ? for help.');
  143.    GotoXY (60,24); Write('By Craig S. Steinberg');
  144.    LowVideo;
  145.  
  146.    { if filename on command line save the filename in memory var ps }
  147.    if (ParamCount >= 1) then ps := ParamStr(1);
  148.  
  149.    { loop until no filename is entered at prompt }
  150.    repeat  {until length(infilename) = 0}
  151.  
  152.       { if a command line filename was entered save it as the filename,
  153.       otherwise prompt for the filename to print}
  154.       if length(ps) > 0 then InFileName := ps
  155.       else begin
  156.          GotoXY (17,10); ClrEol;
  157.          GoToXY (10,8); Write('Enter filename to print  [            ]');
  158.          GotoXY (53,8); Write('Press [RETURN] to Exit');
  159.          GotoXY (36,8); Read(InFileName);
  160.       end;
  161.  
  162.       { If no ext is given and more than eight char are entered then
  163.       truncate the filename to eight characters }
  164.       If (pos('.',InFileName) = 0) and (length(InFileName) > 8) then
  165.          InFileName := copy(InFileName,1,8);
  166.  
  167.       { Add default extension if needed }
  168.       IF length(InFileName) > 0 then
  169.       Begin
  170.          if pos('.',InFileName) = 0 then InFileName := InFileName + '.prg';
  171.          LowVideo;
  172.          GotoXY (17,10);  Write('Printing file: ' + InFileName);
  173.  
  174.          { open the file to be printed and point to beginning of it }
  175.          {$I-}
  176.          Assign(InFile,InFileName);   IOCheck(IOerr);
  177.          Reset(InFile);               IOCheck(IOerr);
  178.          {$I+}
  179.  
  180.          { if there is an error then exit, otherwise continue }
  181.          if (IOErr and (length(ps) > 0)) then begin
  182.             ClrScr;
  183.             halt;
  184.          end;
  185.  
  186.          if not IOErr then begin
  187.  
  188.          { set 88 lines per page, 1/8 inch line spaceing}
  189.          write(lst,#27#48);
  190.  
  191.          { print header line }
  192.          writeln(lst,'');            { blank line }
  193.          write(lst,#27#69);          { double strike }
  194.          write(lst,InFileName:80);   { print filename, flush right }
  195.          writeln(lst,#27#70);        { back to single strike }
  196.  
  197.          write(lst,#27#77);          { elite on }
  198.          write(lst,#27#108#5);       { margin 5 }
  199.          write(lst,#10#13);          { next line }
  200.  
  201.          {begin processing}
  202.          x := 1;  {count number of lines printed}
  203.          n := 3;  {start on line number 3}
  204.          GotoXY (45,10); write('Printing line #');
  205.  
  206.          { process until the end of the file is reached }
  207.          while not eof(InFile) do
  208.          begin
  209.             readln(InFile,line);        { read in a line if text }
  210.             writeln(lst,line);          { write it out to the printer }
  211.             GotoXY (61,10); write(x);   { display the line # being printed }
  212.             x := x + 1;  n := n + 1;    { increment the counters }
  213.             if n = 82 then begin        { are we at the end of the page? }
  214.                write(lst,#12);          {    yes so formfeed }
  215.                n := 3;                  {    restart counter }
  216.                writeln(lst,'');         {    print a couple  }
  217.                writeln(lst,'');         {    of blank lines  }
  218.                writeln(lst,'')
  219.             end
  220.          end;
  221.  
  222.          {end of the file: form feed, bell and reset printer }
  223.          write(lst,#12); write(lst,#7); write(lst,#27#64);
  224.  
  225.          { make sure the input file is closed }
  226.          Close(InFile);
  227.  
  228.          { if command line file was printed blank out InFileName so that
  229.          the repeat condition is false and no filenames are prompted for }
  230.          if length(ps) > 0 then InFileName := '';
  231.          end;
  232.       end;
  233.    until length(InFileName) = 0;
  234.    ClrScr;
  235. end.
  236.  
  237.