Program pre spr8vu objednávok žalúzií.

{ ZALUZIE.PAS               Copyright (c) TrSek alias Zdeno Sekerak }
{ Unit pre tlac textovej zostavy na tlaciaren LPT1 alebo FAX.       }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
unit tlac;
interface
uses printer,dos,crt,kniznic,trsek;
type tzoz = record
     pred:pointer;
     text:string[140];
     zani:pointer;
     end;
 
function zarad(var zoz:tzoz;s:string):pointer;
function vyrad(var zoz:tzoz):pointer;
procedure view_text(subor_txt:string;lav_kraj,pismo,podkl:integer;prin:string);
 
implementation
 
 
function zarad(var zoz:tzoz;s:string):pointer;
var zoz2:^tzoz;
    jed,dva:pointer;
    size,size2:longint;
begin
 size:=MaxAvail;
 size2:=SizeOf(tzoz);
 if MaxAvail<2*SizeOf(tzoz) then begin
    hlaska('M lo pam"te tak sa ne>uduj, ze nevidĄç celŁ zostavu. ',-1);
    z_sound:=false;exit;end;
 getmem(zoz2,SizeOf(tzoz));
 if @zoz<>NIL then begin
    dva:=zoz.zani; jed:=@zoz; zoz.zani:=zoz2;
    zoz2^.pred:=@zoz; zoz2^.zani:=dva;
 
    if zoz2^.zani<>NIL then begin
       dva:=zoz2;
       zoz2:=zoz.zani;
       zoz2^.pred:=dva;
      end;
    end
    else begin
       zoz2^.pred:=NIL;
       zoz2^.zani:=NIL;
       end;
 zoz2^.text:=copy(s,1,80);
 zarad:=zoz2;
end;
 
function vyrad(var zoz:tzoz):pointer;
var jed,dva:pointer;
    zoz2:^tzoz;
    size2:longint;
begin
 jed:=zoz.pred;dva:=zoz.zani;
 if jed<>NIL then begin zoz2:=jed;zoz2^.zani:=dva;end;
 if dva<>NIL then begin zoz2:=dva;zoz2^.pred:=jed;end;
 size2:=MaxAvail;
 FreeMem(@zoz,SizeOf(zoz));
 size2:=MaxAvail;
 if jed<>NIL then vyrad:=jed
             else vyrad:=dva;
end;
 
procedure view_text(subor_txt:string;lav_kraj,pismo,podkl:integer;prin:string);
 
var f:text;
    lst:text;
    zoz:^tzoz;
    prvy,pom:pointer;
    s:string;
    y,i,err:integer;
    ch:char;
begin
 farba(podkl,pismo);
 okno(1,1,80,24,' Prezera> sŁboru '+subor_txt,' Pohyb-çĄpkami,PgDn,PgUp ESC-Koniec ENTER-Tla>',podkl);
 assign(f,subor_txt);
 {$I-}
 reset(f);
 {$I+}
 if IoResult<>0 then begin
    hlaska('SŁbor pre fax pr zdny resp. nexistuje.',0);
    exit;
    end;
                                      { Nacita subor FAX.TXT }
 GetMem(zoz,SizeOf(zoz^));
 prvy:=NIL;zoz^.pred:=NIL;zoz^.zani:=NIL;zoz^.text:='';
 repeat
  readln(f,s);
  zoz:=zarad(zoz^,copy(s,1,77));
  if prvy=NIL then prvy:=zoz;
 until (eof(f));
 close(f);
 
 zoz:=prvy;i:=1;                        { Vykresli ho na obrazovku }
 while ( (zoz<>NIL) and (i<23) ) do begin
     writeln;
     write(zoz^.text);
     i:=i+1;zoz:=zoz^.zani;
     end;
                                        { No a hybe sipkami }
 zoz:=prvy;
 repeat
  twindow(2,2,78,23);
  KurzorZap(false);
  ch:=readkey;
  if ch=#0 then begin
     ch:=readkey;
 
     if ch=#73 then                         { PgUp }
        for y:=1 to 23 do begin
        if zoz^.pred<>NIL then begin
           zoz:=zoz^.pred;
           gotoxy(1,1);insline;
           write(zoz^.text);
          end;
        end;
 
     if ch=#81 then                         { PgDn }
        for y:=1 to 23 do begin
        i:=1;pom:=zoz;
        while (( zoz^.zani<>NIL) and (i<23)) do begin
                 i:=i+1;zoz:=zoz^.zani;
                 end;
        if (i=23) then begin
           gotoxy(1,1);delline;
           gotoxy(1,22);write(copy(zoz^.text,1,76));
           zoz:=pom;zoz:=zoz^.zani;
         end;
        end;
 
     if ch=#72 then begin                   { sipka hore }
        if zoz^.pred<>NIL then begin
           zoz:=zoz^.pred;
           gotoxy(1,1);insline;
           write(zoz^.text);
        end;
       end;
 
     if ch=#80 then begin                    { sipka dole }
        i:=1;pom:=zoz;
        while (( zoz^.zani<>NIL) and (i<23)) do begin
                 i:=i+1;zoz:=zoz^.zani;
                 end;
        if (i=23) then begin
           gotoxy(1,1);delline;
           gotoxy(1,22);write(copy(zoz^.text,1,76));
           zoz:=pom;zoz:=zoz^.zani;
        end
       else zoz:=pom;
      end;
 
     end;
 
   if ch=#13 then begin                 { Vytlaci ho na printer }
      hlaska('Tla>Ąm sŁbor '+subor_txt+' . ChvĄ-u po>kaj .',-1);
      assign(f,subor_txt);
      reset(f);
      assign(lst,prin);
      rewrite(lst);
      repeat
       readln(f,s);
       repeat
        {$I-}
        writeln(lst,nothing(lav_kraj)+s);
        err:=IoResult;
        {$I+}
        if err<>0 then begin
           hlaska('Chyba tla>iarne, alebo tla>iaren nepripraven . ENTER-znova ESC-koniec',0);
           ch:=readkey;
           end;
       until ( (err=0) or (ch=#27) )
      until ( eof(f) or (ch=#27) );
      ch:=#13;
      close(f);close(lst);
      hlaska('',-2);
      end;
 until (ch=#27);                        { Uz ho to prestalo bavit }
 
 zoz:=prvy;                             { Vycisti po sebe pamat }
 repeat
  zoz:=vyrad(zoz^);
 until (zoz=NIL);
 hlaska('',-2);
end;
 
end.