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

{ FORMUL.PAS                Copyright (c) TrSek alias Zdeno Sekerak }
{ Pre pracu s formularmi vo formate stanovenom v T602.              }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
function find(s:string):integer;
begin
 find:=0;
 for i:=1 to max_viet do begin
   if (formular[i].pol<>0) then
      if ( hlavy[formular[i].pol].nazov[1]=s[1] ) then
         if ( strs(hlavy[formular[i].pol].nazov,true)=s ) then
            begin find:=formular[i].pol;i:=max_viet;end;
   end;
end;
 
function form_find(s:string):integer;
begin
 form_find:=0;
 for i:=1 to max_viet do begin
   if (formular[i].pol<>0) then
      if ( hlavy[formular[i].pol].nazov[1]=s[1] ) then
         if ( strs(hlavy[formular[i].pol].nazov,true)=s ) then
            begin form_find:=i;i:=max_viet;end;
   end;
end;
 
function view_frm(meno:string):integer;
var f:text;
    i,i1,x,y,p:integer;
    s,sprem:string;
    prem:boolean;
    pom:formul;
 
begin
 for x:=1 to max_viet do begin
     formular[x].x:=0;formular[x].y:=0;
     formular[x].pol:=0;formular[x].rkluc:=' ';
     end;
 
 assign(f,meno+k_form);
 {$I-}
 reset(f);
 {$I+}
 if IOResult<>0 then begin
     hlaska(' Neexistuje subor s formularom '+meno+k_form,0);
     view_frm:=0;
     exit;
    end;
 s:='@';
 while ( not(eof(f)) and (s[1]='@')) do readln(f,s);
 
 gotoxy(1,1);prem:=false;y:=1;p:=0;sprem:='';
 while ( not(eof(f)) and (y<23) ) do begin
   writeln;
   for x:=1 to length(s) do
       if prem then begin
           if s[x]<>')' then sprem:=sprem+s[x]
               else begin
                prem:=false;i:=0;
                while ( (i<=max_viet) and (formular[p].pol=0) ) do begin
                         i:=i+1;
                         formular[p].pol:=i;
                         for i1:=1 to length(sprem) do
                          if hlavy[i].nazov[i1]<>sprem[i1] then formular[p].pol:=0;
                        end;
                sprem:='';
               end;
             end
            else begin
             if s[x] in ['A'..'Z'] then formular[p+1].rkluc:=s[x];
             if copy(s,x,3)='$(:' then begin prem:=true;x:=x+2;p:=p+1;
                 formular[p].x:=x-2;
                 formular[p].y:=y;
                end
                else begin gotoxy(x,y);write(s[x]);end;
             end;
   readln(f,s);prem:=false;sprem:='';y:=y+1;
   while (s[1]='@') do readln(f,s);
  end;
 close(f);
 
 view_frm:=1;
 
 assign(f,poradie);                                { Ak existuje subor poradie nacita ho }
 {$I-}
 reset(f);
 {$I+}
 if IOResult<>0 then exit;
 x:=1;
 
 while not(eof(f)) do begin
   readln(f,s);x:=x+1;
   y:=form_find(s);
   if (y<>0) and (formular[x].pol<>0) then begin
        pom.x:=formular[x].x;
        pom.y:=formular[x].y;
      pom.pol:=formular[x].pol;
    pom.rkluc:=formular[x].rkluc;
 
        formular[x].x:=formular[y].x;
        formular[x].y:=formular[y].y;
      formular[x].pol:=formular[y].pol;
    formular[x].rkluc:=formular[y].rkluc;
 
        formular[y].x:=pom.x;
        formular[y].y:=pom.y;
      formular[y].pol:=pom.pol;
    formular[y].rkluc:=pom.rkluc;
      end;
   end;
 close(f);
 
end;
 
procedure view_pol(pol:integer);
var s:string;
begin
 gotoxy(formular[pol].x,formular[pol].y);
 if hlavy[formular[pol].pol].typep='D' then
     write(ask_date(base[formular[pol].pol]))
    else write(base[formular[pol].pol]);
 gotoxy(formular[pol].x,formular[pol].y);
end;
 
function realy_find(s:string):integer;
begin
 realy_find:=0;
 for i:=1 to max_viet do begin
   if ( hlavy[i].nazov[1]=s[1] ) then
      if ( strs(hlavy[i].nazov,true)=s ) then
         begin realy_find:=i;i:=max_viet;end;
   end;
end;
 
procedure quick_view_all(var c_plocha,c_pocet:double;p_zal:boolean);
var i:integer;
begin
 i:=1;
 for i:=1 to max_viet do
   if (formular[i].pol<>0) then begin
       gotoxy(formular[i].x,formular[i].y);
       if hlavy[formular[i].pol].typep='D' then
               write(ask_date(base[formular[i].pol]))
          else write(base[formular[i].pol]);
      end;
 if p_zal then i:=proc_zaluz(base[realy_find('ZALUZIA')],true,c_plocha,c_pocet);
end;