Program je určený na evidenciu áut vo firme
Delphi & Pascal (česká wiki)
Kategória: Programy v Pascale
Program: Auto.pas
Súbor exe: Auto.exe
Potrebné: Cisel.pas, Auta.dat, Spz.cis
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.
{ 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.