Trsek Commander - Substitute of Norton Commander, pascal

Program: Tc.pas
File exe: Tc.exe
need: Main.pas, Mouse.pas, T_wind.pas
The purpose of this program is to substitute Norton Commander. It has had a great beginning and this program is a result. However, as it is with other similar projects, this one couldn't move at one point. At present it is possible to view the files in the window which can be enlarged or moved voluntarily by a mouse.
{ TWIND.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Sucast programu tc.pas                                            }
{ Obsahuje rutiny ktore pracuju s oknom.                            }
{                                                                   }
{ Datum:28.07.1996                             http://www.trsek.com }
 
unit t_Wind;
interface
 
type obrazovka=record
      znak_attr:array[1..25,1..80] of word;
     end;
 
     t_znaky=record
       poin:array[1..2] of pointer;     { ukazuju pred,zanim }
       znak_attr:word;
      end;
 
     t_pole_okna=record                 { ukazuju pred,zanim }
       poin:array[1..2,1..24] of pointer;
      end;
 
          { inicializuj pole pre pracu }
function init_okna:pointer;
          { uvolni pole pre okna }
procedure uvolni_inokna(pole_okna:pointer);
          { Vyrobi riadkove obojsmerne pole smernikov do pole_okna }
procedure urobpole(xh,xd,yh,yd:byte;pole:pointer);
          { uchava/vykresli podklad okna }
procedure vepo_podkl(xh,xd,yh,yd:byte;pole:pointer;vezmi:boolean);
          { pohne oknom v smere do dolava-doprava }
procedure move_leri(xh,xd,yh,yd:byte;pole:pointer;left:boolean);
          { pohne oknom v smere-hore }
procedure move_updo(xh,xd,yh,yd:byte;pole:pointer;up:boolean);
          { uvolni pamat vyhradenu oknami }
procedure uvolni_mpole(pole:pointer);
          { zmensi okno v smere do dolava }
procedure size_left(xh,xd,yh,yd:byte;pole:pointer);
          { zvatsi okno v smere do doprava }
procedure size_right(xh,xd,yh,yd:byte;pole:pointer);
          { zmensi okno smerom nahor }
procedure size_up(xh,xd,yh,yd:byte;pole:pointer);
          { zvatsi okno smerom nadol }
procedure size_down(xh,xd,yh,yd:byte;pole:pointer);
 
var obr:^obrazovka;
 
implementation
 
{ inicializuj pole pre pracu }
function init_okna:pointer;
var pole_okna:^t_pole_okna;
    x:byte;
begin
 GetMem(pole_okna,SizeOf(t_pole_okna));
 init_okna:=pole_okna;
 for x:=1 to 24 do begin
     pole_okna^.poin[1,x]:=NIL;
     pole_okna^.poin[2,x]:=NIL;
    end;
end;
 
{ uvolni pole pre okna }
procedure uvolni_inokna(pole_okna:pointer);
begin
 FreeMem(pole_okna,SizeOf(t_pole_okna));
end;
 
{ Vyrobi riadkove obojsmerne pole smernikov do pole_okna }
procedure urobpole(xh,xd,yh,yd:byte;pole:pointer);
var pole_okna:^t_pole_okna;
    p_znak,d_znak:^t_znaky;
    x,y:byte;
begin
 pole_okna:=pole;
 
 for y:=yh to yd do begin
    GetMem(p_znak,SizeOf(t_znaky));
    pole_okna^.poin[1,y]:=p_znak;
    for x:=xh to xd-1 do begin
        GetMem(d_znak,SizeOf(t_znaky));
        p_znak^.poin[2]:=d_znak;
        d_znak^.poin[1]:=p_znak;
        p_znak:=d_znak;
       end;
 
    p_znak:=pole_okna^.poin[1,y];
    pole_okna^.poin[2,y]:=d_znak;
    p_znak^.poin[1]:=d_znak;
    d_znak^.poin[2]:=p_znak;
   end;
end;
 
{ uchava/vykresli podklad okna }
procedure vepo_podkl(xh,xd,yh,yd:byte;pole:pointer;vezmi:boolean);
var x,y:byte;
    pole_okna:^t_pole_okna;
    p_znak:^t_znaky;
begin
 pole_okna:=pole;
 for y:=yh to yd do begin
   p_znak:=pole_okna^.poin[1,y];
   for x:=xh to xd do begin
       if vezmi then p_znak^.znak_attr:=obr^.znak_attr[y,x]
                else obr^.znak_attr[y,x]:=p_znak^.znak_attr;
       p_znak:=p_znak^.poin[2];
      end;
  end;
end;
 
{ pohne oknom v smere do dolava-doprava }
procedure move_leri(xh,xd,yh,yd:byte;pole:pointer;left:boolean);
var pole_okna:^t_pole_okna;
    p_znak:^t_znaky;
    y:byte;
    prv,dru,x1,x2,x:byte;
    ppole:array[1..24] of word;
begin
 pole_okna:=pole;
 if left then begin prv:=1;dru:=2;x1:=xd;x2:=xh-1;end
         else begin prv:=2;dru:=1;x1:=xh;x2:=xd+1;end;
 
 { tuto skutocne pohne }
 if left then
    for y:=yh to yd do begin
        ppole[y]:=obr^.znak_attr[y,x2];
        for x:=xh to xd do obr^.znak_attr[y,x-1]:=obr^.znak_attr[y,x];
   end
  else
    for y:=yh to yd do begin
        ppole[y]:=obr^.znak_attr[y,x2];
        for x:=xd downto xh do obr^.znak_attr[y,x+1]:=obr^.znak_attr[y,x];
   end;
 
 
 for y:=yh to yd do begin
     p_znak:=pole_okna^.poin[dru,y];
     pole_okna^.poin[dru,y]:=p_znak^.poin[prv];
     pole_okna^.poin[prv,y]:=p_znak;
      { najprv obnov podklad }
     obr^.znak_attr[y,x1]:=p_znak^.znak_attr;
      { uchovaj nove }
     p_znak^.znak_attr:=ppole[y];
    end;
end;
 
{ pohne oknom v smere-hore }
procedure move_updo(xh,xd,yh,yd:byte;pole:pointer;up:boolean);
var pole_okna:^t_pole_okna;
    p_znak:^t_znaky;
    x,y:byte;
    y1,y2:byte;
    ppole:array[1..80] of word;
begin
 pole_okna:=pole;
 if up then begin y1:=yh-1;y2:=yd;end
       else begin y1:=yd+1;y2:=yh;end;
 
 p_znak:=pole_okna^.poin[1,y2];         { zapamataj posledny }
 
 pole_okna^.poin[1,y2]:=NIL;
 pole_okna^.poin[2,y2]:=NIL;
 
 pole_okna^.poin[1,y1]:=p_znak;         { prvy daj to co bolo posledne }
 pole_okna^.poin[2,y1]:=p_znak^.poin[1];
 
 if up then
    for x:=xh to xd do begin
        ppole[x]:=obr^.znak_attr[yh-1,x];
        for y:=yh to yd do obr^.znak_attr[y-1,x]:=obr^.znak_attr[y,x];
       end
   else
    for x:=xh to xd do begin
        ppole[x]:=obr^.znak_attr[yd+1,x];
        for y:=yd downto yh do obr^.znak_attr[y+1,x]:=obr^.znak_attr[y,x];
       end;
 
 for x:=xh to xd do begin
     obr^.znak_attr[y2,x]:=p_znak^.znak_attr;
     p_znak^.znak_attr:=ppole[x];
     p_znak:=p_znak^.poin[2];
     end;
end;
 
{ uvolni pamat vyhradenu oknami }
procedure uvolni_mpole(pole:pointer);
var pole_okna:^t_pole_okna;
    p_znak:^t_znaky;
    pom:pointer;
    y:byte;
begin
 pole_okna:=pole;
 for y:=1 to 24 do
   if (pole_okna^.poin[1,y]<>NIL) then begin
       pom:=pole_okna^.poin[1,y];
       repeat
        p_znak:=pom;
        pom:=p_znak^.poin[2];
        FreeMem(p_znak,SizeOf(t_znaky));
       until (pom=pole_okna^.poin[1,y]);
      end;
end;
 
{ zmensi okno v smere do dolava }
procedure size_left(xh,xd,yh,yd:byte;pole:pointer);
var pole_okna:^t_pole_okna;
    p_znak,d_znak:^t_znaky;
    y:byte;
begin
 pole_okna:=pole;
 
 for y:=yh to yd do begin
     obr^.znak_attr[y,xd]:=p_znak^.znak_attr;
                                             { vykresli podklad }
     p_znak:=pole_okna^.poin[2,y];
     pole_okna^.poin[2,y]:=p_znak^.poin[1];
     obr^.znak_attr[y,xd]:=p_znak^.znak_attr;
                                             { vyhod posledny stlpec }
     d_znak:=p_znak^.poin[1];
     d_znak^.poin[2]:=p_znak^.poin[2];
 
     d_znak:=p_znak^.poin[2];
     d_znak^.poin[1]:=p_znak^.poin[1];
     FreeMem(p_znak,SizeOf(t_znaky));
    end;
end;
 
{ zvatsi okno v smere do doprava }
procedure size_right(xh,xd,yh,yd:byte;pole:pointer);
var pole_okna:^t_pole_okna;
    p_znak,d_znak:^t_znaky;
    pom:pointer;
    y:byte;
begin
 pole_okna:=pole;
 
 for y:=yh to yd do begin
     p_znak:=pole_okna^.poin[2,y];
     GetMem(d_znak,SizeOf(t_znaky));
                                    { pridaj posledny stlpec }
     pom:=p_znak^.poin[2];
     p_znak^.poin[2]:=d_znak;
     d_znak^.poin[1]:=p_znak;
     p_znak:=pom;
     p_znak^.poin[1]:=d_znak;
     d_znak^.poin[2]:=p_znak;
     pole_okna^.poin[2,y]:=d_znak;
                                  { zapamataj podklad }
     d_znak^.znak_attr:=obr^.znak_attr[y,xd+1];
    end;
end;
 
{ zmensi okno smerom nahor }
procedure size_up(xh,xd,yh,yd:byte;pole:pointer);
var pole_okna:^t_pole_okna;
    p_znak:^t_znaky;
    pom:pointer;
    x:byte;
begin
 pole_okna:=pole;
 pom:=pole_okna^.poin[1,yd];         { zapamataj posledny }
 pole_okna^.poin[1,yd]:=NIL;         { zrus cesty na ne }
 pole_okna^.poin[2,yd]:=NIL;
 
 for x:=xh to xd do begin
     p_znak:=pom;
     obr^.znak_attr[yd,x]:=p_znak^.znak_attr;
     pom:=p_znak^.poin[2];
     FreeMem(p_znak,SizeOf(t_znaky));
     end;
end;
 
{ zvatsi okno smerom nadol }
procedure size_down(xh,xd,yh,yd:byte;pole:pointer);
var pole_okna:^t_pole_okna;
    p_znak,d_znak:^t_znaky;
    pom:pointer;
    x:byte;
begin
 pole_okna:=pole;
 GetMem(p_znak,SizeOf(t_znaky));
 pole_okna^.poin[1,yd+1]:=p_znak;
 p_znak^.znak_attr:=obr^.znak_attr[yd+1,xh];
 
 for x:=xh+1 to xd do begin
   GetMem(d_znak,SizeOf(t_znaky));
   d_znak^.znak_attr:=obr^.znak_attr[yd+1,x];
   p_znak^.poin[2]:=d_znak;
   d_znak^.poin[1]:=p_znak;
   p_znak:=d_znak;
  end;
 
 p_znak:=pole_okna^.poin[1,yd+1];
 pole_okna^.poin[2,yd+1]:=d_znak;
 p_znak^.poin[1]:=d_znak;
 d_znak^.poin[2]:=p_znak;
end;
 
begin
 obr:=Ptr($B800,0);           { nastav pole do pamate obrazovky }
end.
Trsek Commander - Substitute of Norton Commander, pascal

Navigační menu

Osobní nástroje

Hledat

Pascal source

Pascal Wiki

Bonus

Contacts

Languages
