Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
{ 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;