Works with telephone numbers in database, pascal

Program: Telefon.pas
File exe: Telefon.exe
File ubuntu: Telefon
It's a homework. The homework itself isn't so complicated as it looks like. Static allocation of the memory is what irritates me most. Nobody does it today, otherwise one could get into big troubles. I like the classification of the names using a typical "bubble" method. So if you need to have something sorted out and reliability and exactness, instead of rapidity, are the qualities you are looking for, this might be the program you need. Just have a look. I was engaged by the matter of classification for a longer time and some suggestions can be found in C source codes.
{ TELEFON.PAS               Copyright (c) TrSek alias Zdeno Sekerak }
{ Program na uchovavanie telefonnych cisel a simulovanie funkcii    }
{ databazy. Obsahuje uzivatelske prostredie. Data vsak neuchovava   }
{ v ziadnom subore.                                                 }
{                                                                   }
{ Datum:02.06.1994                             http://www.trsek.com }
 
program zadanie_telefonny_zoznam;
uses crt,dos;
const poc=100;potel=6;
      text:array[1..5] of string=
      ('  Vstup udajov  ',
       '  Vyhladavanie  ',
       '  Zmena udajov  ',
       '  Vypis zoznamu ',
       '  Koniec (ESC)  ');
       text1:array[1..5] of string=
       ('  mena              ',
        '  priezviska        ',
        '  mena a priezviska ',
        '  adresy            ',
        '  Spat do menu      ');
 
 
type zaz=record
     meno      :string[10];
     priezvisko:string[20];
     adresa    :string[30];
     telefon   :string[potel];
     end;
 
var zoznam:array[1..poc] of zaz;
    pomocna:zaz;
    i,i2,zpoc,p,min,max:integer;
    s,meno,meno2:string;
    ok:boolean;
    ch:char;
 
function upcase_s(meno:string):string;
var     i:integer;
    pmeno:string;
begin
 pmeno:='';
 for i:=1 to length(meno) do pmeno:=pmeno+UpCase(meno[i]);
 upcase_s:=pmeno;
end;
 
procedure farba(x,y:byte);
 begin textbackground(x);
       textcolor(y);
 end;
 
procedure open_win(xl,yl,xp,yp:integer;text:string;color:integer);
 var i,xs,ys:integer;
    p:real;
 begin
  window(xl,yl,xp,yp);
  p:=(yp-yl)/(xp-xl);
  xs:=round((xp-xl)/2)+xl;
  ys:=round((yp-yl)/2)+yl-1;
  textbackground(color);
  for i:=1 to round((xp-xl)/2) do begin
   window(xs-i,ys-round(i*p-0.6),xs+i,ys+round(i*p));
   clrscr;
   delay(8);
   end;
  window(1,1,80,24);
  for i:=xl to xp do begin
   gotoxy(i,yl);write('Í');end;
  gotoxy(xp,yl);write('ť');
  for i:=yl+1 to yp do begin
   gotoxy(xp,i);write('ş');end;
  gotoxy(xp,yp);write('ź');
  for i:=xp-1 downto xl do begin
   gotoxy(i,yp);write('Í');end;
  gotoxy(xl,yp);write('Č');
  for i:=yp-1 downto yl do begin
   gotoxy(xl,i);write('ş');end;
  gotoxy(xl,yl);write('É');
  if text<>'' then begin
     gotoxy(xs-(length(text) div 2),yl);write(' ',text,' ');end;
  window(xl+1,yl+1,xp-1,yp-1);
end;
 
function tread(x,y:integer;d:byte;s:string):string;
  var s1,s2,sz:string;
     st:char;
     x1,i,ins:integer;
     label tam;
   begin
   x1:=x;farba(15,0);ins:=1;
   s:=copy(s,1,d);
   if length(s)<d then for i:=length(s) to d-1 do s:=s+' ';
   gotoxy(x,y);write(s);sz:=s;
   if (x>0) and (x<81) and (y>0) and (y<25) and(x+d<81) then
                              begin
                              gotoxy(x,y);
                              repeat
                              st:=readkey;
         if (st=#27) or (st=#8) or (st=#0) or (st=#13) then
                  begin if st=#0 then
                           begin st:=readkey;
                              if st=#75  then x1:=x1-1;
                              if st=#77  then x1:=x1+1;
                              if st=#71 then x1:=x;
                              if st=#79 then begin i:=d+1;x1:=x+d;
                                                        repeat
                                                          i:=i-1;
                                                          s1:=copy(s,i,1);
                                                          if (s1=' ') then x1:=x+i-1;
                                                        until  (i=0) or (not(s1=' '));
                                             end;
                            end;
                        if st=#27 then begin gotoxy(x,y);write(sz);tread:=sz;exit;end;
                        if st=#8  then begin s1:=copy(s,1,x1-x-1);
                                             s2:=copy(s,x1-x+1,d-x1+x);
                                             s:=s1+s2+' ';
                                             x1:=x1-1;
                                       end;
                        if st=#83 then begin s1:=copy(s,1,x1-x);
                                             s2:=copy(s,x1-x+2,d-x1+x);
                                             s:=s1+s2+' ';
                                       end;
                        if st=#82 then begin if ins=2 then ins:=1
                                                      else ins:=2;
                                       end;
                  end
                  else begin
                             s1:=copy(s,1,x1-x);
                             s2:=copy(s,x1+ins-x,d-x1+x);
                             s:=s1+copy(st,1,1)+s2;
                             s:=copy(s,1,d);
                             x1:=x1+1;if (x1>x+d) then x1:=x+d;
                      end;
        if x1<x then x1:=x;
        if x1>x+d then x1:=x+d;
        s:=copy(s,1,d);
        gotoxy(x,y);writeln(s);gotoxy(x1,y);
     until st=#13;
    while pos(' ',s)>0 do delete(s,pos(' ',s),1);
    tread:=s;farba(0,15);
    end;
    textbackground(blue);textcolor(yellow);writeln;
 end;
 
procedure zamen(x,y:integer);
begin
 pomocna.meno:=zoznam[x].meno;
 zoznam[x].meno:=zoznam[y].meno;
 zoznam[y].meno:=pomocna.meno;
 
 pomocna.priezvisko:=zoznam[x].priezvisko;
 zoznam[x].priezvisko:=zoznam[y].priezvisko;
 zoznam[y].priezvisko:=pomocna.priezvisko;
 
 pomocna.adresa:=zoznam[x].adresa;
 zoznam[x].adresa:=zoznam[y].adresa;
 zoznam[y].adresa:=pomocna.adresa;
 
 pomocna.telefon:=zoznam[x].telefon;
 zoznam[x].telefon:=zoznam[y].telefon;
 zoznam[y].telefon:=pomocna.telefon;
end;
 
procedure tclrscr;
var i:integer;
begin
 for i:=1 to 24 do writeln;
 gotoxy(1,1);
end;
 
begin
 s:=' ';zpoc:=0;
 repeat
  window(1,1,80,25);
  textbackground(black);
  textcolor(yellow);
  clrscr;
  open_win(15,5,65,18,'Hlavne menu',blue);
  textbackground(blue);
  clrscr;
  writeln;
  writeln('      T E L E F O N N Y     Z O Z N A M  ');
  writeln('      ----------------------------------');
  writeln('      Definovanych ',zpoc,' ucastnikov.');
  writeln('      ----------------------------------');
  for i:=1 to 5 do begin
      gotoxy(7,i+5);write(text[i]);end;
  writeln;
  writeln('      -----------------');
  i:=1;
  textbackground(7);gotoxy(7,i+5);write(text[i]);
  repeat
   ch:=readkey;
   if ch=#27 then begin i:=5;ch:=#13;end;
   if ch=#0 then begin
      ch:=readkey;
      if ch=#80 then begin
          textbackground(1);gotoxy(7,i+5);write(text[i]);
          i:=i+1;if i>5 then i:=1;
          textbackground(7);gotoxy(7,i+5);write(text[i]);
          end;
      if ch=#72 then begin
          textbackground(1);gotoxy(7,i+5);write(text[i]);
          i:=i-1;if i<1 then i:=5;
          textbackground(7);gotoxy(7,i+5);write(text[i]);
          end;
       end;
  until (ch=#13);
  if i=5 then begin
    textbackground(blue);open_win(1,2,80,23,'',blue);clrscr;
    gotoxy(19,10);
    write  (' Naozaj chces skoncit ??? [A/..]: ');ch:=readkey;
    if (ch in ['a','A']) then i:=5
                         else i:=0;
    end;
  case i of
   1:begin
       textbackground(blue);open_win(1,2,80,23,'',blue);clrscr;
       repeat
        clrscr;zpoc:=zpoc+1;
        if zpoc>poc then begin
           zpoc:=poc;
           writeln('Viac udajov uz nemozem natlacit do pamete, predefinuj konstantu poc.');
           readln;
           end
        else begin
         writeln;
         writeln('       1.Vstup udajov');
         writeln('       --------------');
         writeln('       Maximalny pocet je:',poc,' . Zatial je ',zpoc-1,' zadefinovanych.');
         writeln('       -----------------------------------------------------------');
         write  ('       Zadaj meno:');zoznam[zpoc].meno:=tread(wherex,wherey,10,'');
         write  ('       priezvisko:');zoznam[zpoc].priezvisko:=tread(wherex,wherey,20,'');
         write  ('           adresu:');zoznam[zpoc].adresa:=tread(wherex,wherey,30,'');
         repeat
          ok:=true;
          for i:=1 to potel do zoznam[zpoc].telefon[i]:=' ';
          write  ('          telefon:');readln(zoznam[zpoc].telefon);
          for i:=1 to potel do
            if not(zoznam[zpoc].telefon[i] in ['0'..'9',' ','/']) then ok:=false;
          if not(ok) then writeln('       Zle zadanne telefonne cislo.');
         until ok;
        end;
       writeln;
       writeln('        Definovat dalsieho.  [../N]:');
       ch:=readkey;
       until (ch in ['n','N']);
       end;
   2:begin
       repeat
        window(1,1,80,25);
        textbackground(black);
        clrscr;
        open_win(15,5,65,18,'Menu hladaj',blue);
        textbackground(blue);
        clrscr;
        writeln;
        writeln('      Vyhladavanie podla');
        writeln('      ------------------');
        for i2:=1 to 5 do begin
           gotoxy(7,i2+3);write(text1[i2]);end;
        writeln;
        writeln('      ------------------');
           i2:=1;
           textbackground(7);gotoxy(7,i2+3);write(text1[i2]);
           repeat
            ch:=readkey;
            if ch=#0 then begin
               ch:=readkey;
               if ch=#80 then begin
                  textbackground(1);gotoxy(7,i2+3);write(text1[i2]);
                  i2:=i2+1;if i2>5 then i2:=1;
                  textbackground(7);gotoxy(7,i2+3);write(text1[i2]);
               end;
               if ch=#72 then begin
                  textbackground(1);gotoxy(7,i2+3);write(text1[i2]);
                  i2:=i2-1;if i2<1 then i2:=5;
                  textbackground(7);gotoxy(7,i2+3);write(text1[i2]);
                  end;
               end;
            until (ch=#13);
        if i2<>5 then begin
        textbackground(blue);open_win(1,3,80,22,'',blue);clrscr;end;
        case i2 of
         1:begin
           write('       Zadaj meno:');meno:=tread(wherex,wherey,10,'');
           write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄż');
           write('ł Meno     ł Priezvisko         ł Adresa                       ł Tel. cislo  ł');
           write('ĂÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
           for i:=1 to zpoc do
             if upcase_s(meno)=upcase_s(zoznam[i].meno) then
               write('ł',zoznam[i].meno:10,'ł',zoznam[i].priezvisko:20,'ł',zoznam[i].adresa:30,'ł',zoznam[i].telefon:13,'ł');
           write('ŔÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄŮ');
           readln;
           end;
         2:begin
           write('       Zadaj priezvisko:');meno:=tread(wherex,wherey,20,'');
           write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄż');
           write('ł Meno     ł Priezvisko         ł Adresa                       ł Tel. cislo  ł');
           write('ĂÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
           for i:=1 to zpoc do
             if upcase_s(meno)=upcase_s(zoznam[i].priezvisko) then
               write('ł',zoznam[i].meno:10,'ł',zoznam[i].priezvisko:20,'ł',zoznam[i].adresa:30,'ł',zoznam[i].telefon:13,'ł');
           write('ŔÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄŮ');
           readln;
           end;
         3:begin
           write('       Zadaj meno:');meno:=tread(wherex,wherey,10,'');
           write('       priezvisko:');meno2:=tread(wherex,wherey,20,'');
           write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄż');
           write('ł Meno     ł Priezvisko         ł Adresa                       ł Tel. cislo  ł');
           write('ĂÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
           for i:=1 to zpoc do
             if (upcase_s(meno)=upcase_s(zoznam[i].meno)) and
                (upcase_s(meno2)=upcase_s(zoznam[i].priezvisko)) then
               write('ł',zoznam[i].meno:10,'ł',zoznam[i].priezvisko:20,'ł',zoznam[i].adresa:30,'ł',zoznam[i].telefon:13,'ł');
           write('ŔÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄŮ');
           readln;
           end;
         4:begin
           write('       Zadaj adresu:');meno:=tread(wherex,wherey,30,'');
           write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄż');
           write('ł Meno     ł Priezvisko         ł Adresa                       ł Tel. cislo  ł');
           write('ĂÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
           for i:=1 to zpoc do
             if upcase_s(meno)=upcase_s(zoznam[i].adresa) then
               write('ł',zoznam[i].meno:10,'ł',zoznam[i].priezvisko:20,'ł',zoznam[i].adresa:30,'ł',zoznam[i].telefon:13,'ł');
           write('ŔÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄŮ');
           readln;
           end;
         end;
       until (i2=5);
       end;
   3:begin
       textbackground(blue);open_win(1,2,80,23,'Zmena',blue);clrscr;
       repeat
         clrscr;
         writeln;
         writeln('       Zmena udajov');
         writeln('       ------------');
         write  ('       Zadaj meno:');pomocna.meno:=tread(wherex,wherey,10,'');
         write  ('       priezvisko:');pomocna.priezvisko:=tread(wherex,wherey,20,'');
         write  ('           adresu:');pomocna.adresa:=tread(wherex,wherey,30,'');
         repeat
          ok:=true;
          for i:=1 to potel do pomocna.telefon[i]:=' ';
          write  ('          telefon:');readln(pomocna.telefon);
          for i:=1 to potel do
            if not(pomocna.telefon[i] in ['0'..'9',' ','/']) then ok:=false;
          if not(ok) then writeln('       Zle zadanne telefonne cislo.');
         until ok;
         ok:=false;
         for i:=1 to zpoc do
           if (upcase_s(pomocna.meno)=upcase_s(zoznam[i].meno)) and
              (upcase_s(pomocna.priezvisko)=upcase_s(zoznam[i].priezvisko)) then begin
              write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄż');
              write('ł',zoznam[i].meno:10,'ł',zoznam[i].priezvisko:20,'ł',zoznam[i].adresa:30,'ł',zoznam[i].telefon:13,'ł');
              write('ŔÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄŮ');
              writeln('       Zmenit tohto ucastnika ???  [A/..]:');ch:=readkey;
              if (ch in ['a','A']) then begin
                 ok:=true;
                 zoznam[i].adresa :=pomocna.adresa;
                 zoznam[i].telefon:=pomocna.telefon;end;
              end;
          if (not(ok) and (zpoc<poc)) then begin
              writeln('       Takyto ucastnik neexistuje. Mam ho zaradit ???  ../N:');
              ch:=readkey;;
              if not(ch in ['n','N']) then begin
                 zpoc:=zpoc+1;
                 zoznam[zpoc].meno      :=pomocna.meno;
                 zoznam[zpoc].priezvisko:=pomocna.priezvisko;
                 zoznam[zpoc].adresa    :=pomocna.adresa;
                 zoznam[zpoc].telefon   :=pomocna.telefon;end;
              end;
        writeln('       Chces previest dalsiu zmenu [../N]:');ch:=readkey;
       until (ch in ['n','N']);
       end;
   4:begin
        textbackground(blue);window(1,1,80,25);clrscr;
        if zpoc>0 then begin
        writeln('Prebieha triedenie zoznamu udajov.');
        write  ('Prechod zoznamom:   0');
        p:=0;      {*** Usporiadava podla mena a priezviska ***}
        repeat
         ok:=true;
         for i:=1 to zpoc-1 do
          if (zoznam[i].priezvisko>zoznam[i+1].priezvisko) then begin
             zamen(i,i+1);
             ok:=false;end;
         for i:=zpoc downto 2 do
          if (zoznam[i].priezvisko<zoznam[i-1].priezvisko) then begin
             zamen(i-1,i);
             ok:=false;end;
         p:=p+1;write(chr(8)+chr(8)+chr(8),p:3);
        until ok;
        window(1,1,80,25);clrscr;
        writeln;
        writeln('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄż');
        writeln('ł Meno     ł Priezvisko         ł Adresa                       ł Telefonne cisł');
        writeln('ĂÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
        for i:=1 to zpoc do begin
         writeln('ł',zoznam[i].meno:10,'ł',zoznam[i].priezvisko:20,'ł',zoznam[i].adresa:30,'ł',zoznam[i].telefon:14,'ł');
         if (i mod 20)=0 then begin
            write('Stlac Enter pre dalsi vypis ....');readln;
            gotoxy(1,wherey-1);delline;end;
         end;
        writeln('ŔÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄŮ');
        write('Stlac Enter ....');readln;
       end;
      end;
   end;
 until (i=5);
 window(1,1,80,25);
 textbackground(black);
 textcolor(white);
 clrscr;
end.
Works with telephone numbers in database, pascal

Navigační menu

Osobní nástroje

Hledat

Pascal source

Pascal Wiki

Bonus

Contacts

Languages
