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

Delphi & Pascal (èeská wiki)
Pøejít na: navigace, hledání
Kategorija: Programy zos Pascalu
zaluzie.pngProgram: Zaluzie.pas,  Archiv.pas,  Dealer.pas,  Farba.pas,  Fax.pas,  Filter.pas,  Formul.pas,  Fyzic.pas,  Help.pas,  Kniznic.pas,  Miesto.pas,  Mzdy.pas,  Option.pas,  Pr_zal.pas,  Read_dbf.pas,  Redef.pas,  Sdv.pas,  Tlac.pas,  Trsek.pas,  Zaluz.pas,  Zostavy.pas
Subor exe: Zaluzie.exe
Mu¹i¹ mac: Zaluzie.zip,  Help.dat,  Dealer,  Dealer.$$$,  Fax.dat,  Kumuly.$$$,  Kumuly.frm,  Kumuly.kum,  Merac,  Montaz,  Option.dbf,  Option.frm,  Option.ind,  Poradie.dat,  Vystup.txt,  Zaluzie.dbf,  Zaluzie.dat,  Zaluzie.frm,  Zaluzie.ind,  Zaluzie.txt,  Zostava.frm

Program bol vytvorený pre vnutorné potreby firmy KOMA pre spravu objednávok ¾alúzií.

Bli¾¹í popis jednotlivých funkcií:
F2 - Zalúzia
Slú¾i ako nosná èas» celého tohto programu dajú sa v òom zadáva» informácie o objednávateµovi ako jeho MENO, ADRESA, PODLA®IE.
Kvôli neskor¹ím rozpisom je mo¾né vyplni» (©TVR«) program sa potom bude týmto riadi».
Ïalej informácie o tom kto bol dohadzovaè (DEALER), kto odmeriaval ¾alúziu (MERAÈ) a nakoniec mená a¾ troch (MONTÁ®NIKOV).
Je mo¾né ïalej vyplni» DATUM OBJEDNAVKY, s tým, ¾e program okam¾ite prepoèíta kedy uplyie doba 14 dní na vykonanie montá¾e (LEHOTA).
Ak je nám známa CENA ¾alúzie po je vyplnení okam¾ite vypoèítava DOPLATOK. Po vyplnení ZALOHY je vypoèítaný doplatok znova.
Pri vyplòovaní mzdových nákladov máme pribli¾ný mzdový charakter pre jednotlivých zainteresovaných.
®alúzie sa vypåòajú intuitívne prièom ak nie je zadaná farba nie je mo¾né vyplni» ¾alúziu ïal¹iu.

Èíselníky pre STVRT, DEALER, MERAC, MONTAZNIK, FARBA sú aktivované okam¾ite po stlaèení klávesy ENTER. Potom si staèí vybra» potrebné a znova stlaèi» ENTER. Ak v¹ak má u¾ívateµ èísla v krvi staèí napísa» priamo èíslo program si u¾ neako poradí sám.

F3 - DEALER, F5 - MERAC, F6 - MONTAZ, F4 - FARBA
Okno pre doplnenie èíselníka dealerov (meraèov, montá¾nikov farieb). Pohyb ¹ipkami, ESC - koniec práce, DEL - oznaè dealera na zmazanie.

F4 - ULICA
Okno pre doplnenie èíselníka ulíc. Ostatné ako u DEALER. Ak v¹ak stlacíte ENTER na polo¾ke vpravo objaví sa vám okno MESTO, kde si vyberiete do akého mesta potrí ulica. Aj v meste je e¹te mo¾né vybra» KRAJ. ( Upozoròujem, ¾e názvy sú pracovné. Znamená, ¾e ich pou¾itie mô¾e by» iné). 
{ FAX.PAS                   Copyright (c) TrSek alias Zdeno Sekerak }
{ Rutiny pre pracu s faxom. Posielanie objednavok.                  }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
function getfax(meno:string):longint;
var f:text;
    s:string;
begin
 assign(f,meno);
 {$I-}
 reset(f);
 {$I+}                                  { Nenasiel cislo subor s poslednym cislom faxu }
 if ioresult<>0 then begin
    rewrite(f);
    writeln(f,'0');
    getfax:=0;
   end
  else begin
   readln(f,s);
   getfax:=vali(s);
  end;
 close(f);
end;
 
procedure putfax(meno:string;cislo:integer);
var f:text;
    s:string;
begin
 assign(f,meno);
 rewrite(f);
 writeln(f,stri(cislo,1));
 close(f);
end;
 
function vytried(cfax:integer;pfax:string):longint;
const meno_sub='zaluzie.dat';
var cis,mcis:integer;
    err:integer;
    akt,kolko:longint;
    s,meno_o:string;
    i:longint;
    f:text;
    fza:file of tzaluz;
    fza1:file of fzaluz;
    zaluz:tzaluz;
    zaluf:fzaluz;
    bo:boolean;
begin
 if cfax=0 then begin vytried:=0;exit;end;
 hlaska('Hladam dane formulare pre FAX             ',-1);
 assign(f,pfax+'.$$$');
 rewrite(f);
 opendbase(subor);                { vyberie vsetky FAX pre danne cislo }
 for i:=1 to poc do begin
    cit_vety(subor,i);
    if (base[realy_find('ZMAZ')][1]<>'A') then
     if vali(base[realy_find('FAX')])=cfax then
        writeln(f,base[realy_find('ZALUZIA')],':',base[realy_find('S')],base[realy_find('SYMC')]);
      end;
 writeln(f,'0');
 close(f);
 
 assign(f,pfax+'.$$$');
 reset(f);readln(f,s);close(f);
 if vali(s)=0 then begin
    hlaska('Nen jdenì §iaden FAXovì vstup pod >¡slom '+stri(cfax,6)+'.',-1);
    vytried:=0;
    exit;
    end;
 
                                        { Vybera zname zaluzie }
 hlaska('Selektujem objednan  §al£zie             ',-1);
 assign(f,pfax+'.$$$');
 reset(f);
                                        { zo suboru zaluz.dat }
 assign(fza,meno_sub);
 {$I-}
 reset(fza);
 err:=ioresult;
 if err<>0 then begin
    rewrite(fza);
     err:=ioresult;
     end;
 {$I+}
 if err<>0 then begin hlaska('Chyba z pisu na disk. Pracovnì disk chr nenì proti z pisu.',0);exit;end;
 
 assign(fza1,pfax+'.$$1');                   { Vyberie vsetky zaluzie }
 rewrite(fza1);
 
 readln(f,s);kolko:=0;
 while (not (eof(f)) ) do begin
  akt:=vali(copy(s,1,pos(':',s)-1));meno_o:=copy(s,pos(':',s)+1,text_obj);
 
  repeat
   seek(fza,akt);read(fza,zaluz);
   if not((zaluz.sirka=0) and (zaluz.vyska=0)) and not(zaluz.del) then begin
      with zaluf do begin
       meno_f:=meno_o;porad:=1;farba:=zaluz.farba;
       sirka:=zaluz.sirka;vyska:=zaluz.vyska;
       end;
      kolko:=kolko+1;
      seek(fza1,kolko);write(fza1,zaluf);
      end;
   akt:=zaluz.zani;
  until (akt=0);
 
  with zaluf do begin
   meno_f:=meno_o;farba:=nothing(SizeOf(zaluf.farba));
   sirka:=0;vyska:=0;porad:=0;
   end;
 
  kolko:=kolko+1;
  seek(fza1,kolko);write(fza1,zaluf);
  readln(f,s);
  bo:=eof(f);
 end;
 
 close(f);
 prikaz('del '+pfax+'.$$$');             { miesto erase }
 close(fza1);
 close(fza);
 vytried:=kolko;
end;
 
procedure zapis_fax(pfax:string);
var f:text;
    i:integer;
begin
 assign(f,pfax);
 append(f);
 fzoz:=prvy;
 for i:=1 to dlzpap do begin
     writeln(f,fzoz^.text);
     if i<>dlzpap then fzoz:=fzoz^.zani;
     end;
 writeln(f,chr(12));
 close(f);
 fzoz:=prvy;
 for i:=1 to dlzpap do begin
     fzoz^.text:=nothing(sirpap);
     if i<>dlzpap then fzoz:=fzoz^.zani;
     end;
end;
 
procedure fgotoxy(x,y:integer);
begin
 fgx:=x;fgy:=y;
end;
 
procedure fwrite(s:string);
var i:integer;
begin
 fzoz:=prvy;
 for i:=2 to fgy do if fzoz^.zani<>NIL then fzoz:=fzoz^.zani;
 for i:=fgx to fgx+length(s)-1 do if i<=sirpap then fzoz^.text[i]:=s[i-fgx+1];
end;
 
procedure fwriteln(s:string);
begin
 fwrite(s);
 fgy:=fgy+1;
end;
 
procedure hlavicka(x,y,typ_fa:integer);
begin
 case typ_fa of
      1: begin
         fgotoxy(x,y  );fwriteln('ÚÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÂÄÄÄÄÄ¿');
         fgotoxy(x,y+1);fwriteln('³ ç¡rka³ vìçka³ ks³color³');
         fgotoxy(x,y+2);fwriteln('ÃÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÅÄÄÄÄÄ´');
         end;
      2: begin
         fgotoxy(x,y  );fwriteln('ÚÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÂÄÄÄÄÄ¿');
         fgotoxy(x,y+1);fwriteln('³objed ³ ç¡rka³ vìçka³ ks³color³');
         fgotoxy(x,y+2);fwriteln('ÃÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÅÄÄÄÄÄ´');
         end;
     end;
 fgx:=x;
end;
 
procedure paticka(x,y,typ_fa,stred:integer);
begin
  fgotoxy(x,y);
  if (y+3)>dlzpap then begin
     if stred in [1,2,3] then stred:=2
                         else stred:=5;
     end;
 
  case stred of
   1:case typ_fa of
       1: fwriteln('ÃÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÅÄÄÄÄÄ´');
       2: fwriteln('ÃÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÅÄÄÄÄÄ´');
     end;
   2:case typ_fa of
       1: fwriteln('ÀÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÁÄÄÄÄÄÙ');
       2: fwriteln('ÀÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÁÄÄÄÄÄÙ');
     end;
   3:case typ_fa of
       1: fwriteln('ÃÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÁÄÄÄÄÄ´');
       2: fwriteln('ÃÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÁÄÄÄÄÄ´');
     end;
   4:case typ_fa of
       1: fwriteln('ÃÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÂÄÄÄÄÄ´');
       2: fwriteln('ÃÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÂÄÄÄÄÄ´');
     end;
   5:case typ_fa of
       1: fwriteln('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
       2: fwriteln('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
     end;
   end;
end;
 
procedure new_page(cfax,typ_fa,sir:integer;var str:integer;var zavri:boolean;prod:string);
begin
 if zavri then paticka(fgx,fgy,typ_fa,2);
 fgx:=fgx+sir;fgy:=3;zavri:=false;
 
 if fgx+sir>sirpap then begin
    zapis_fax(prod);fgx:=1;fgy:=1;str:=str+1;
    fwriteln('FAXovì vìstup >.'+stri(cfax,0)+' objedn vky §al£zi¡. Zo dåa '+get_realy_date(1)+' strana:'+stri(str,0));
    fgy:=fgy+1;
    end;
 hlavicka(fgx,fgy,typ_fa);zavri:=true;
end;
 
procedure fax_text(zdroj,prod:string;cfax,typ_fa:integer);
var f:text;
    fza:file of fzaluz;
    zaluf:fzaluz;
    sir,str:integer;
    i,in_far:integer;
    meno_o:string;
    poc:array[0..vcisla] of integer;
    ploch:array[0..vcisla] of double;
    in_ploch:array[0..vcisla] of double;
    in_poc:array[0..vcisla] of integer;
    zavri:boolean;                      { pisat paticku a/n }
begin
 case typ_fa of
   1: sir:=length('ÀÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÁÄÄÄÄÄÙ')+1;
   2: sir:=length('ÀÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÁÄÄÄÄÄÙ')+1;
   end;
 fzoz:=NIL;
 fzoz:=zarad(fzoz^,nothing(sirpap));prvy:=fzoz;
 fgx:=1;fgy:=1;str:=1;zavri:=true;
 for i:=2 to dlzpap do fzoz:=zarad(fzoz^,nothing(sirpap));
 
 assign(f,prod);
 rewrite(f);
 close(f);
 
 assign(fza,zdroj);
 reset(fza);
 
 for i:=0 to vcisla do ploch[i]:=0;
 for i:=0 to vcisla do poc[i]:=0;
 for i:=0 to vcisla do in_ploch[i]:=0;
 for i:=0 to vcisla do in_poc[i]:=0;
 
 fwriteln('FAXovì vìstup >.'+stri(cfax,0)+' objedn vky §al£zi¡. Zo dåa '+get_realy_date(1)+' strana:'+stri(str,0));
 fgy:=fgy+1;meno_o:=nothing(text_obj);
 hlavicka(fgx,fgy,typ_fa);
 
 read(fza,zaluf);in_far:=vali(zaluf.farba);
 
 while ( not (eof(fza)) ) do begin
   if (fgy+2) > dlzpap then new_page(cfax,typ_fa,sir,str,zavri,prod);
   fgotoxy(fgx,fgy);
   case typ_fa of
    1: fwrite('³'+strr(zaluf.sirka,6)+'³'+strr(zaluf.vyska,6)+'³'+
                  stri(zaluf.porad,3)+'³'+strsi(zaluf.farba,farba_sir)+'³');
    2: if meno_o<>zaluf.meno_f then
        fwrite('³'+zaluf.meno_f+'³'+strr(zaluf.sirka,6)+'³'+strr(zaluf.vyska,6)+'³'+
                  stri(zaluf.porad,3)+'³'+strsi(zaluf.farba,farba_sir)+'³')
       else
        fwrite('³'+nothing(text_obj)+'³'+strr(zaluf.sirka,6)+'³'+strr(zaluf.vyska,6)+'³'+
                  stri(zaluf.porad,3)+'³'+strsi(zaluf.farba,farba_sir)+'³');
    end;
 
   inc(fgy);zavri:=true;
 
   { Scitavaj podla farieb      Ak sirka*vyska<0.5 potom plocha=0.5     }
   { Oprava 27.3.96 bolo iba 5000 a pri vacsich cislach nad 32000 blbol }
   { Predpokladal Integer                                               }
   if ( zaluf.sirka * zaluf.vyska ) < 5000.0 then begin
       ploch[ in_far ]    :=    ploch[ in_far ] + ( 5000.0 * zaluf.porad );
       in_ploch[ in_far ] := in_ploch[ in_far ] + ( 5000.0 * zaluf.porad );
      end
     else begin
      ploch[ in_far ]    := ploch[ in_far ] + zaluf.sirka * zaluf.vyska * zaluf.porad;
      in_ploch[ in_far ] := in_ploch[ in_far ] + zaluf.sirka * zaluf.vyska * zaluf.porad;
      end;
 
   in_poc[ in_far ] :=   in_poc[ in_far ] + zaluf.porad;
   poc[ in_far ]    :=      poc[ in_far ] + zaluf.porad;
 
   meno_o:=zaluf.meno_f;
   read(fza,zaluf);in_far:=vali(zaluf.farba);
 
   if meno_o<>zaluf.meno_f then begin        { Pre jednu objednavku vypis farby }
      if zavri then paticka(fgx,fgy,typ_fa,3);
      zavri:=false;
 
      for i:=3 to vcisla do in_ploch[2] := in_ploch[2] + in_ploch[i];
      for i:=3 to vcisla do   in_poc[2] :=   in_poc[2] + in_poc[i];
      in_ploch[2] := in_ploch[2] + in_ploch[0];
        in_poc[2] := in_poc[2]   + in_poc[0];
 
      if (fgy+2)>dlzpap then new_page(cfax,typ_fa,sir,str,zavri,prod);
 
      case typ_fa of
          1: fwriteln('³Col='+strri(in_ploch[2]/10000,7,3)+'m2 po>='+stri(in_poc[2],3)+'ks³');
          2: fwriteln('³  Col='+strri(in_ploch[2]/10000,7,3)+' m2  po>et='+stri(in_poc[2],3)+'ks ³');
          end;
 
      { Ak je pre farbu 1 }
      if in_ploch[1]<>0 then
      case typ_fa of
          1: fwriteln('³Al='+strri(in_ploch[1]/10000,7,3)+' m2 po>='+stri(in_poc[1],3)+'ks³');
          2: fwriteln('³   Al='+strri(in_ploch[1]/10000,7,3)+' m2  po>et='+stri(in_poc[1],3)+'ks ³');
          end;
 
      { Znuluj polia s kumulativnou sumou }
      for i:=0 to vcisla do in_ploch[i]:=0;
      for i:=0 to vcisla do in_poc[i]:=0;
      if fgy+2>=dlzpap then paticka(fgx,fgy,typ_fa,5)
                       else paticka(fgx,fgy,typ_fa,4);
      zavri:=false;
      end;
  end;
 close(fza);                    { miesto erase(fza); }
 prikaz('del '+zdroj);
 
 if zavri then begin
    paticka(fgx,fgy,typ_fa,3);
 
    for i:=3 to vcisla do in_ploch[2] := in_ploch[2] + in_ploch[i];
    for i:=3 to vcisla do   in_poc[2] :=   in_poc[2] + in_poc[i];
      in_ploch[2]:=in_ploch[2]+in_ploch[0];
      in_poc[2]:=in_poc[2]+in_poc[0];
 
   case typ_fa of
        1: fwriteln('³Col='+strri(in_ploch[2]/10000,7,3)+'m2 po>='+stri(in_poc[2],3)+'ks³');
        2: fwriteln('³  Col='+strri(in_ploch[2]/10000,7,3)+' m2  po>et='+stri(in_poc[2],3)+'ks ³');
       end;
 
   if in_ploch[1]<>0 then
   case typ_fa of
        1: fwriteln('³Al='+strri(in_ploch[1]/10000,7,3)+' m2 po>='+stri(in_poc[1],3)+'ks³');
        2: fwriteln('³   Al='+strri(in_ploch[1]/10000,7,3)+' m2  po>et='+stri(in_poc[1],3)+'ks ³');
        end;
 
   if not((fgy+1) > dlzpap) and zavri then paticka(fgx,fgy,typ_fa,5);
 end;
 
 fgotoxy(1,dlzpap);
 
 { Nakoniec vypis globalne pre kumulovane sumy farieb }
 for i:=3 to vcisla do ploch[2] := ploch[2] + ploch[i];
 ploch[2]:=ploch[2]+ploch[0];
 for i:=3 to vcisla do   poc[2] :=   poc[2] +   poc[i];
 poc[2]:=poc[2]+poc[0];
 
 fwrite(' Al ='+strri(ploch[1]/10000,7,3)+' m2  po>et='+stri(poc[1],6)+' ks   '+
        ' Col='+strri(ploch[2]/10000,7,3)+' m2  po>et='+stri(poc[2],6)+' ks ');
 
 zapis_fax(prod);
 
 fzoz:=prvy;                             { Vycisti po sebe pamat }
 repeat
  fzoz:=vyrad(fzoz^);
 until (fzoz=NIL);
end;
 
function fax(cfax,typ_fa:integer):string;
var cis,err:integer;
    kolko:longint;
    fza,fza1:file of fzaluz;
    zaluz,zalu2:fzaluz;
    pfax:string;
    prv,dru:longint;
    f:text;
    i:word;
begin
 farba(ptlac,ftlac);pfax:='f'+get_realy_date(2);
 hlaska('',-2);
 okno(5,10,75,15,' Podmienka ','',ptlac);
 writeln(' ( BuÔ zad ç existuj£ce >¡slo, alebo 0 vytvor Ôalç¡ z nezaradenìch.) ');
 writeln('       Zadaj >¡slo faxu :              Poslednì mal >¡slo :'+stri(getfax(nfax+'.dat'),6));
 if cfax=0 then cfax:=vali('0'+tread(30,3,5,stri(cfax,5),'',#0,#0));
 if cfax=0 then begin                           { Ak je nula tak vytvori novy FAX }
     cis:=getfax(nfax+'.dat')+1;
 
     hlaska('Priradzujem nov, >¡slo FAXu = '+stri(cis,5)+'           ',-1);
     opendbase(subor);
     i:=0;
     repeat
      i:=i+1;
      cit_vety(subor,i);
      if vali(base[realy_find('FAX')])=0 then begin
         base[realy_find('FAX')]:=stri(cis,hlavy[realy_find('FAX')].size);
         zap_vety(subor,i);
        end;
     until (i>=poc);
    end
   else cis:=cfax;
 
 kolko:=vytried(cis,pfax);                           { Najdi vsetky pre danny FAX }
 if kolko=0 then begin
    {$I-}
    assign(f,pfax+'.txt');
    reset(f);
    {$I+}
    if IoResult=0 then prikaz('del '+pfax+'.txt');
    exit;
    end;
                                                { Vytriedy zhodne }
 hlaska('H-ad m, ktor  m"§em posp ja? !?!             ',-1);
 assign(fza,pfax+'.$$1');
 reset(fza);
 prv:=1;dru:=1;
 seek(fza,prv);read(fza,zaluz);
 
 repeat
  dru:=dru+1;
  seek(fza,dru);read(fza,zalu2);                { Nasiel co mu vyhovuje dve zhodne !!! }
  if (zaluz.sirka=zalu2.sirka) and (zaluz.vyska=zalu2.vyska) and
     (zaluz.farba=zalu2.farba) and (zaluz.porad<>0) then begin
     zaluz.porad:=zaluz.porad+1;
     zalu2.porad:=0;
     seek(fza,prv);write(fza,zaluz);
     seek(fza,dru);write(fza,zalu2);
     end;
                                                { Presiel vsetky kontroly }
  if (vali(zalu2.farba)=0) then begin
     prv:=prv+1;
     seek(fza,prv);read(fza,zaluz);
     while ( (zaluz.farba=nothing( SizeOf(zalu2.farba))) and not(eof(fza)) ) do begin
           prv:=prv+1;
           seek(fza,prv);read(fza,zaluz);
           end;
     dru:=prv;
     end;                                       { Je koniec suboru zaluzii }
 until ( (eof(fza) ));
 close(fza);
 
                                                { Prefiltruj zaluzie }
 hlaska('Filtrujem n jdene ...             ',-1);
 assign(fza,pfax+'.$$1');
 reset(fza);
 assign(fza1,pfax+'.$$2');
 rewrite(fza1);
 seek(fza,1);
 read(fza,zaluz);
 while ( not (eof(fza)) ) do begin
     if (zaluz.porad<>0) then write(fza1,zaluz);
     read(fza,zaluz);
     end;
 
 write(fza1,zaluz);
 close(fza);                                   { miesto  erase(fza);}
 prikaz('del '+pfax+'.$$1');
 close(fza1);
                                               { Vytvor textovy subor }
 hlaska('Vytv ram textov£ zostavu.',40);
 fax_text(pfax+'.$$2','faxy\'+pfax+'.txt',cis,typ_fa);
 hlaska('',-2);
 if getfax(nfax+'.dat')<cis then putfax(nfax+'.dat',cis);
 view_text('faxy\'+pfax+'.txt',lav_kraj,ftlac,ptlac,prin);
end;