home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PNL010.ZIP / MDP7.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-29  |  3.2 KB  |  117 lines
  1. program mdp7;
  2.  
  3. {This program allows you to scroll through a file you specify on the comm- }
  4. {and line.  The number of lines in the file is virtually unlimited - you'd }
  5. {need many megabytes to overflow it.                                       }
  6. {Note that this program uses a unit called BigArray, which uses DOS memory }
  7. {calls.  This means you can have arrays larger than 64k.  This is how it   }
  8. {can access such HUGE files.  It uses the same "array of offsets" that     }
  9. {previous programs have.                                                   }
  10.  
  11. {$G+,R-,S-,N+,M 16384,0,0}
  12.  
  13. uses Test186, crt,Textutl2, DosMem, BigArray;
  14.  
  15. const TBuffSize = 20; {k}
  16.       ScreenLen = 24;
  17.       LineCount:word = 0;
  18.       WinTop:integer = 1;
  19.  
  20. type TBuffPtr  = ^TBuffType;
  21.      TBuffType = array [1..TBuffSize*1024] of byte; {20k text buffer}
  22.  
  23. var MaxLines:longint;
  24.     LineBank:BigDOSArray;
  25.     TBuff:TBuffPtr;
  26.     Buffer:string;
  27.     LinePtr:^longint;
  28.     Loop,LNum:word;
  29.     ch:char;
  30.     f:text;
  31.  
  32. function Min (a,b:word):word;
  33.  
  34. begin
  35.   if a < b then Min := a else Min := b;
  36. end;
  37.  
  38. procedure PrLn (var s:string);
  39.  
  40. begin
  41.   writeln (copy (s,1,79));
  42. end;
  43.  
  44. begin
  45.   {Set up text buffer}
  46.   TBuff := ptr (DosMem.Alloc (TBuffSize * 64),0); { * 64 turns K into paras}
  47.   {Initialise the line arrays}
  48.   with linebank do begin
  49.     SetElemSize (sizeof (longint));
  50.     MaxLines := GetMaxSize;
  51.     writeln ('There''s room for ',MaxLines,' lines in memory.');
  52.     Init (MaxLines);
  53.   end;
  54.   writeln ('Reading...');
  55.   assign (f,paramstr (1)); SetTextBuf (f,TBuff^); reset (f);
  56.   while not (eof (f) or (LineCount = MaxLines)) do begin
  57.     inc (LineCount);
  58.     write (LineCount,#13);
  59.     LinePtr := LineBank.Elem (LineCount);
  60.     LinePtr^ := TextFilePos (f);
  61.     readln (f);
  62.   end;
  63.   writeln;
  64.  
  65.   clrscr;
  66.   if Linecount = 0 then begin
  67.     writeln ('File is empty.');
  68.     close (f);
  69.     DosMem.Free (seg(TBuff^)); {not really needed, but here for looks.}
  70.     LineBank.Done;
  71.     halt;
  72.   end;
  73.   {Draw the initial screen}
  74.   clrscr;
  75.   TextSeek (f,0); {Move to the start of the file}
  76.   for loop := 1 to min (ScreenLen,LineCount-WinTop+1) do begin
  77.     readln (f,buffer); {print out the first screen}
  78.     prLn (buffer);
  79.   end;
  80.   write ('            Use ''+'' to move forward, ''-'' to move back.  ''q'' to quit.');
  81.   repeat
  82.     ch := readkey;
  83.     case ch of
  84.       '-':if WinTop > 1 then begin
  85.             dec (WinTop);
  86.             gotoxy (1,ScreenLen);
  87.             DelLine;
  88.             gotoxy (1,1);
  89.             InsLine;
  90.             LinePtr := LineBank.Elem (WinTop);
  91.             TextSeek (f,LinePtr^);
  92.             readln (f,buffer);
  93.             PrLn (buffer);
  94.           end;
  95.       '+':if WinTop < LineCount-ScreenLen+1 then begin
  96.             inc (WinTop);
  97.             gotoxy (1,1);
  98.             DelLine;
  99.             gotoxy (1,ScreenLen);
  100.             InsLine;
  101.             LinePtr := LineBank.Elem (WinTop+ScreenLen-1);
  102.             TextSeek (f,LinePtr^);
  103.             readln (f,buffer);
  104.             PrLn (buffer);
  105.           end;
  106.       'q':;
  107.       else write (#7);
  108.     end;
  109.     gotoxy (1,ScreenLen+1); write (WinTop:5,'/',LineCount,#13);
  110.   until ch = 'q';
  111.  
  112.   close (f);
  113.   DosMem.Free (seg(TBuff^));
  114.   LineBank.Done;
  115. end.
  116.  
  117.