Delphi & Pascal (česká wiki)
{ 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;