fewrf
Const
  MaxBufSize = 30000;
Type
  TBuffer=array[1..MaxBufSize] of char;
Const
  FKeys: array[1..10] of String[6]=
    ('Помощь', '', '', 'Режим', '', '', '', 'Кодир.', '', 'Выход');
  Color: Byte = $0F;
  XPos: Byte = 1;
  YPos: Byte = 1;
  Black        = 0;
  Blue         = 1;
  Green        = 2;
  Cyan         = 3;
  Red          = 4;
  Magenta      = 5;
  Brown        = 6;
  LightGray    = 7;
  DarkGray     = 8;
  LightBlue    = 9;
  LightGreen   = 10;
  LightCyan    = 11;
  LightRed     = 12;
  LightMagenta = 13;
  Yellow       = 14;
  White        = 15;
Var
  Buffer:record
    Data: TBuffer;
    FilePos: Longint;
    Count: Integer;
  end;

  F: file;

  Screen: array[1..25, 1..80] of record
    C: Char;
    CColor: Byte;
  end absolute $B800:0000;

END.
Uses CRT;
Const
  MaxBufSize = 30000;
Type
  TBuffer=array[1..MaxBufSize] of char;
  TScreen = array[1..25, 1..80] of record
    C: Char;
    CColor: Byte;
  end;
Const
  FKeys: array[1..10] of String[6]=
    ('Помощь', '', '', 'Режим', '', '', '', 'Кодир.', '', 'Выход');
  Color: Byte = $0F;
  XPos: Byte = 1;
  YPos: Byte = 1;
  Black        = 0;
  Blue         = 1;
  Green        = 2;
  Cyan         = 3;
  Red          = 4;
  Magenta      = 5;
  Brown        = 6;
  LightGray    = 7;
  DarkGray     = 8;
  LightBlue    = 9;
  LightGreen   = 10;
  LightCyan    = 11;
  LightRed     = 12;
  LightMagenta = 13;
  Yellow       = 14;
  White        = 15;
Var
  Buffer:record
    Data: TBuffer;
    FilePos: Longint;
    Count: Integer;
  end;

  F: file;

  ScreenCopy: TScreen;

  Screen: TScreen absolute $B800:0000;

  FileInfo: record
    FileName: String[80];
    Code: (DOS866, KOI8, WIN1251, UNICODE);
    FileLength: Longint;
    Column, Row: Integer;
    FilePos: Longint;
  end;

function GetChar(P: Longint): Char;
begin
  if (P<Buffer.FilePos)or(P>=Buffer.FilePos+Buffer.Count) then
  begin
    if (FileInfo.FileLength<MaxBufSize)or(P<MaxBufSize div 2)then
      Buffer.FilePos := 0
    else
      if FileInfo.FileLength-P<MaxBufSize div 2 then
        Buffer.FilePos := FileInfo.FileLength-MaxBufSize
      else
        Buffer.FilePos := P-MaxBufSize div 2;
    Seek(f, Buffer.FilePos);
    BlockRead(f, Buffer.Data, MaxBufSize, Buffer.Count);
  end;
  GetChar := Buffer.Data[P-Buffer.FilePos+1]
end;

procedure InitFileInfo;
begin
  if ParamCount>0 then FileInfo.FileName := ParamStr(1);
  Assign(f, FileInfo.FileName);{$i-}
  Reset(f, 1);
  FileInfo.FileLength := FileSize(f);
  FileInfo.Code := DOS866;
  FileInfo.Column := 1; FileInfo.Row := 1;
  Buffer.FilePos := 0; Buffer.Count := 0;
  {$i+}
end;

procedure ClrWindow(X1, Y1, X2, Y2: Byte);
Var
  i, j: Integer;
begin
  for i := Y1 to Y2 do
    for j := X1 to X2 do
    begin
      Screen[i, j].c := ' ';
      Screen[i, j].CColor := Color;
    end;
end;

procedure ClrScr;
begin
  ClrWindow(1, 1, 80, 25);
end;

procedure TextColor(C: Byte);
begin
  Color := (Color and $F0)+C;
end;

procedure TextBackground(C: Byte);
begin
  Color := (Color and $F)+C shl 4;
end;

procedure Scroll;
begin
end;

procedure WriteString(S: String);
Var
  i: Byte;
begin
  for i := 1 to Length(S) do
  begin
    if YPos>25 then
    begin
      Scroll; Dec(YPos);
    end;
    Screen[YPos, XPos].C := S[i];
    Screen[YPos, XPos].CColor := Color;
    if XPos=80 then
    begin
      XPos := 1;
      Inc(YPos);
    end
    else
      Inc(XPos);
  end;
end;

procedure WriteStringL(S: String; L: Byte);
begin
  while Length(S)<L do S := S+' ';
  WriteString(S);
end;

function IntToStr(I: Integer): String;
Var
  S: String;
begin
  Str(I, S);
  IntToStr := S;
end;

procedure GotoXY(X, Y: Integer);
begin
 XPos := X; YPos := Y;
end;

procedure ShowStatusInfo;
begin
  GotoXY(1, 1); TextColor(Black); TextBackground(Cyan);
  WriteStringL(FileInfo.FileName, 40);
  case FileInfo.Code of
    DOS866:  WriteStringL('DOS866', 10);
    KOI8:    WriteStringL('KOI8', 10);
    WIN1251: WriteStringL('WIN1251', 10);
    UNICODE: WriteStringL('UNICODE', 10);
  end;
  WriteStringL(IntToStr(FileInfo.FileLength), 10);
  WriteStringL('Кол: '+IntToStr(FileInfo.Column), 10);
  WriteStringL('Стр: '+IntToStr(FileInfo.Row), 10);
end;

procedure ShowKeysInfo;
Var
  i: Integer;
begin
  GotoXY(1, 25);
  for i := 1 to 10 do
  begin
    TextColor(LightGray); TextBackground(Black);
    WriteString(IntToStr(i));
    TextColor(Black); TextBackground(Cyan);
    WriteStringL(FKeys[i], 6);
    TextColor(LightGray); TextBackground(Black);
    if i<>10 then WriteString(' ');
  end;
end;

procedure ShowWindow(X1, Y1, X2, Y2: Byte);
Var
  i: Integer;
begin
  ClrWindow(X1, Y1, X2, Y2);
  for i := X1+1 to X2-1 do
  begin
    Screen[Y1, i].c := Chr(205);
    Screen[Y2, i].c := Chr(205);
  end;
  for i := Y1+1 to Y2-1 do
  begin
    Screen[i, X1].c := Chr(186);
    Screen[i, X2].c := Chr(186);
  end;
  Screen[Y1, X1].c := Chr(201);
  Screen[Y1, X2].c := Chr(187);
  Screen[Y2, X1].c := Chr(200);
  Screen[Y2, X2].c := Chr(188);
end;

function Convert(c: Char): Char;
begin
  Convert := c;
end;

procedure ShowText;
Var
  P: Longint;
  c: Char;
begin
  TextColor(White); TextBackground(Blue);
  GotoXY(1, 2); P := FileInfo.FilePos;
  while (YPos<25)and(P<=FileInfo.FileLength) do
  begin
    c := Convert(GetChar(P));
    case c of
      Chr(13): begin ClrWindow(XPos, YPos, 80, YPos); XPos := 1; end;
      Chr(10): Inc(YPos);
    else
      WriteString(c);
    end;
    Inc(P);
  end;
  if YPos<25 then ClrWindow(XPos, YPos, 80, YPos);
  ClrWindow(1, YPos+1, 80, 24);
  ShowStatusInfo;
end;

procedure StepUp;
Var
  P: Longint;
  i: Integer;
begin
  if FileInfo.FilePos=0 then
    P := -1
  else
  begin
    P := FileInfo.FilePos-2;
    Dec(FileInfo.Row);
  end;
  i := 0;
  while (P>=0)and(GetChar(P)<>Chr(10))and(i<80) do
  begin
    Dec(P);
    Inc(i);
  end;
  FileInfo.FilePos := FileInfo.FilePos-(FileInfo.FilePos-P-1)mod 80;
end;

procedure MoveUp;
begin
  StepUp;
  ShowText;
end;

procedure StepDown;
Var
  P: Longint;
  i: Integer;
begin
  P := FileInfo.FilePos;
  i := 0;
  while (P<=FileInfo.FileLength)and(GetChar(P)<>Chr(10))and(i<80) do
  begin
    Inc(P);
    Inc(i);
  end;
  if FileInfo.FilePos<P then
    Inc(FileInfo.Row);
  FileInfo.FilePos := P+1;
end;

procedure MoveDown;
begin
  StepDown;
  ShowText;
end;

procedure Run;
Var
  c: Char;
  i: Integer;
begin
  Repeat
    c := ReadKey;
    if c=#0 then
    begin
      c := ReadKey;
      case c of
        Chr(72): MoveUp;
        Chr(80): MoveDown;
        Chr(73): for i := 1 to 22 do MoveUp;
        Chr(81): for i := 1 to 22 do MoveDown;
        Chr(68): Break;
      end;
    end;
  until false;
end;

BEGIN
  ScreenCopy := Screen;
  if ParamCount=0 then Exit;
  ClrScr;{$i-}
  asm
   mov ah,01h
   mov ch,20h
   int 10h
  end;
  InitFileInfo;
  if IOResult<>0 then
  begin
    TextColor(White); TextBackground(Blue);
    ShowWindow(20, 10, 60, 14);
    GotoXY(25, 12); WriteString('Указанный Вами файл не найден!!!');
    Exit;
  end;{$i+}
  ShowStatusInfo;
  ShowKeysInfo;
  TextColor(White); TextBackground(Blue);
  ClrWindow(1, 2, 80, 24);
  ShowText;
  Run;
  Screen := ScreenCopy;
END.