[Back to TEXTFILE SWAG index]  [Back to Main SWAG index]  [Original]

{
 IP>     Does anyone have a source to a viewer out there? Im looking
 IP> for one kinda like List.com or whatever.. where you can use your
 IP> arrow keys to list the file.. Thanx alot!!!!!!!!!!!!!!!!!!!!
}

 Program Viewer;
 (*$M $800,0,$A0000 *)

 Uses
    crt;

 Type    TextBlock = Array[1..16000] of ^String; { lines enough? 8-) }

 Var     VText : TextBlock;
         Lines : integer;
         Last  : integer;

 Procedure Init(N:string);
 Var F: text;
     S: String;
 begin
   FillChar( VText, Sizeof(Vtext), 0 );
   Lines := 0;
   Assign( f, N );
(*$I-*)
   Reset( f );
(*$I+*)
   If IoResult <> 0 then exit;
   While ( not EOF( F ) )
     AND ( Maxavail > 80 )   do  { assume a 80-Char-String }
   begin
      Inc( Lines );
      ReadLn( F, S );
      If Length(S) > 80
        Then S[0] := #80;
      GetMem( Vtext[Lines], 1+Length(S) );
      VText[Lines]^ := S;
   end;
   Last := Lines;
   if not eof( F )
     then Write(' Sorry, only ')
     else Write(' All ');
   Writeln( Lines,' Lines of ', N , ' read. ');
   Close( F );
 end;

 Procedure Display(N:String);
 Var ch : Char;
     akt: integer;
     Procedure Update;
     Var y,i: integer;
     begin
       if akt > ( Last - 22 )
          then akt := last - 22;
       if akt < 1
          then akt := 1;
       y := 2;
       for  i := akt to akt + 22 do
       begin
         gotoxy( 1, y );
         ClrEol;
         inc( y );
         if i <= Last then write( VText[i]^ );
       end;
       TextAttr := $70;  (* Black on Gray *)
       Gotoxy(70,25);
       if akt+23 > Last
         then Write(akt,'..',Last)
         else Write(akt,'..',akt+22);
       ClrEol
     end;
 begin
   TextAttr := $70;  (* Black on Gray *)
   ClrScr;
   Gotoxy( 2, 1);
   Write('The All Dancing and Singing Textfile Viewer');
   Write('     Norbert Igl, 2:2453/50.3@Fido');
   Gotoxy( 2,25);
   while Pos('\',N) > 0 do delete(n,1,1);
   for akt := 1 to length(N) do N[akt] := upcase(n[akt]);
   Write('File: ',N,', ',Last,' Lines,  ');
   Write( MemAvail,' Bytes free.');
   Gotoxy(63,25); Write('Lines: ');
   akt := 1;
   repeat
     TextAttr := $1F;  { white on blue }
     Update;
     repeat
        ch := ReadKey;
        if ch = #0 then
        begin
          ch := readkey;
          case ch of
          'H' : ch := #1; { up }
          'P' : ch := #2; { down }
          'Q' : ch := #3; { pg-up }
          'I' : ch := #4; { pg-down }
          'G' : ch := #5; { home }
          'O' : ch := #6; { end }
          else ch := #0;  { discard }
        end
        end
     until Ch in [#27, #1..#6 ] ;
     case Ch of
       #1 : dec( akt );
       #2 : inc( akt );
       #3 : inc( akt, 22 );
       #4 : dec( akt, 22 );
       #5 : akt := 1;
       #6 : akt := last-22;
     end;
  until ch=#27;
 end;

 procedure CleanUp;
 Var I : Integer;
 begin
   for I := last downto 1 do
     FreeMem( Vtext[i], 1+Length(VText[i]^) );
   TextAttr := 7;
   ClrScr;
 end;

 begin
   if Paramcount <> 1 then
   begin
     writeln(' Usage :  VIEWER [Drive:[\Path\]] FileName.Ext');
     halt
   end;
   Init(paramstr(1));
   if Lines > 0 then
   begin
     Display(paramstr(1));
     CleanUp
   end;
 end.

[Back to TEXTFILE SWAG index]  [Back to Main SWAG index]  [Original]