Dze je subor www.TrSek.com/pas/auto.pas{ 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;
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);