Program je určený na evidenciu áut vo firme

Program: Auto.pas
Súbor exe: Auto.exe
Potrebné: Cisel.pas, Auta.dat, Spz.cis
Program je určený na evidenciu áut vo firme. Eviduje ŠPZ auta, spotrebu, počet najazdených kilometrov, dátum generálnej opravy. Program dokáže generovať grafy. Pre ukladanie dát používa štruktúru 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;
Program je určený na evidenciu áut vo firme

Navigační menu

Osobní nástroje

Hledat

Pascal programy

Pascal Wiki

Bonus

Kontakty

V iných jazykoch
