Delphi & Pascal (česká wiki)
{ MZDY.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Rutiny pre vypocet miezd jednotlivych montaznikov/meracov. } { } { Datum:19.06.1995 http://www.trsek.com } procedure mzdy(meno_s:string;viac:byte); var mm:file of temp_deal; td:temp_deal; polo:tdealer; t_polo:temp_deal; i,err:integer; cis,strana,poc_y,cpoc:integer; pmzdy:string; f:text; celkom:real; nenul:boolean; aky_text:string; begin for i:=1 to length(meno_s) do meno_s[i]:=UpCase(meno_s[i]); nenul:=true; pmzdy:='mzdy\m'+get_realy_date(2)+'.txt'; if viac=2 then pmzdy:='mzdy.$$$'; if viac<>1 then begin hlaska(meno_s+' len těch >o nie>o majŁ, alebo vçetkěch. Vçetkěch [A/..]',-1); if not(readkey in ['a','A']) then nenul:=false; hlaska('',-2); end; if meno_s='DEALER' then aky_text:='Dealersk, mzdy KOMA '; if meno_s='MERAC' then aky_text:='Mera>sk, mzdy KOMA '; if meno_s='MONTAZ' then aky_text:='Mont §nick, mzdy KOMA '; assign(mm,meno_s+'.$$$'); rewrite(mm); assign(fde,meno_s); {$I-} reset(fde); {$I+} if IoResult<>0 then begin hlaska('SŁbor '+meno_s+' pravdepodobne nejestvuje.',-1); exit; end; t_polo.cis_deal:=0;t_polo.mzda:=0;t_polo.priezv:='';t_polo.poc:=0; if viac<>1 then begin hlaska('ZotrieÔujem '+meno_s+'.',-1); for i:=1 to FileSize(fde) do begin seek(fde,i-1);read(fde,polo); t_polo.cis_deal:=polo.cis_deal; t_polo.priezv:=polo.priezv; seek(mm,i);write(mm,t_polo); end; close(fde); end else begin for i:=1 to FileSize(fde) do begin seek(mm,i);write(mm,t_polo); end; close(fde); i:=round(ddealer('Dealeri ',meno_s,men,pre,false,0,0)); textcolor(YELLOW); t_polo.cis_deal:=i;t_polo.priezv:=pre; seek(mm,i);write(mm,t_polo); end; close(mm); reset(mm); hlaska('',-2); hlaska('Prepo>Ątav m mzdy ...',-1); z_sound:=false; opendbase(subor); for i:=1 to poc do begin cit_vety(subor,i); hlaska('Prepo>Ątav m mzdy pre >:'+stri(i,3)+' z celkov,ho po>tu:'+stri(poc,3)+ '. Percentu lne:'+stri(round(100*(i/poc)),3)+'%',-1); if meno_s='DEALER' then begin cis:=vali(base[realy_find('DEALER')]); if cis>0 then begin seek(mm,cis);read(mm,t_polo); t_polo.mzda:=t_polo.mzda+valr(base[realy_find('NAKL_D')]); inc(t_polo.poc); seek(mm,cis);write(mm,t_polo); end; end; if meno_s='MERAC' then begin cis:=vali(base[realy_find('MERAC')]); if cis>0 then begin seek(mm,cis);read(mm,t_polo); t_polo.mzda:=t_polo.mzda+valr(base[realy_find('NAKL_M')]); inc(t_polo.poc); seek(mm,cis);write(mm,t_polo); end; end; if meno_s='MONTAZ' then begin cis:=vali(base[realy_find('M1')]); if cis>0 then begin seek(mm,cis);read(mm,t_polo); t_polo.mzda:=t_polo.mzda+valr(base[realy_find('NAKL_M1')]); inc(t_polo.poc); seek(mm,cis);write(mm,t_polo); end; cis:=vali(base[realy_find('M2')]); if cis>0 then begin seek(mm,cis);read(mm,t_polo); t_polo.mzda:=t_polo.mzda+valr(base[realy_find('NAKL_M2')]); inc(t_polo.poc); seek(mm,cis);write(mm,t_polo); end; cis:=vali(base[realy_find('M3')]); if cis>0 then begin seek(mm,cis);read(mm,t_polo); t_polo.mzda:=t_polo.mzda+valr(base[realy_find('NAKL_M3')]); inc(t_polo.poc); seek(mm,cis);write(mm,t_polo); end; end; if keypressed then if readkey=#27 then begin hlaska('',-2); hlaska('Preruçen, u§Ąvate-om !!!',-1); i:=poc; end; end; { end od main cyklu } close(mm); reset(mm); assign(f,pmzdy); { Otvori textovy subor pre zostavu } rewrite(f); close(f); strana:=0;poc_y:=0;celkom:=0;cpoc:=0; z_hlava(strana,poc_y,f,aky_text); for i:=1 to FileSize(mm)-1 do begin seek(mm,i); read(mm,t_polo); if t_polo.cis_deal>0 then begin if not( (t_polo.mzda=0) and not(nenul)) then writeln(f,' '+t_polo.priezv+nothing(SizeOf(t_polo.priezv)-length(t_polo.priezv))+' '+strr(t_polo.mzda,11)+ ' '+strr(t_polo.poc,6)+' objedn vok'); celkom:=celkom+t_polo.mzda; cpoc:=cpoc+t_polo.poc; end; if poc_y>dlzpap then z_hlava(strana,poc_y,f,aky_text); end; if viac<>1 then begin writeln(f,'--------------------------------------------------------------------'); writeln(f,' Celkom '+nothing(SizeOf(t_polo.priezv)-6)+strr(celkom,11)+ ' '+strr(cpoc,6)+' objedn vok'); end; close(mm); prikaz('del '+meno_s+'.$$$'); writeln(f,chr(12));close(f); if viac<>2 then view_text(pmzdy,lav_kraj,ftlac,ptlac,prin); hlaska('',-2); end;