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