home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pas_nl
/
10
/
mdp8.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-02-29
|
5KB
|
165 lines
program mdp8;
{This program performs exactly the same functions as mdp7.pas, except that }
{it allows the use of the cursor keys, PgUp, PgDn, Home, End, ESC, etc., }
{plus it allows you to specify a line number to jump to, by pressing #. }
{Note that while the functionality is similar, it has been moderately re- }
{written. }
{$G+,R-,S-,N+,M 16384,0,0}
uses Test186, crt,Textutl2, DosMem, BigArray;
const TBuffSize = 20; {k}
ScreenLen = 24;
LineCount:word = 0;
WinTop:longint = 1;
type TBuffPtr = ^TBuffType;
TBuffType = array [1..TBuffSize*1024] of byte; {20k text buffer}
var LineBank:BigDOSArray;
TBuff:TBuffPtr;
LinePtr:^longint;
Loop,LNum:word;
f:text;
function Min (a,b:word):word;
begin
if a < b then Min := a else Min := b;
end;
procedure PrLn (var s:string);
begin
write (copy (s,1,79));
if length (s) < 79 then write (' ':79-length(s));
writeln;
end;
procedure ReadFile;
var MaxLines:longint;
FSize:longint;
FPos:longint;
begin
{Set up text buffer}
TBuff := ptr (DosMem.Alloc (TBuffSize * 64),0); { * 64 turns K into paras}
{Initialise the line arrays}
with linebank do begin
SetElemSize (sizeof (longint));
MaxLines := GetMaxSize;
writeln ('There''s room for ',MaxLines,' lines in memory.');
Init (MaxLines);
end;
writeln ('Please wait while the file is read...');
assign (f,paramstr (1)); SetTextBuf (f,TBuff^); reset (f);
FSize := TextFileSize (f);
while not (eof (f) or (LineCount = MaxLines)) do begin
inc (LineCount);
write (LineCount);
LinePtr := LineBank.Elem (LineCount);
FPos := TextFilePos (f);
if lo (LineCount) = 0 then write (' ',FPos * 100 div FSize,'%');
write (#13);
LinePtr^ := FPos;
readln (f);
end;
clreol; writeln;
end;
procedure ShowFromLine (var line:longint);
var LinePtr:^longint;
Buffer:string;
begin
gotoxy (1,1);
LinePtr := LineBank.Elem (line);
TextSeek (f,LinePtr^);
for loop := 1 to min (ScreenLen,LineCount-WinTop+1) do begin
readln (f,buffer);
prLn (buffer);
end;
write (' Use keypad to manoeuvre, ''ESC'' to quit, ''#'' to jump.'#13);
write (WinTop:5,'/',LineCount,#13);
end;
procedure showfile;
var quit,moved,extended:boolean;
ch:char;
LSL:longint; {last screen line}
begin
quit := false; lsl := LineCount - ScreenLen; moved := true;
repeat
if moved then ShowFromLine (WinTop);
ch := readkey;
extended := ch = #0; {was it a function key?}
if extended then begin {yes}
ch := readkey; {get the scan code}
moved := false;
{When the scan code is treated as a char, it APPEARS to be a letter}
{This is why the case below uses letters to identify the key. }
case ch of
'H':if WinTop > 1 then begin {H is the up arrow}
dec (WinTop);
moved := true;
end;
'P':if WinTop < lsl+1 then begin {P is the down arrow}
inc (WinTop);
moved := true;
end;
'I':if WinTop > 1 then begin {I is the PgUp key}
dec (WinTop,ScreenLen-1);
if WinTop < 1 then WinTop := 1;
moved := true;
end;
'Q':if WinTop < lsl then begin {Q is the PgDn key}
inc (WinTop,ScreenLen-1);
if WinTop >= lsl then WinTop := lsl+1;
moved := true;
end;
'G':if WinTop > 1 then begin {G is the Home key}
WinTop := 1;
moved := true;
end;
'O':if WinTop < LSL+1 then begin {O is the End key}
WinTop := LSL+1;
moved := true;
end;
else write (#7);
end;
end else case ch of
'#':begin
ClrEol; {clears this line}
write ('Move to what line? (1-',LSL+1,'): ');
readln (WinTop);
moved := true;
end;
#27:quit := true;
else write (#7);
end;
until quit;
end;
begin
clrscr;
ReadFile;
if Linecount = 0 then begin
writeln ('File is empty.');
close (f);
DosMem.Free (seg(TBuff^)); {not really needed, but here for looks.}
LineBank.Done;
halt;
end;
ShowFile;
close (f);
DosMem.Free (seg(TBuff^));
LineBank.Done;
end.