Program for car evidence in company, pascal source

Program: Auto.pas
File exe: Auto.exe
need: Cisel.pas, Auta.dat, Spz.cis
It is one of the assignments I made for my friend, but because it is so complicated I resolved to include it in here. By the way, assignments are to be found here.
{ CISEL.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Obsahuje funkcie a procedury pre program AUTO.PAS.                }
{ Blizsie informacie v AUTO.PAS.                                    }
{                                                                   }
{ Datum:18.03.1998                             http://www.trsek.com }
 
function ciselnik(vyber:boolean):integer;
var cislo,poc,i,i2,ir:integer;
      ch:char;
      uz:boolean;
begin
 textbackground(DARKGRAY);
 textcolor(YELLOW);
 okno(10,5,48,21,' Ciselnik SPZ ',' olvadanie:Enter,sipky, ESC-koniec ',GREEN);
 textbackground(DARKGRAY);
 assign(fc1,'spz.cis');
 {$I-}
 reset(fc1);
 {$I+}
 if (Ioresult<>0) then begin
     rewrite(fc1);
     end;
 poc:=1;
 while ( (poc<FileSize(fc1)) or not(Eof(fc1)) ) do begin
  seek(fc1,poc);
  read(fc1,cisel);
  if (poc<15) then begin
     gotoxy(2,poc);write(cisel.typ:3,' - ',cisel.popis);
     end;
  poc:=poc+1;
  end;
 
 i:=1;ir:=0;
 if (i=poc) then begin
     cisel.typ:=tival(copy('                              ',1,3));
     cisel.popis:=copy('                              ',1,SizeOf(cisel.popis));
     cisel.del:=false;
     end
    else begin
     seek(fc1,i+ir);read(fc1,cisel);
     end;
 textbackground(BLUE);
 textcolor(YELLOW);
 gotoxy(2,i);write(cisel.typ:3,' - ',cisel.popis);
 
 repeat
  ch:=readkey;
  if ((ch=#13) or (ch in ['0'..'9'])) then begin
    if vyber then cislo:=cisel.typ
    else begin
    repeat
     if(ch=#13) then cisel.typ:=tival(tread(2,i,3,tistr(cisel.typ),#0,#0))
                else cisel.typ:=tival(tread(2,i,3,'',ch,ch));
     textcolor(YELLOW);
     if (cisel.typ=0) then hlaska(12,21,' Nulove cislo neberiem. ');
     uz:=false;
     for i2:=1 to poc-1 do begin
         seek(fc1,i2);read(fc1,pcisel);
         if ((pcisel.typ=cisel.typ) and (i<>i2)) then uz:=true;
         end;
     if uz then hlaska(12,21,' Uz take cislo mas !!! ');
     textcolor(WHITE);
     gotoxy(2,i);
     window(11,6,69,20);
    until ( not(uz) and (cisel.typ<>0));
     cisel.popis:=tread(8,i,SizeOf(cisel.popis)-2,cisel.popis,#0,#0);
     seek(fc1,i+ir);write(fc1,cisel);
   ch:=' ';
   end;
  end;
 
  if (ch=#0) then begin
     ch:=readkey;
     textbackground(DARKGRAY);
     textcolor(YELLOW);
     gotoxy(2,i);write(cisel.typ:3,' - ',cisel.popis);
     case (ch) of
      #83:begin
           cisel.del:=true;
           if( cisel.typ > 0) then
               cisel.typ:=(-1)*cisel.typ;
           hlaska(11,21,' Polozka je oznacena ako zrusena.  ');
           window(11,6,69,20);
           seek(fc1,i+ir);write(fc1,cisel);
          end;
      #72:begin
           i:=i-1;
           if (i<1) then begin
              i:=1;ir:=ir-1;
              if (ir<0) then ir:=0
                        else begin gotoxy(1,1);insline;
                                   gotoxy(1,15);delline;end;
              end;
          end;
      #80:begin
           i:=i+1;
           if ((i+ir)>FileSize(fc1)) then i:=i-1;
           if vyber and ((i+ir)>=FileSize(fc1)) then i:=i-1;
           if (i>14) then begin
              i:=14;ir:=ir+1;
              if ((ir+i)>FileSize(fc1)+1) then ir:=FileSize(fc1)-i+1
                                     else begin gotoxy(1,1);delline;end;
              end;
          end;
      end;
     end;
 
   if (ir+i<FileSize(fc1)) then begin
        seek(fc1,ir+i);
        read(fc1,cisel);
        end
       else
        if not(vyber) then
        begin
        cisel.typ:=tival(copy('                              ',1,3));
        cisel.popis:=copy('                              ',1,SizeOf(cisel.popis)-2);
        cisel.del:=false;
        end;
 
     textbackground(BLUE);
     textcolor(YELLOW);
     gotoxy(2,i);write(cisel.typ:3,' - ',cisel.popis);
 until (ch in [#27,#13]);
 close(fc1);
 ciselnik:=cislo;
end;
 
procedure edit_aut(podmienka:boolean);
var poc,i,i2,ic,ir:integer;
      ch:char;
   kolko:byte;
      uz:boolean;
   v_sub:array[1..1000] of word;
cis_okna:integer;
begin
 textbackground(DARKGRAY);
 textcolor(YELLOW);
 if podmienka then
     okno(8,5,72,21,' SPZ       ł Typ ł     Spotreba łodjazdne od GOł ostava do GO ',' Auta majuce do GO '+trstr(do_go)+' km ',
     GREEN)
    else
    okno(8,5,72,21,' SPZ       ł Typ ł     Spotreba łodjazdne od GOł ostava do GO ',' ENTER-Zmen  DEL-Zrus ',GREEN);
 textbackground(DARKGRAY);
 assign(fa1,'auta.dat');
 {$I-}
 reset(fa1);
 {$I+}
 if (Ioresult<>0) then begin
     rewrite(fa1);
     end;
 for i:=1 to 1000 do v_sub[i]:=0;
 poc:=0;i:=1;
 while (not(Eof(fa1))) do begin
  poc:=poc+1;
  seek(fa1,poc-1);
  read(fa1,auto);
  if (not(podmienka) or (auto.do_go<=do_go)) and (i<15) then begin
      v_sub[i]:=poc;
      gotoxy(2,i);write(auto.SPZ,' ł ',auto.typ:3,' ł ',auto.p_spot:12:2,' ł ',auto.od_go:12:2,' ł ',auto.do_go:12:2);
      i:=i+1;
      end;
  end;
 poc:=filesize(fa1);
 
 if podmienka and (v_sub[1]=0) then begin
    hlaska(20,14,'Neda sa vybrat ziadne auto !!!');
    close(fa1);
    exit;
    end;
 ir:=0;y:=1;ic:=1;
 if (i=1) then begin
     auto.SPZ:='         ';
     auto.typ:=0;auto.p_spot:=0;auto.od_go:=0;auto.do_go:=0;
     auto.del:=false;
     end
    else begin
     i:=1;
     seek(fa1,v_sub[i+ir]-1);read(fa1,auto);
     end;
 
 textbackground(BLUE);
 textcolor(YELLOW);
 gotoxy( 2,i);write(auto.SPZ);
 
 repeat
  ch:=readkey;
  if ((ch=#13) or (ch in ['0'..'9','A'..'z'])) then
     if not(podmienka) then
     begin
     case (y) of
      1: auto.SPZ   :=tread(2,i,SizeOf(auto.SPZ)-1,auto.SPZ,ch,ch);
      2: begin
          window(1,1,80,24);
          cis_okna := get_window(10,5,70,21);
          auto.typ:=ciselnik(true);
          window(1,1,80,24);
          put_window(cis_okna,10,5,70,21);
          window(9,6,71,20);
          gotoxy(14,i);write(auto.typ:3);
         end;
      3: auto.p_spot:=trval(tread(20,i,12,'',ch,ch));
      4: auto.od_go :=trval(tread(35,i,12,'',ch,ch));
      5: auto.do_go :=trval(tread(50,i,12,'',ch,ch));
      end;
     y:=y+1;  if(y>5) then y:=1;
 
     if not(nemoze(auto)) then begin
        if (v_sub[i+ir]=0) then begin
           poc:=poc+1;
           v_sub[i+ir]:=poc;
           end;
        ic:=filesize(fa1);
        seek(fa1,v_sub[ir+i]-1);
        write(fa1,auto);
        close(fa1);reset(fa1);
        ic:=filesize(fa1);
        end;
     end;
 
 
  if (ch=#0) then begin
     ch:=readkey;
     textbackground(DARKGRAY);
     textcolor(YELLOW);
     gotoxy(2,i);write(auto.SPZ,' ł ',auto.typ:3,' ł ',auto.p_spot:12:2,' ł ',auto.od_go:12:2,' ł ',auto.do_go:12:2);
     case (y) of
        1: begin gotoxy( 2,i);write(auto.SPZ);end;
        2: begin gotoxy(14,i);write(auto.typ:3);end;
        3: begin gotoxy(20,i);write(auto.p_spot:12:2);end;
        4: begin gotoxy(35,i);write(auto.od_go:12:2);end;
        5: begin gotoxy(50,i);write(auto.do_go:12:2);end;
        end;
     case (ch) of
      #83:begin
           if not(auto.del) then begin
              auto.del:=true;
              auto.SPZ:='ĺ'+copy(auto.SPZ,2,length(auto.SPZ)-1);
              hlaska(12,21,' Polozka je oznacena ako zrusena. ');
              seek(fa1,v_sub[i+ir]-1);write(fa1,auto);
              window(9,6,71,20);
             end;
          end;
      #75:begin
           y:=y-1;if (y<1) then y:=1;
          end;
      #77:begin
           y:=y+1;if (y>5) then y:=5;
          end;
      #72:begin
           i:=i-1;
           if (i<1) then begin
              i:=1;ir:=ir-1;
              if (ir<0) then ir:=0
                        else begin gotoxy(1,1);insline;
                                   gotoxy(1,15);delline;end;
              end;
          end;
      #80:begin
           i:=i+1;
           if ((i+ir)>poc) then if nemoze(auto) then i:=i-1;
           if podmienka and (v_sub[i+ir]=0) then i:=i-1;
           if (i>14) then begin
              i:=14;ir:=ir+1;
              if ((ir+i)>FileSize(fa1)+1) then ir:=FileSize(fa1)-i+1
                                     else begin gotoxy(1,1);delline;end;
              end;
           if ((i+ir)<>ic) then begin
              auto.SPZ:='         ';
              auto.typ:=0;auto.p_spot:=0;auto.do_go:=0;auto.od_go:=0;
              auto.del:=false;
             end;
          end;
      end;
     end;
 
   if (v_sub[ir+i]>0) then begin
        seek(fa1,v_sub[ir+i]-1);
        read(fa1,auto);
        end;
 
     ic:=i+ir;
     textbackground(DARKGRAY);
     textcolor(YELLOW);
     gotoxy(2,i);write(auto.SPZ,' ł ',auto.typ:3,' ł ',auto.p_spot:12:2,' ł ',auto.od_go:12:2,' ł ',auto.do_go:12:2);
     textbackground(BLUE);
     case (y) of
        1: begin gotoxy( 2,i);write(auto.SPZ);end;
        2: begin gotoxy(14,i);write(auto.typ:3);end;
        3: begin gotoxy(20,i);write(auto.p_spot:12:2);end;
        4: begin gotoxy(35,i);write(auto.od_go:12:2);end;
        5: begin gotoxy(50,i);write(auto.do_go:12:2);end;
        end;
 
     ic:=i+ir;
     if not(nemoze(auto)) then begin
        seek(fa1,v_sub[ir+i]-1);
        write(fa1,auto);
     end;
 until (ch in [#27]);
 close(fa1);
 filtruj_auta;
 
 { Chce to mat aj v textovom subore }
 if( podmienka ) then begin
  okno(5,10,75,15,' Zapis aut do TXT suboru ??? ','',BLUE);
  gotoxy(6,2);write('Zapisat vybrane auta do TXT suboru (A/..) :');
  meno_s:=tread(49,2,1,'A',#0,#0);
  if UpCase(meno_s[1])='A' then begin
     textbackground(BLUE);
     gotoxy(2,2);write('         Zadaj meno TXT suboru:                 ');
     meno_s:=tread(33,2,12,'noname00.txt',#0,#0);
     assign(fa1,'auta.dat');
     reset(fa1);
     assign(ftext,meno_s);
     rewrite(ftext);
     writeln(ftext,'ŐÍÍÍÍÍÍÍÍÍÍÍŃÍÍÍÍÍŃÍÍÍÍÍÍÍÍÍÍÍÍÍÍŃÍÍÍÍÍÍÍÍÍÍÍÍÍÍŃÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¸');
     writeln(ftext,'ł SPZ       ł Typ ł     Spotreba łodjazdne od GOł ostava do GO   ł');
     writeln(ftext,'ĆÍÍÍÍÍÍÍÍÍÍÍŘÍÍÍÍÍŘÍÍÍÍÍÍÍÍÍÍÍÍÍÍŘÍÍÍÍÍÍÍÍÍÍÍÍÍÍŘÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍľ');
     i:=1;
     while (v_sub[i]<>0) do begin
        seek(fa1,v_sub[i]-1);read(fa1,auto);i:=i+1;
     writeln(ftext,'ł ',auto.SPZ,' ł ',auto.typ:3,' ł ',auto.p_spot:12:2,' ł ',auto.od_go:12:2,' ł ',auto.do_go:12:2,'   ł');
        end;
     writeln(ftext,'ÔÍÍÍÍÍÍÍÍÍÍÍĎÍÍÍÍÍĎÍÍÍÍÍÍÍÍÍÍÍÍÍÍĎÍÍÍÍÍÍÍÍÍÍÍÍÍÍĎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍž');
     close(fa1);
     close(ftext);
     end;
  end;
end;
Program for car evidence in company, pascal source

Navigační menu

Osobní nástroje

Hledat

Pascal source

Pascal Wiki

Bonus

Contacts

Languages
