Program je uren na evidenciu ut vo firme

Delphi & Pascal (esk wiki)
Pejt na: navigace, hledn
Kategorija: Programy zos Pascalu
auto.pngProgram: Auto.pas
Subor exe: Auto.exe
Mui mac: Cisel.pasAuta.datSpz.cis

Program je uren na evidenciu ut vo firme. Eviduje PZ auta, spotrebu, poet najazdench kilometrov, dtum generlnej opravy. Program doke generova grafy. Pre ukladanie dt pouva truktru vytvoren cez type.
{ CISEL.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Obsahuje funkcie a procedury pre program AUTO.PAS.                }
{ Blizsie informacie v AUTO.PAS.                                    }
{                                                                   }
{ Datum:18.03.1998                             http://www.trsek.com }
 
function ciselnik(vyber:boolean):integer;
var cislo,poc,i,i2,ir:integer;
      ch:char;
      uz:boolean;
begin
 textbackground(DARKGRAY);
 textcolor(YELLOW);
 okno(10,5,48,21,' Ciselnik SPZ ',' olvadanie:Enter,sipky, ESC-koniec ',GREEN);
 textbackground(DARKGRAY);
 assign(fc1,'spz.cis');
 {$I-}
 reset(fc1);
 {$I+}
 if (Ioresult<>0) then begin
     rewrite(fc1);
     end;
 poc:=1;
 while ( (poc<FileSize(fc1)) or not(Eof(fc1)) ) do begin
  seek(fc1,poc);
  read(fc1,cisel);
  if (poc<15) then begin
     gotoxy(2,poc);write(cisel.typ:3,' - ',cisel.popis);
     end;
  poc:=poc+1;
  end;
 
 i:=1;ir:=0;
 if (i=poc) then begin
     cisel.typ:=tival(copy('                              ',1,3));
     cisel.popis:=copy('                              ',1,SizeOf(cisel.popis));
     cisel.del:=false;
     end
    else begin
     seek(fc1,i+ir);read(fc1,cisel);
     end;
 textbackground(BLUE);
 textcolor(YELLOW);
 gotoxy(2,i);write(cisel.typ:3,' - ',cisel.popis);
 
 repeat
  ch:=readkey;
  if ((ch=#13) or (ch in ['0'..'9'])) then begin
    if vyber then cislo:=cisel.typ
    else begin
    repeat
     if(ch=#13) then cisel.typ:=tival(tread(2,i,3,tistr(cisel.typ),#0,#0))
                else cisel.typ:=tival(tread(2,i,3,'',ch,ch));
     textcolor(YELLOW);
     if (cisel.typ=0) then hlaska(12,21,' Nulove cislo neberiem. ');
     uz:=false;
     for i2:=1 to poc-1 do begin
         seek(fc1,i2);read(fc1,pcisel);
         if ((pcisel.typ=cisel.typ) and (i<>i2)) then uz:=true;
         end;
     if uz then hlaska(12,21,' Uz take cislo mas !!! ');
     textcolor(WHITE);
     gotoxy(2,i);
     window(11,6,69,20);
    until ( not(uz) and (cisel.typ<>0));
     cisel.popis:=tread(8,i,SizeOf(cisel.popis)-2,cisel.popis,#0,#0);
     seek(fc1,i+ir);write(fc1,cisel);
   ch:=' ';
   end;
  end;
 
  if (ch=#0) then begin
     ch:=readkey;
     textbackground(DARKGRAY);
     textcolor(YELLOW);
     gotoxy(2,i);write(cisel.typ:3,' - ',cisel.popis);
     case (ch) of
      #83:begin
           cisel.del:=true;
           if( cisel.typ > 0) then
               cisel.typ:=(-1)*cisel.typ;
           hlaska(11,21,' Polozka je oznacena ako zrusena.  ');
           window(11,6,69,20);
           seek(fc1,i+ir);write(fc1,cisel);
          end;
      #72:begin
           i:=i-1;
           if (i<1) then begin
              i:=1;ir:=ir-1;
              if (ir<0) then ir:=0
                        else begin gotoxy(1,1);insline;
                                   gotoxy(1,15);delline;end;
              end;
          end;
      #80:begin
           i:=i+1;
           if ((i+ir)>FileSize(fc1)) then i:=i-1;
           if vyber and ((i+ir)>=FileSize(fc1)) then i:=i-1;
           if (i>14) then begin
              i:=14;ir:=ir+1;
              if ((ir+i)>FileSize(fc1)+1) then ir:=FileSize(fc1)-i+1
                                     else begin gotoxy(1,1);delline;end;
              end;
          end;
      end;
     end;
 
   if (ir+i<FileSize(fc1)) then begin
        seek(fc1,ir+i);
        read(fc1,cisel);
        end
       else
        if not(vyber) then
        begin
        cisel.typ:=tival(copy('                              ',1,3));
        cisel.popis:=copy('                              ',1,SizeOf(cisel.popis)-2);
        cisel.del:=false;
        end;
 
     textbackground(BLUE);
     textcolor(YELLOW);
     gotoxy(2,i);write(cisel.typ:3,' - ',cisel.popis);
 until (ch in [#27,#13]);
 close(fc1);
 ciselnik:=cislo;
end;
 
procedure edit_aut(podmienka:boolean);
var poc,i,i2,ic,ir:integer;
      ch:char;
   kolko:byte;
      uz:boolean;
   v_sub:array[1..1000] of word;
cis_okna:integer;
begin
 textbackground(DARKGRAY);
 textcolor(YELLOW);
 if podmienka then
     okno(8,5,72,21,' SPZ        Typ      Spotreba odjazdne od GO ostava do GO ',' Auta majuce do GO '+trstr(do_go)+' km ',
     GREEN)
    else
    okno(8,5,72,21,' SPZ        Typ      Spotreba odjazdne od GO ostava do GO ',' ENTER-Zmen  DEL-Zrus ',GREEN);
 textbackground(DARKGRAY);
 assign(fa1,'auta.dat');
 {$I-}
 reset(fa1);
 {$I+}
 if (Ioresult<>0) then begin
     rewrite(fa1);
     end;
 for i:=1 to 1000 do v_sub[i]:=0;
 poc:=0;i:=1;
 while (not(Eof(fa1))) do begin
  poc:=poc+1;
  seek(fa1,poc-1);
  read(fa1,auto);
  if (not(podmienka) or (auto.do_go<=do_go)) and (i<15) then begin
      v_sub[i]:=poc;
      gotoxy(2,i);write(auto.SPZ,'  ',auto.typ:3,'  ',auto.p_spot:12:2,'  ',auto.od_go:12:2,'  ',auto.do_go:12:2);
      i:=i+1;
      end;
  end;
 poc:=filesize(fa1);
 
 if podmienka and (v_sub[1]=0) then begin
    hlaska(20,14,'Neda sa vybrat ziadne auto !!!');
    close(fa1);
    exit;
    end;
 ir:=0;y:=1;ic:=1;
 if (i=1) then begin
     auto.SPZ:='         ';
     auto.typ:=0;auto.p_spot:=0;auto.od_go:=0;auto.do_go:=0;
     auto.del:=false;
     end
    else begin
     i:=1;
     seek(fa1,v_sub[i+ir]-1);read(fa1,auto);
     end;
 
 textbackground(BLUE);
 textcolor(YELLOW);
 gotoxy( 2,i);write(auto.SPZ);
 
 repeat
  ch:=readkey;
  if ((ch=#13) or (ch in ['0'..'9','A'..'z'])) then
     if not(podmienka) then
     begin
     case (y) of
      1: auto.SPZ   :=tread(2,i,SizeOf(auto.SPZ)-1,auto.SPZ,ch,ch);
      2: begin
          window(1,1,80,24);
          cis_okna := get_window(10,5,70,21);
          auto.typ:=ciselnik(true);
          window(1,1,80,24);
          put_window(cis_okna,10,5,70,21);
          window(9,6,71,20);
          gotoxy(14,i);write(auto.typ:3);
         end;
      3: auto.p_spot:=trval(tread(20,i,12,'',ch,ch));
      4: auto.od_go :=trval(tread(35,i,12,'',ch,ch));
      5: auto.do_go :=trval(tread(50,i,12,'',ch,ch));
      end;
     y:=y+1;  if(y>5) then y:=1;
 
     if not(nemoze(auto)) then begin
        if (v_sub[i+ir]=0) then begin
           poc:=poc+1;
           v_sub[i+ir]:=poc;
           end;
        ic:=filesize(fa1);
        seek(fa1,v_sub[ir+i]-1);
        write(fa1,auto);
        close(fa1);reset(fa1);
        ic:=filesize(fa1);
        end;
     end;
 
 
  if (ch=#0) then begin
     ch:=readkey;
     textbackground(DARKGRAY);
     textcolor(YELLOW);
     gotoxy(2,i);write(auto.SPZ,'  ',auto.typ:3,'  ',auto.p_spot:12:2,'  ',auto.od_go:12:2,'  ',auto.do_go:12:2);
     case (y) of
        1: begin gotoxy( 2,i);write(auto.SPZ);end;
        2: begin gotoxy(14,i);write(auto.typ:3);end;
        3: begin gotoxy(20,i);write(auto.p_spot:12:2);end;
        4: begin gotoxy(35,i);write(auto.od_go:12:2);end;
        5: begin gotoxy(50,i);write(auto.do_go:12:2);end;
        end;
     case (ch) of
      #83:begin
           if not(auto.del) then begin
              auto.del:=true;
              auto.SPZ:=''+copy(auto.SPZ,2,length(auto.SPZ)-1);
              hlaska(12,21,' Polozka je oznacena ako zrusena. ');
              seek(fa1,v_sub[i+ir]-1);write(fa1,auto);
              window(9,6,71,20);
             end;
          end;
      #75:begin
           y:=y-1;if (y<1) then y:=1;
          end;
      #77:begin
           y:=y+1;if (y>5) then y:=5;
          end;
      #72:begin
           i:=i-1;
           if (i<1) then begin
              i:=1;ir:=ir-1;
              if (ir<0) then ir:=0
                        else begin gotoxy(1,1);insline;
                                   gotoxy(1,15);delline;end;
              end;
          end;
      #80:begin
           i:=i+1;
           if ((i+ir)>poc) then if nemoze(auto) then i:=i-1;
           if podmienka and (v_sub[i+ir]=0) then i:=i-1;
           if (i>14) then begin
              i:=14;ir:=ir+1;
              if ((ir+i)>FileSize(fa1)+1) then ir:=FileSize(fa1)-i+1
                                     else begin gotoxy(1,1);delline;end;
              end;
           if ((i+ir)<>ic) then begin
              auto.SPZ:='         ';
              auto.typ:=0;auto.p_spot:=0;auto.do_go:=0;auto.od_go:=0;
              auto.del:=false;
             end;
          end;
      end;
     end;
 
   if (v_sub[ir+i]>0) then begin
        seek(fa1,v_sub[ir+i]-1);
        read(fa1,auto);
        end;
 
     ic:=i+ir;
     textbackground(DARKGRAY);
     textcolor(YELLOW);
     gotoxy(2,i);write(auto.SPZ,'  ',auto.typ:3,'  ',auto.p_spot:12:2,'  ',auto.od_go:12:2,'  ',auto.do_go:12:2);
     textbackground(BLUE);
     case (y) of
        1: begin gotoxy( 2,i);write(auto.SPZ);end;
        2: begin gotoxy(14,i);write(auto.typ:3);end;
        3: begin gotoxy(20,i);write(auto.p_spot:12:2);end;
        4: begin gotoxy(35,i);write(auto.od_go:12:2);end;
        5: begin gotoxy(50,i);write(auto.do_go:12:2);end;
        end;
 
     ic:=i+ir;
     if not(nemoze(auto)) then begin
        seek(fa1,v_sub[ir+i]-1);
        write(fa1,auto);
     end;
 until (ch in [#27]);
 close(fa1);
 filtruj_auta;
 
 { Chce to mat aj v textovom subore }
 if( podmienka ) then begin
  okno(5,10,75,15,' Zapis aut do TXT suboru ??? ','',BLUE);
  gotoxy(6,2);write('Zapisat vybrane auta do TXT suboru (A/..) :');
  meno_s:=tread(49,2,1,'A',#0,#0);
  if UpCase(meno_s[1])='A' then begin
     textbackground(BLUE);
     gotoxy(2,2);write('         Zadaj meno TXT suboru:                 ');
     meno_s:=tread(33,2,12,'noname00.txt',#0,#0);
     assign(fa1,'auta.dat');
     reset(fa1);
     assign(ftext,meno_s);
     rewrite(ftext);
     writeln(ftext,'͸');
     writeln(ftext,' SPZ        Typ      Spotreba odjazdne od GO ostava do GO   ');
     writeln(ftext,'͵');
     i:=1;
     while (v_sub[i]<>0) do begin
        seek(fa1,v_sub[i]-1);read(fa1,auto);i:=i+1;
     writeln(ftext,' ',auto.SPZ,'  ',auto.typ:3,'  ',auto.p_spot:12:2,'  ',auto.od_go:12:2,'  ',auto.do_go:12:2,'   ');
        end;
     writeln(ftext,';');
     close(fa1);
     close(ftext);
     end;
  end;
end;