Program for car evidence in company, pascal source

{ 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.