procedure tree;
label start,again;

var
 DirInfo : SearchRec;
 cat     : array[0..1023] of _catrec;
 d_cnt   : word;
 i,j     : word;
 ios,tmp : string[25];
 first   : word;
 posit   : word;
 scroll_cat : word;
 c_dir      : string;
 ib,jb,cdb : byte;
procedure up;
begin
 if (wgetpos=100) and (first>0) then begin
    wcursoroff;
    wscroll(1,1,$3f,scrhdr[100,0], scrhdr[100,1],
      scrhdr[100,0]+scrhdr[100,2]-1,
                    scrhdr[115,1]);
    dec(first);
    wwrite(cat[first].nam,100,$3f,$3f);
    wcursoron(100);
  end;
end;

{ Local }
procedure dw;
begin
 if (wgetpos=115) and (posit<(d_cnt-1)) then begin
     wcursoroff;
     wscroll(0,1,$3f,scrhdr[100,0], scrhdr[100,1],
                     scrhdr[100,0]+scrhdr[100,2]-1,
                     scrhdr[115,1]);
    inc(first);
    wwrite(cat[first+15].nam,115,$3f,$3f);
 end
 else if (posit=(d_cnt-1)) or (d_cnt=0) then i:=1 else i:=1080;
end;

begin
 d_cnt:=0;
 wsavescr;
 textattr:=$3f;
 createmenu(26,3,54,20,100,$70,' Tree ');
 downwin(' <Enter>, <Esc> ');
 scrhdr[100,4]:=100;
 scrhdr[115,5]:=115;

again:
 ib:=textattr;
 textattr:=$70;
 gotoxy(1,25);
 write(wstring(' ',77));
 gotoxy(1,25);
 write(path,'\');
 textattr:=ib;

{ Идет заполнение массива дерева }

 d_cnt := 0;
 if path[length(path)]<>':' then begin
  cat[0].nam:='..';
  d_cnt:=1;
 end;

 if path[length(path)]=':' then begin
  asm
   mov ah,19h
   int 21h
   mov cdb,al
  end;
  for ib:=2 to 26 do
  begin
   asm
    mov ah,0eh
    mov dl,ib
    int 21h
    mov ah,19h
    int 21h
    cmp al,ib
    jz @l1
    mov al,0
    @l1:mov jb,al
   end;
   if (jb>0) and (chr(jb+65)<>path[1]) then begin
    cat[d_cnt].nam:=chr(jb+65)+':';
    inc(d_cnt);
   end;
  end;
  asm
   mov ah,0eh
   mov dl,cdb
   int 21h
  end;
 end;

 FindFirst(path+'\*.*', $3f, DirInfo);
 while DosError = 0 do
 begin
   if (dirinfo.attr = directory) and
      (dirinfo.name<>'.') and
      (dirinfo.name<>'..')
    then begin
    format_name(dirinfo.name);
    dirinfo.name[9]:=' ';
    cat[d_cnt].nam:=dirinfo.name;
    inc(d_cnt);
   end;
   FindNext(DirInfo);
 end;
 sortdir(cat,d_cnt);

start:
  first:=0;
 { fresult:=0;}
  for i:=0 to 15 do
  begin
   if (i+first)<d_cnt
   then wwrite(cat[i+first].nam,i+100,$3f,$3f)
   else wwrite(' ',i+100,$3f,$3f);
  end;
  wcursoron(100);
  repeat
   posit:=(wgetpos-100)+first;
   gotoxy(1,1);
   i:=wreadkey;
   scroll_cat:=i;
   case i of
    1073: begin { PgUp }
            wcursoroff;
            if (first>=16)
            then begin
               dec(first,16);
               dec(posit,16);
            end
            else begin
      first:=0;
      if posit<16 then posit:=0 else posit:=15;
            end
            ;
            goto start;
          end;
    1081: begin {PgDw }
           wcursoroff;
    if (d_cnt-posit)>=16
    then begin
     inc(first,16);
     inc(posit,16);
    end
    else begin
     posit:=(d_cnt-1);
     if (d_cnt-first)>16 then inc(first,16);
    end
    ;
    goto start;
   end;
    13: begin
         getdir(0,c_dir);
         chdir(path);
         chdir('\');
         chdir(path);
         tmp:=cat[posit].nam;
         name_compact(tmp);
         chdir(tmp);
         getdir(0,path);
         if path[length(path)]='\' then delete(path, length(path),1);
         chdir(c_dir);
         chdir('\');
         chdir(c_dir);
         goto again;
        end;


    27           : begin wcursoroff; wloadscr; exit end;
    1072         : Up; { Up }
    1080         : Dw;
   end;
   wmovecursor(i);
  until false;

end;
