Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
{ ZALUZ.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ POmocne rutiny pre program zaluzie.                               }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
function uprav_pol(pol:integer;s:string):string;
var d,m,r:string;
begin
 
 if (hlavy[pol].typep='N') then
    if hlavy[pol].desat>0 then s:=strr(valr(s),hlavy[pol].size)
                          else s:=stri(vali(s),hlavy[pol].size);
 
 if (hlavy[pol].typep='D') then begin
     d:=copy(s,7,2);m:=copy(s,5,2);r:=copy(s,1,4);
     if vali(r)<1995 then r:='1995';
     if not(vali(m) in [1..12]) then m:='01';
     if not(vali(d) in [1..31]) then d:='01';
     if (vali(m) in [4,6,9,11]) and (d='31') then d:='30';
     if (vali(m) in [2]) and (vali(copy(s,3,2))>29) then d:='29';
     s:=r+m+d;
    end;
 
 if (hlavy[pol].typep='L') then
    if not(s[1] in ['A','a','N','n']) then s[1]:='N';
 
 s:=s+nothing(80);
 s:=copy(s,1,hlavy[pol].size);
 uprav_pol:=s;
end;
 
function tread2(y:integer;s,old:string;sedy,znak:char):string;
var sp:string;
 d,m,r:integer;
begin
 if hlavy[formular[y].pol].typep='D' then begin
         d:=vali(tread(formular[y].x  ,formular[y].y,2,s[1]+s[2],old,sedy,znak));
         m:=vali(tread(formular[y].x+3,formular[y].y,2,s[3]+s[4],old,#255,#32));
         r:=vali(tread(formular[y].x+6,formular[y].y,4,s[5]+s[6]+s[7]+s[8],old,#255,#32));
         sp:=stri(r,4);
         if m<10 then sp:=sp+'0'+stri(m,1)
                 else sp:=sp+stri(m,2);
         if d<10 then sp:=sp+'0'+stri(d,1)
                 else sp:=sp+stri(d,2);
         tread2:=sp;
    end
   else
     tread2:=tread(formular[y].x,formular[y].y,hlavy[formular[y].pol].size,s,old,sedy,znak);
end;
 
function find_p(znak:char):integer;             { Najdi prvy vyhovujuci CTRL + znak }
var x,y,p:integer;
begin
 y:=1;p:=0;
 repeat
  if formular[y].pol <> 0 then
     if znak=formular[y].rkluc then p:=1;
  y:=y+1;
 until ( (p>0) or (y>max_viet) );
 
 if p>0 then find_p:=y-1
        else find_p:=0;
end;
 
procedure zakazka;
const d_text='PgDn,PgUp F4-Nově F7-Filter Shift+F8-zrus ENTER-ŹĄselnĄk CRTL[znak]-Polo§ka';
var     veta:integer;
  hlada,y,ys:integer;
        i1,p:integer;
          ch:char;
     s1,s2,s:string;
         vst:boolean;
   hore,dole:boolean;
 c_plocha,c_pocet:double;
        prvy:boolean;
    prepocet:boolean;
      filter:boolean;
begin
 farba(pozalu,fozalu);
 okno(1,1,80,24,' Zak zka zad vanie ',d_text,pozalu);
 opendbase(subor);
 cit_vety(subor,1);
 if view_frm(subor)=0 then exit;
 
 veta:=poc;y:=1;vst:=false;                   { Pociatocna veta je posledna }
 dole:=true;hore:=false;
 
 if poc=0 then begin                          { ak je nahodou ciste DBF }
    poc:=1;veta:=poc;
    for i:=1 to max_viet do base[i]:=nothing(hlavy[i].size);
    s:=stri(poc,hlavy[formular[1].pol].size);
    for i:=1 to length(s) do base[formular[1].pol][i]:=s[i];
    zap_vety(subor,veta);
    end;
 
 cit_vety(subor,veta);
 farba(pnzalu,fnzalu);
 quick_view_all(c_plocha,c_pocet,true);
 prvy:=true;prepocet:=false;filter:=false;
                                            { taku vetu nastavi  }
                                            { Je zapnuty filter  }
 if s_exist('filter'+k_index,0) then hlaska('Filter zapnuty !!!  Pocet='+stri(poc,3),-1);
 
 repeat
  farba(pvzalu,fvzalu);
  view_pol(y);
  kurzorzap(false);
                                        { prvy znamena prejst vsetky kontroly na E }
  if not(prvy) then ch:=readkey;
 
  if ctrl_akt then begin
     farba(pnzalu,fnzalu);view_pol(y);
     ys:=find_p( UpCase( chr(ord(ch)+64) ) );
     if ys<>0 then y:=ys;
     ch:=#1;
    end;
 
  if not(prvy) then                     { prvy znamena prejst vsetky kontroly na E }
  if ch=#0 then begin
     ch:=readkey;
     case (ch) of
 
       #72: begin                       { sipka hore }
             farba(pnzalu,fnzalu);view_pol(y);
             hore:=true;dole:=false;
             y:=y-1;if y<1 then y:=1;
            end;
 
       #80: begin                       { sipka dole }
             farba(pnzalu,fnzalu);view_pol(y);
             y:=y+1;
             hore:=false;dole:=true;
            end;
 
       #81: if not(filter) then begin                       { PgDn }
             zap_vety(subor,veta);
             veta:=veta+1;
             cit_vety(subor,veta);
             while ( (base[find('ZMAZ')][1]='A') and (veta<poc) ) do begin
                   veta:=veta+1;
                   cit_vety(subor,veta);
                   end;
             if veta>poc then begin
                 veta:=poc;
                 hlaska('Posledna veta dalej len cez F4 !!!',20);
                end;
             farba(pnzalu,fnzalu);
             quick_view_all(c_plocha,c_pocet,true);
            end;
 
       #73: if not(filter) then begin                       { PgUp }
             zap_vety(subor,veta);
             veta:=veta-1;
             while ( (base[find('ZMAZ')][1]='A') and (veta>1) ) do begin
                   veta:=veta-1;
                   cit_vety(subor,veta);
                   end;
             if veta<1 then begin
                 veta:=1;
                 hlaska('Toto bola prv  veta !!!',20);
                end;
             cit_vety(subor,veta);
             farba(pnzalu,fnzalu);
             quick_view_all(c_plocha,c_pocet,true);
            end;
 
        #67: begin                      { F9 - zmaz daj clear vstup  }
              base[formular[y].pol]:=nothing(length(base[formular[y].pol]));
             end;
 
        #62: if not(filter) then
             if not(s_exist('filter'+k_index,0)) then begin                      { F4 - Nova veta }
              zap_vety(subor,veta);
              veta:=spoc+1;
{              poc:=poc+1;veta:=poc;}
              for i:=1 to max_viet do base[i]:=nothing(hlavy[i].size);
              s:=stri(veta,hlavy[realy_find('POR_CIS')].size);
              for i1:=1 to length(s) do base[realy_find('POR_CIS')][i1]:=s[i1];
              farba(pnzalu,fnzalu);
              quick_view_all(c_plocha,c_pocet,true);
              zap_vety(subor,veta);
              y:=1;
             end;
 
        #90: begin                              { SHIFT F7- vypni filter }
              if not(filter) then zap_vety(subor,veta);
              prikaz('del '+subor+k_index);
              opendbase(subor);
              veta:=poc;
              cit_vety(subor,veta);
              farba(pnzalu,fnzalu);
              quick_view_all(c_plocha,c_pocet,true);
              hlaska('Filter zruseny ...',-1);
              if s_exist('filter'+k_index,1) then prikaz('del filter'+k_index);
              filter:=false;
             end;
 
        #91: begin                              { SHIFT F8- vypni filter o jednu uroven }
              if not(filter) then zap_vety(subor,veta);
              if s_exist(subor+'1'+k_index,1) then begin
                                                   prikaz('copy '+subor+'1'+k_index+' '+subor+k_index+' >nul');
                                                   prikaz('del '+subor+'1'+k_index+' >nul')
                                                   end
                                              else hlaska('Nemozno vratit spat !',65);
              opendbase(subor);
              veta:=poc;
              cit_vety(subor,veta);
              farba(pnzalu,fnzalu);
              quick_view_all(c_plocha,c_pocet,true);
              hlaska('Filter vrateny spat ... Pocet='+stri(poc,3),-1)
             end;
 
        #65: begin                      { F7 filter }
              if filter then begin
                    p:=make_filter;
                    farba(pozalu,fozalu);
                    clrscr;
                    view_frm(subor);
                    opendbase(subor);
                    veta:=poc;
                    cit_vety(subor,veta);
                    farba(pnzalu,fnzalu);
                    quick_view_all(c_plocha,c_pocet,true);
                    if p=1 then hlaska('Filter zapnuty ... Pocet='+stri(poc,3),-1)
                           else hlaska('Filter nenasiel nic !!! ',-1);
                    filter:=false;
                    end
                 else begin
                    clear_pod;
                    zap_vety(subor,veta);
                    for i:=1 to max_viet do base[i]:=nothing(hlavy[i].size);
                    s:='FILTER';p:=realy_find('POR_CIS');
                    for i:=1 to length(s) do base[p][i]:=s[i];
                    farba(pnzalu,fnzalu);
                    quick_view_all(c_plocha,c_pocet,true);
                    filter:=true;
                   end;
             end
 
 
         else begin
              base[formular[y].pol]:=uprav_pol(formular[y].pol,tread2(y,base[formular[y].pol],base[formular[y].pol],#0,ch));
              if filter then begin
                 podmien[formular[y].pol]:=vyber_pod;
                 gotoxy(formular[y].x-2,formular[y].y);
                 write(podmienky[podmien[formular[y].pol]]);
                 end;
              farba(pnzalu,fnzalu);view_pol(y);vst:=true;
              end;
         end;
      ch:=#0;
     end;
 
                                                { vyplnovanie poloziek }
    if (ch in ['0'..'9','-','+','.','A'..'ý',#13,#32]) and not(prvy) then begin
       s:=strs(hlavy[formular[y].pol].nazov,true);
       vst:=true;
 
       if not (ch in [#13]) then begin
          if ch in ['0'..'9','-','+','.','A'..'z'] then        { bud edituje, alebo cisti polozku pre vyplnovanie }
             base[formular[y].pol]:=uprav_pol(formular[y].pol,tread2(y,nothing(hlavy[formular[y].pol].size),
                                              base[formular[y].pol],#13,ch))
           else
             base[formular[y].pol]:=uprav_pol(formular[y].pol,tread2(y,base[formular[y].pol],base[formular[y].pol],#13,ch));
 
          hlada:=vali(base[formular[y].pol]);
         end
        else hlada:=0;
                                                { prechod do ciselnikov }
       if (s='STVRT') then begin
          base[formular[y].pol]:=stri(dmiesto('miesto',base[find('SSTVRT')],base[find('SMESTO')],true,hlada),
                                 hlavy[formular[y].pol].size);
          base[find('SSTVRT')]:=copy(base[find('SSTVRT')],1,hlavy[find('SSTVRT')].size);
          base[find('SMESTO')]:=copy(base[find('SMESTO')],1,hlavy[find('SMESTO')].size);
          y:=y+1;
         end;
 
       if (s='DEALER') then begin
          base[formular[y].pol]:=stri(ddealer('Dealeri   ',s,s1,s2,false,hlada,vali(base[formular[y].pol])),
                                               hlavy[formular[y].pol].size);
          base[find('M'+s)]:=copy(s2,1,hlavy[find('M'+s)].size);
          prepocet:=true;
         end;
 
       if (s='MERAC') then begin
          base[formular[y].pol]:=stri(ddealer('Meraci    ',s,s1,s2,false,hlada,vali(base[formular[y].pol])),
                                               hlavy[formular[y].pol].size);
          base[find('M'+s)]:=copy(s2,1,hlavy[find('M'+s)].size);
          prepocet:=true;
         end;
 
       if (s='M1') or (s='M2') or (s='M3') then begin
          base[formular[y].pol]:=stri(ddealer('Mont §nici','montaz',s1,s2,false,hlada,vali(base[formular[y].pol])),
                                               hlavy[formular[y].pol].size);
          base[find('M'+s)]:=copy(s2,1,hlavy[find('M'+s)].size);
          prepocet:=true;
         end;
 
       if (s='M1') or (s='M2') or (s='M3') or (s='DEALER') or
          (s='MERAC') or (s='STVRT') then begin
          farba(pozalu,fozalu);
          okno(1,1,80,24,' Zak zka zad vanie ',d_text,pozalu);
          i:=view_frm(subor);
          farba(pnzalu,fnzalu);
          quick_view_all(c_plocha,c_pocet,true);
         end;
 
       if filter then begin
          podmien[formular[y].pol]:=vyber_pod;
          gotoxy(formular[y].x-2,formular[y].y);
          write(podmienky[podmien[formular[y].pol]]);
          end;
      end;
 
    if vst and not(filter) then begin           { iba ak prebehol vstup a nie je filter }
     s:=strs(hlavy[formular[y].pol].nazov,true);
     if (s = 'ZALOHA') then                     { vypocita DOPLATKY = CENA - ZALOHA }
          base[find('DOPLATKY')]:=strr(valr(base[find('CENA')])-valr(base[formular[y].pol]),hlavy[formular[y].pol].size);
 
     if (s = 'DOPLATKY') then                   { vypocita CENA = ZALOHA - DOPLATKY }
          base[find('CENA')]:=strr(valr(base[find('ZALOHA')])+valr(base[formular[y].pol]),hlavy[formular[y].pol].size);
 
     if (s = 'CENA') then                       { vypocita DOPLATKY = CENA - ZALOHA }
          base[find('DOPLATKY')]:=strr(valr(base[formular[y].pol])-valr(base[find('ZALOHA')]),hlavy[formular[y].pol].size);
 
     if (copy(s,1,5)='NAKUP') then             { Prepocita datum LEHOTA podla NAKUPU }
          base[find('LEHOTA')]:=get_date(poc_dni(base[formular[y].pol])+doba_dod);
 
     farba(pnzalu,fnzalu);
     quick_view_all(c_plocha,c_pocet,true);
     y:=y+1;
    end;
 
    if not(filter) then                 { Ak je filter mozny vstup pre podmienku  }
    repeat                              { Nasledovne polozky preskakuj podla }
     ys:=y;                             { toho aky bol predosli pohyb ci dole}
                                        { ci hore }
 
     farba(pnzalu,fnzalu);              { predtym zrusi farebne oznacenie }
     view_pol(y);
 
     s:=strs(hlavy[formular[y].pol].nazov,true);
     if (s='POR_CIS') or (s='LEHOTA') or (s='FAX') or (s='DOPLATKY') or
        (s='NAKLADY') or (s='SSTVRT') or (s='MESTO') or (s='SMESTO') or
        (s='ZMAZ') or (s='MDEALER') or (s='MMERAC') or
        (copy(s,1,2)='MM') or (copy(s,1,4)='NAKL') then begin
        if dole then y:=y+1
                else y:=y-1;
        if y<1 then begin
           y:=1;dole:=true;prvy:=true;
           end;
        end
        else prvy:=false;
    until (ys=y);
                                         { ak uz formular konci prejdi na zaluzie }
    if ((ch=#9) or (formular[y+1].pol=0)) and not(ch=#27) and not(filter) then begin
       farba(pnzalu,fnzalu);
       while ((formular[y].pol = 0) and (y>1)) do y:=y-1;
       view_pol(y);
 
       p:=realy_find('ZALUZIA');
       base[p]:=stri(proc_zaluz(base[p],false,c_plocha,c_pocet),hlavy[p].size);
       prepocet:=true;
 
       farba(pvzalu,fvzalu);
       if y<1 then y:=1;
       view_pol(y);
       prvy:=true;dole:=false;ch:=#10;
       prepocet:=true;
       end;
 
   if prepocet then begin
       farba(pnzalu,fnzalu);
       if valr(base[find('DEALER')])<>0 then                                                { Dealer 25 / hod}
           base[find('NAKL_D')] :=strr(cen_dea,hlavy[find('NAKL_D')].size)
           else
           base[find('NAKL_D')] :=strr(0,hlavy[find('NAKL_D')].size);
 
       if valr(base[find('MERAC')])<>0 then                                       { iba ak je nevyplneny =Merac 10* m2 }
          base[find('NAKL_M')] :=strr(cen_mer*c_plocha/10000,hlavy[find('NAKL_M')].size)
          else
          base[find('NAKL_M')] :=strr(0,hlavy[find('NAKL_M')].size);
 
       base[find('NAKL_M1')]:=strr(0,hlavy[find('NAKL_M1')].size);
       base[find('NAKL_M2')]:=strr(0,hlavy[find('NAKL_M2')].size);
       base[find('NAKL_M3')]:=strr(0,hlavy[find('NAKL_M3')].size);
 
       if valr(base[find('M1')])<>0 then
       if valr(base[find('M2')])<>0 then begin
          if valr(base[find('M3')])<>0 then begin
                  base[find('NAKL_M1')]:=strr(cen_mon*c_pocet/3,hlavy[find('NAKL_M1')].size);
                  base[find('NAKL_M2')]:=strr(cen_mon*c_pocet/3,hlavy[find('NAKL_M2')].size);
                  base[find('NAKL_M3')]:=strr(cen_mon*c_pocet/3,hlavy[find('NAKL_M3')].size);
                  end
             else begin
                  base[find('NAKL_M1')]:=strr(cen_mon*c_pocet/2,hlavy[find('NAKL_M1')].size);
                  base[find('NAKL_M2')]:=strr(cen_mon*c_pocet/2,hlavy[find('NAKL_M2')].size);
                  end;
          end
          else base[find('NAKL_M1')]:=strr(cen_mon*c_pocet,hlavy[find('NAKL_M1')].size);
 
       { Scitaj pre vsetkych }
       base[find('NAKLADY')]:=strr(valr(base[find('NAKL_D')])+valr(base[find('NAKL_M')])+
                  valr(base[find('NAKL_M1')])+valr(base[find('NAKL_M2')])+valr(base[find('NAKL_M3')])
                  ,hlavy[find('NAKLADY')].size);
       quick_view_all(c_plocha,c_pocet,true);
       prepocet:=false;
      end;
 
   vst:=false;
   clear_keyb;
 until (ch=#27);                        { Koniec na ESC=#27     }
 if not(filter) then
    zap_vety(subor,veta);               { zapis poslednu editovanu vetu do DBF suboru }
end;