Program je určen pro evidenci aut ve firmě

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie: Programy v Pascalu
auto.pngProgram: Auto.pas
Soubor exe: Auto.exe
Potřebné: Cisel.pasAuta.datSpz.cis

Program je určen pro evidenci aut ve firmě. Eviduje ŠPZ auta, spotrěbu, počet naježdených kilometrů, datum generální opravy. Program dokáže generovat grafy. Pro ukládaní dát používa štrukturu vytvorěnou za pomoci type.
{ AUTO.PAS                  Copyright (c) TrSek alias Zdeno Sekerak }
{ Program robi jednoduchu evidenciu najazdenych kilometrov.         }
{ Pre kompilaciu potrebuje subor CISEL.PAS.                         }
{                                                                   }
{ Datum:18.03.1998                             http://www.trsek.com }
 
program Evidencia_Aut;
uses crt,dos,graph,trsek;
 
type auto_t = record            { Definicia typu auta }
     SPZ:string[9];
     typ:integer;
  p_spot:real;
   od_go:real;
   do_go:real;
     del:boolean;
         end;
 
type cis_typ = record           { Ciselnik typov aut }
       typ:integer;
     popis:string[30];
       del:boolean;
           end;
 
var   fa1,fa2:file of auto_t;
          fc1:file of cis_typ;
        ftext:text;
       meno_s:string;
   pauto,auto:auto_t;
 pcisel,cisel:cis_typ;
        x,y,i:integer;
        do_go:real;
           ch:char;
 
procedure okno(x1, y1, x2, y2:integer; text,podpis:string; bar:integer);
var x,y:integer;
begin
 window(x1+1,y1+1,x2-1,y2-1);
 clrscr;
 window(1,1,80,25);
 
 for x:=x1+1 to x2-1 do begin
     gotoxy(x,y1);write('Í');
     gotoxy(x,y2);write('Í');
     end;
 
 for y:=y1+1 to y2-1 do begin
     gotoxy(x1,y);write('ş');
     gotoxy(x2,y);write('ş');
     end;
 
 gotoxy(x1,y1);write('É');
 gotoxy(x2,y1);write('ť');
 gotoxy(x1,y2);write('Č');
 gotoxy(x2,y2);write('ź');
 textbackground(bar);
 gotoxy(x1+round((x2-x1-length(text))/2),y1);write(text);
 gotoxy(x2-length(podpis)-2,y2);write(podpis);
 window(x1+1,y1+1,x2-1,y2-1);
end;
 
procedure vypln;
begin
 window(5,4,75,22);
 textbackground(BLUE);textcolor(BROWN);
 gotoxy(1,1);
 for i:=1 to 89 do write(' Evidencia aut ');
 write(' Evidencia au');
 textcolor(YELLOW);
end;
 
procedure hlaska(x,y:integer;s:string);
var i:integer;
begin
 window(1,1,80,25);
 textbackground(DARKGRAY);
 gotoxy(x,y);
 write(s);
 sound(500);delay(3);nosound;
 repeat until keypressed;
 for i:=x to length(s)+x do begin gotoxy(i,y); write('Í');end;
end;
 
function tival(s:string):integer;
var v,err:integer;
begin
 while ( (Pos(' ',s)>0) and (s<>'')) do delete(s,Pos(' ',s),1);
 val(s,v,err);
 while ( (err<>0) and (s<>'')) do delete(s,err,1);
 tival:=v;
end;
 
function tistr(i:integer):string;
var s:string;
begin
 str(i,s);
 while ((pos(' ',s)>0) and (length(s)>0)) do delete(s,pos(' ',s),1);
 tistr:=s;
end;
 
function trval(s:string):real;
var err:integer;
    v:real;
begin
 while ( (Pos(' ',s)>0) and (s<>'')) do delete(s,Pos(' ',s),1);
 val(s,v,err);
 while ( (err<>0) and (s<>'')) do begin
    delete(s,err,1);
    val(s,v,err);
    end;
 trval:=v;
end;
 
function trstr(i:real):string;
var s:string;
begin
 str(i:12:2,s);
 while ((pos(' ',s)>0) and (length(s)>0)) do delete(s,pos(' ',s),1);
 trstr:=s;
end;
 
procedure help;
begin
end;
 
function nemoze(auto:auto_t):boolean;
var nemoz:boolean;
begin
 nemoz:=false;
 if auto.SPZ='         ' then nemoz:=true;
 if auto.typ=0 then nemoz:=true;
 if auto.p_spot=0 then nemoz:=true;
 if auto.od_go=0 then nemoz:=true;
 if auto.do_go=0 then nemoz:=true;
{ if nemoz then begin
    hlaska(12,21,' Nemas vyplnene vsetky polozky. ');
    window(9,6,71,20);
    end;}
 nemoze:=nemoz;
end;
 
procedure filtruj_auta;
begin
 assign(fa1,'auta.dat');
 assign(fa2,'auta.bak');
 reset(fa1);
 rewrite(fa2);
 while (not(eof(fa1))) do begin
   read(fa1,auto);
   if not(auto.del) then write(fa2,auto);
   end;
 erase(fa1);
 close(fa1);
 close(fa2);
 
 { Naspat prekopiruje lebo mi nefunguje rename(fa2) }
 assign(fa1,'auta.bak');
 assign(fa2,'auta.dat');
 reset(fa1);
 rewrite(fa2);
 while (not(eof(fa1))) do begin
   read(fa1,auto);
   write(fa2,auto);
   end;
 erase(fa1);
 close(fa1);
 close(fa2);
end;
 
{$I cisel.pas}
procedure graf_g(typg,per:char);
var gd,gm:integer;
    x,y:integer;
    krokx,kroky:integer;
    stred,lavo,pravo,hore:integer;
    poc:integer;
    max:real;
    jazda:array[1..255,1..2] of real;
    popis:array[1..255] of string[10];
    cis_okna:integer;
begin
 window(1,1,80,25);
 cis_okna := get_window(1,1,80,24);
 gd := Detect;
 InitGraph(gd,gm,'');
 cleardevice;
 setcolor(YELLOW);
 SetBkColor(BLUE);
 line(20,50,20,400);line(10,390,630,390);
 line(17,53,20,41);line(20,41,23,53);
 line(627,387,639,390);line(639,390,627,393);
 
 for x:=1 to 255 do begin jazda[x,1]:=0;jazda[x,2]:=0; end;
 assign(fa1,'auta.dat');
 reset(fa1);
 x:=0;
 while not(eof(fa1)) do begin
   seek(fa1,x);
   read(fa1,auto);
   jazda[auto.typ,1]:=jazda[auto.typ,1]+auto.od_go;
   jazda[auto.typ,2]:=jazda[auto.typ,2]+auto.do_go;
   x:=x+1;
  end;
 close(fa1);
 
 assign(fc1,'SPZ.cis');
 reset(fc1);
 x:=0;
 while not(eof(fc1)) do begin
   x:=x+1;
   seek(fc1,x);
   read(fc1,cisel);
   if(cisel.typ > 0) then
      popis[cisel.typ]:=copy(cisel.popis,1,10);
  end;
 close(fc1);
 
 poc:=0;max:=1;
 for x:=1 to 255 do begin
  if (jazda[x,1]+jazda[x,2])>max then max:=jazda[x,1]+jazda[x,2];
  if (jazda[x,1]=0) and (jazda[x,2]=0) then begin
     y:=x;
     while ((jazda[y,1]=0) and (jazda[y,2]=0) and (y<255)) do y:=y+1;
     if (jazda[y,1]<>0) or (jazda[y,2]<>0) then begin
        jazda[x,1]:=jazda[y,1];jazda[x,2]:=jazda[y,2];
        popis[x]:=popis[y];
        jazda[y,1]:=0;jazda[y,2]:=0;
        poc:=poc+1;
        end;
     end
    else poc:=poc+1;
  end;
 
 krokx:=round(600/poc);
 if krokx<20 then krokx:=20;
 for x:=1 to round(600/krokx) do line(round(x*krokx)+20,385,round(x*krokx)+20,395);
 kroky:=round(330/10);
 for y:=0 to round(330/kroky) do line(15,round(y*kroky)+60,25,round(y*kroky)+60);
 
 settextstyle(2,1,5);
 if (per='p') then outtextxy(3,50,'0%                 50%                100%');
 if (per='a') then begin
    outtextxy(3,40,trstr(max)+' [km]');
    outtextxy(3,200,trstr(max/2));
    outtextxy(3,378,'0');
    end;
 settextstyle(2,0,7);
 if (per='p') then outtextxy(40,10,'Percentualny graf ojazdenosti aut.')
              else outtextxy(40,10,'Graf ojazdenosti aut v kilometroch.');
 
 settextstyle(2,0,5);
 if (typg='s') then outtextxy(60,38,'Spodny stvorcek je pocet najezdenych km. Horny kolko este km do GO.')
               else outtextxy(60,38,'Spodna ciara je pocet najezdenych km. Horna kolko este km do GO.');
 
 settextstyle(2,3,5);
 for x:=1 to round(600/krokx) do begin
   lavo:=round((x-1)*krokx)+26;
   pravo:=round(x*krokx)+14;
 
   if (typg='s') then begin
     if (per='p') then begin
        stred:=390-round(330*(jazda[x,1]/(jazda[x,1]+jazda[x,2])));
        hore:=60;
        end
       else begin
        stred:=390-round(330*(jazda[x,1])/max);
        hore:=390-round(330*(jazda[x,1]+jazda[x,2])/max);
        end;
      outtextxy(round((x-0.5)*krokx-textheight('Z')/2)+20,390,popis[x]);
      bar3d(lavo-1,hore-1,pravo+1,390,0,TopOn);
      setfillstyle(4,x-13*round(x/13)+2);
      bar(lavo,stred,pravo,389);
      setfillstyle(5,x-13*round(x/13)+2);
      bar(lavo,hore,pravo,stred);
      line(lavo,stred,pravo,stred);
     end
    else begin
     if (per='p') then begin
       if (x>1) then line(lavo,390-round(330*(jazda[x-1,1]/(jazda[x-1,1]+jazda[x-1,2]))),lavo+krokx,
                               390-round(330*(jazda[x,1]/(jazda[x,1]+jazda[x,2]))));
       end
      else begin
       if (x>1) then line(lavo,390-round(330*(jazda[x-1,1]/max)),lavo+krokx,
                               390-round(330*(jazda[x,1]/max)) );
       if (x>1) then line(lavo,390-round(330*(jazda[x-1,1]+jazda[x-1,2])/max),lavo+krokx,
                               390-round(330*(jazda[x,1]+jazda[x,2])/max));
       end;
     outtextxy(x*krokx-round(textheight('Z')/2)+20,390,popis[x]);
     end;
   end;
 repeat until keypressed;
 closegraph;
 put_window(cis_okna,1,1,80,24);
end;
 
procedure graf;
var typg:string;
     per:string;
     max:real;
     poc:integer;
begin
 okno(5,10,75,15,' Graf aut iducich na GO ','',BLUE);
 repeat
  textbackground(BLUE);
  gotoxy(6,2);write('Graf ma byt stlpcovy, alebo ciarovy (s/c) :');
  typg:=tread(50,2,1,'s',#0,#0);
 until (typg[1] in ['s','c','S','C']);
 
 repeat
  textbackground(BLUE);
  gotoxy(6,2);write('Percentualne, absolutne vyjadrenie  (p/a) :');
  per:=tread(50,2,1,'p',#0,#0);
 until (per[1] in ['p','a','P','A']);
 per:=per;
 textbackground(BLUE);
 gotoxy(6,2);write('            Vykreslit graf (a/..) :           ');
 if (tread(42,2,1,'a',#0,#0)='a') then begin
    assign(fa1,'auta.dat');
    {$I-}
    reset(fa1);
    {$I+}
    if ioresult<>0 then begin
       gotoxy(7,2);write('     Nie su ziadne auta v databanke !  Stlac ENTER.    ');
       repeat until (readkey in [#32,#27,#13]);
       exit;
      end;
    close(fa1);
  graf_g(typg[1],per[1]);
  end;
end;
 
begin
 textbackground(BLACK);
 clrscr;
 textbackground(BLUE);
 textcolor(YELLOW);
 okno(1,2,80,24,' F1-Help Í F2-SPZ Í F4-Evidencia Í F5-Vyber Í F6-Graf Í F10-Koniec ',' Software by TRSEK ',BLUE);
 vypln;
 repeat
  window(2,3,79,23);
  ch:=readkey;
  if (ch=#0) then begin
     ch:=readkey;
     case ch of
      #59: help;
      #60: i:=ciselnik(false);
      #62: edit_aut(false);
      #63: begin
           okno(5,10,75,15,'Podmienka pre vyber aut.','',BLUE);
           gotoxy(2,2);write('Vypisat auta, ktore maju do generalnej opravy:              km');
           do_go:=trval(tread(49,2,12,'',#0,#0));
           edit_aut(true);
           end;
      #64: graf;
      end;
      vypln;
    end;
 until (ch=#68);
 
 window(1,1,80,25);
 textcolor(WHITE);
 textbackground(BLACK);
 clrscr;
end.