home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TURBO5.ZIP / PRINT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-26  |  3.9 KB  |  134 lines
  1. {$B-}
  2. Program PrnFile(Input,Printer);
  3. Const
  4.   max = 80;
  5.  
  6. Type
  7.   Today = array [1..3] of integer;
  8.   Character = string[max];
  9.   Name = string[12];
  10.  
  11. Var
  12.   Date: Today;
  13.   X, Line, Number, Page: integer;
  14.   DataLine: Character;
  15.   FileName: Name;
  16.   Infile: text;
  17.  
  18. Procedure Header(Dat: Today; Prog: Name);
  19. Var
  20.   X, Count: integer;
  21. begin
  22. for Count := 1 to 13 do
  23.   writeln(lst);
  24. write(lst,'                           ');
  25. writeln(lst,'***********************************************');
  26. write(lst,'                           ');
  27. writeln(lst,'***********************************************');
  28. write(lst,'                           ');
  29. writeln(lst,'***********************************************');
  30. write(lst,'                           ');
  31. write(lst,'*** FILE NAME: ',Prog);
  32. if length(Prog) < 12 then
  33.    for X := length(Prog) to 12 do
  34.       write(lst,' ');
  35. writeln(lst,'                ***');
  36. write(lst,'                           ');
  37. writeln(lst,'*** AUTHOR: Russell J. Friery               ***');
  38. write(lst,'                           ');
  39. write(lst,'*** DATE: ',Date[1]:2,'/',Date[2]:2,'/');
  40. writeln(lst,Date[3]:2,'                          ***');
  41. write(lst,'                           ');
  42. writeln(lst,'*** COMPUTER: Osborne I Z80 Microprocessor  ***');
  43. write(lst,'                           ');
  44. writeln(lst,'*** PRINTER: Sears Electronic Typewriter    ***');
  45. write(lst,'                           ');
  46. writeln(lst,'*** COMMUNICATIONS: External Interface Unit ***');
  47. write(lst,'                           ');
  48. writeln(lst,'***********************************************');
  49. write(lst,'                           ');
  50. writeln(lst,'***********************************************');
  51. write(lst,'                           ');
  52. writeln(lst,'***********************************************');
  53. for Count := 1 to 41 do
  54.   writeln(lst);
  55. end;
  56.  
  57. Procedure PrintHeader(Dat: Today; Prog: Name; Page: integer);
  58. begin
  59. writeln(lst);
  60. writeln(lst);
  61. write(lst,'PROGRAM LISTER                           FILE: ',Prog);
  62. writeln(lst,'                               PAGE: ',Page);
  63. writeln(lst,'AUTHOR: Russell J. Friery');
  64. writeln(lst,'SOCIAL SECURITY NO: 029-50-9863');
  65. writeln(lst);
  66. writeln(lst);
  67. end;
  68.  
  69. Procedure PrintLine;
  70. Var
  71.   B: integer;
  72. begin
  73. if Number < 10 then
  74.   writeln(lst,'   ',Number,') ',DataLine)
  75. else
  76.   if Number < 100 then
  77.      writeln(lst,'  ',Number,') ',DataLine)
  78.   else
  79.      if Number < 1000 then
  80.         writeln(lst,' ',Number,') ',DataLine)
  81.      else
  82.         writeln(lst,Number,') ',DataLine);
  83. Line := Line + 1;
  84. Number := Number + 1;
  85. end;
  86.  
  87. begin
  88. ClrScr;
  89. write(' ENTER DATE [MM DD YY]> ');
  90. read(Date[1],Date[2],Date[3]);
  91. readln;
  92. write(' ENTER FILE NAME> ');
  93. readln(FileName);
  94. assign(Infile,FileName);
  95. writeln;
  96. writeln;
  97. writeln('**** PROCESSING FILE ****');
  98. reset(Infile);
  99. Header(Date,FileName);
  100. Number := 1;
  101. Page := 1;
  102. while not EOF(Infile) do
  103.   begin
  104.      PrintHeader(Date,FileName,Page);
  105.      Line := 8;
  106.      Page := Page + 1;
  107.      while (Line < 64) and (not EOF(Infile)) do
  108.         begin
  109.            readln(Infile,DataLine);
  110.            if DataLine <> #138 then
  111.               PrintLine;
  112.         end;
  113.      for X := 1 to 3 do
  114.         writeln(lst);
  115.   end;
  116. if Line > 60 then
  117.    for Line := Line to 69 do
  118.       writeln(lst);
  119. write(lst,'****************************************************');
  120. writeln(lst,'**************************************************');
  121. write(lst,'***** EOF DETECTED *********************************');
  122. writeln(lst,'**************************************************');
  123. write(lst,'****************************************************');
  124. writeln(lst,'**************************************************');
  125. Line := Line + 1;
  126. if Line < 66 then
  127.    for Line := Line to 70 do
  128.       writeln(lst)
  129. else
  130.    for Line := Line to 136 do
  131.       writeln(lst);
  132. ClrScr; 
  133. end.
  134.