home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / fd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  1.5 KB  |  67 lines
  1. unit FD;     { File Dump }
  2.  
  3. interface
  4. uses Crt,      CPaU,     Def,      SetBU,    Printer,
  5.      GetKeU,   ColorDef, PG,       FastWr,   ShadoU;
  6. procedure FileDump;
  7.  
  8. implementation
  9.  
  10. procedure FileDump;
  11. var Temp:            s40;
  12.     Count,
  13.     RecordNum,
  14.     X,
  15.     I:               integer;
  16.     Continue,
  17.     FunctionKey,
  18.     CompressTest:    boolean;
  19.     Ch:              char;
  20.     TempStr:         s10;
  21.  
  22. begin
  23. SetBG;
  24. clrscr;
  25. Shadow( 15, 2, 65, 4, Inputs.Attr, true);
  26. FastWrite( CPad('Dump file to printer ?   (Y/N)',40), 3, 20, Inputs.Attr );
  27. GetKey(Ch,FunctionKey);
  28. Ch := upcase(Ch);
  29. if Ch = 'Y' then
  30.    begin
  31.    clrscr;
  32.    PrintDevice;
  33.    assign(OutPutDevice,Device);
  34.    rewrite(OutPutDevice);
  35.    clrscr;
  36.    Shadow( 15, 8, 65, 15, Headings.Attr, true);
  37.    FastWrite( CPad('Hit [ESC] to exit.',20), 10, 30, Headings.Attr);
  38.    FastWrite( CPad('Writing',20), 12, 30, Headings.Attr);
  39.    Continue := true;
  40.    RecordNum := 1;
  41.    while Continue do
  42.       begin
  43.       if (RecordNum mod 10) = 0 then
  44.          begin
  45.          str(RecordNum,TempStr);
  46.          FastWrite( CPad(TempStr,10), 13, 35, msgs.Attr);
  47.          end;
  48.       PrintRecord(1,RecordNum);
  49.       if keypressed then
  50.          begin
  51.          GetKey(Ch,FunctionKey);
  52.          if (not FunctionKey) and (Ch = #27) then Continue := false;
  53.          end
  54.         else
  55.          begin
  56.          inc(RecordNum);
  57.          if RecordNum > FileTop then Continue := false;
  58.          end;
  59.       end;
  60.    writeln(OutPutDevice,#12);
  61.    close(OutPutDevice);
  62.    end;
  63. end;
  64.  
  65. end.
  66. 
  67.