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

{ ZOSTAVY.PAS               Copyright (c) TrSek alias Zdeno Sekerak }
{ Unit pre generovanie textovych zostav. Vysledok je potom mozne    }
{ Vytlacit poslat emailom alebo faxom.                              }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
procedure get_frm_kum(meno:string);
var f,ff:text;
 s,ss:string;
  i,y:integer;
 bezi:boolean;
 
begin
 assign(ff,meno+'.$$$');
 rewrite(ff);
 
 assign(f,meno+'.kum');
 {$I-}
 reset(f);
 {$I+}
 s:='@';poc_kum:=0;bezi:=false;y:=1;ss:=nothing(80);
 for i:=1 to max_kum do begin
     kumulaty[i].meno:='';
     kumulaty[i].x:=0;
     kumulaty[i].y:=0;
     end;
 if IoResult<>0 then exit;
 while (s[1]='@') do readln(f,s);
 
 repeat
  for i:=1 to length(s) do
      if not(bezi) then begin
                        if (s[i]='$') and (s[i+1]='(') and (s[i+2]=':') then
                           begin
                            poc_kum:=poc_kum+1;bezi:=true;
                            kumulaty[poc_kum].x:=i;kumulaty[poc_kum].y:=y;
                            i:=i+2;
                           end
                          else ss[i]:=s[i];
                        end
                   else begin
                        if s[i]=')' then bezi:=false
                                    else kumulaty[poc_kum].meno:=kumulaty[poc_kum].meno+s[i];
                        end;
   readln(f,s);inc(y);
   writeln(ff,ss);ss:=nothing(80);
 until (eof(f));
 close(f);
 close(ff);
end;
 
function ex_kum(nazov:string):integer;
var i:integer;
    s:string;
begin
 ex_kum:=0;s:=strs(nazov,true);
 for i:=1 to max_kum do if s=kumulaty[i].meno then ex_kum:=i;
end;
 
procedure zostava(nazov,aky_text:string);
const d_text='';
var err,x,y,i,p:integer;
      pom:byte;
    poc_y,dlz_y,strana:integer;                 { pocet riadkov na 1 vypis, pocet stran }
    z_str:array[1..23] of string[80];           { pomocna strana na vypis do pamete - co viac[string,char] }
     kumy:array[1..max_kum] of real;
    dkumy:array[1..2,1..max_kum] of string[8];
 z_text,s,ss:string;
    f,ff:text;
 len_kum:boolean;
begin
 z_text:='zostavy\'+'z'+get_realy_date(2)+'.txt';       { Tam sa nachadza text }
 okno(1,1,80,24,' Zostavy formul r ',d_text,pozalu);
 opendbase(subor);
 cit_vety(subor,1);
 if view_frm(nazov)=0 then exit;
 get_frm_kum(nazov);
 writeln;dlz_y:=wherey-1;
 
 len_kum:=false;
 if s_exist(nazov+'.kum',0) then begin
     hlaska('Len kumulacie, alebo celu zostavu. Celu zostavu [A/..]',-1);
     if not(readkey in ['a','A']) then len_kum:=true;
     hlaska('',-2);
    end;
 
 for y:=1 to max_kum do begin
     kumy[y]:=0;
     dkumy[1,y]:='20001230';dkumy[2,y]:='00000000';
     end;
 
 for y:=1 to dlz_y do begin
  z_str[y]:='';
  for x:=1 to 79 do z_str[y]:=z_str[y]+' ';
  end;
 
 for y:=1 to dlz_y do begin
  for x:=1 to 79 do
   z_str[y][x]:=char(get_znak(x,y,pom));
  end;
 
 assign(f,z_text);
 {$I-}
 rewrite(f);
 err:=ioresult;
 {$I+}
 if err<>0 then begin hlaska('Chyba z pisu na disk. Pracovně disk chr neně proti z pisu.',0);exit;end;
 close(f);
 
 strana:=0;z_sound:=false;
 z_hlava(strana,poc_y,f,aky_text);
 
 for x:=1 to poc do begin
  hlaska('Veta >:'+stri(x,3)+'  z celkov,ho po>tu:'+stri(poc,3)+
         '. Percentu lne:'+stri(round(100*(x/poc)),3)+'%',-1);
  cit_vety(subor,x);
 
  for i:=1 to max_kum do begin
   y:=realy_find(kumulaty[i].meno);
   if y>0 then
      if hlavy[y].typep='D' then begin
         s:=ask_date(base[y]);
         if s[1]<>' ' then begin
            if dkumy[1,i]>base[y] then dkumy[1,i]:=base[y];
            if dkumy[2,i]<base[y] then dkumy[2,i]:=base[y];
            end;
         end
        else begin
         kumy[i]:=kumy[i]+valr(base[y]);
         end;
    end;
 
  for i:=1 to max_viet do
   if (formular[i].pol<>0) then begin
       if hlavy[formular[i].pol].typep='D' then s:=ask_date(base[formular[i].pol])
                                           else s:=base[formular[i].pol];
       for p:=1 to length(s) do z_str[formular[i].y][formular[i].x+p]:=s[p];
      end;
 
   {$I-}
   append(f);
   err:=ioresult;
   {$I+}
   if err<>0 then begin hlaska('Chyba z pisu na disk. Pracovně disk chr neně proti z pisu.',0);exit;end;
 
   if not(len_kum) then begin
      for y:=1 to dlz_y do writeln(f,z_str[y]);
      poc_y:=poc_y+dlz_y;
      if poc_y+dlz_y>dlzpap then z_hlava(strana,poc_y,f,aky_text);
      end;
   close(f);
 
   if keypressed then if readkey=#27 then begin
      hlaska('',-2);
      hlaska('Preruçen, u§Ąvate-om !!!',-1);
      x:=poc;
      end;
 end;
 
 append(f);                             { Este bude dokladat }
 assign(ff,nazov+'.$$$');
 {$I-}
 reset(ff);
 {$I+}
 y:=0;
 if IoResult=0 then begin
    repeat
     readln(ff,s);inc(y);
     for i:=1 to max_kum do
         if kumulaty[i].y=y then begin
            if dkumy[2,i]<>'00000000' then
                ss:=ask_date(dkumy[1,i])+' - '+ask_date(dkumy[2,i])
               else ss:=strr(kumy[i],9);
            for p:=1 to length(ss) do s[kumulaty[i].x+p]:=ss[p];
            end;
     writeln(f,s);
    until (eof(ff));
   close(ff);
   end;
 
 prikaz('del '+nazov+'.$$$');
 writeln(f,chr(12));close(f);
 view_text(z_text,lav_kraj,ftlac,ptlac,prin);
 hlaska('',-2);
end;