Program na prácu s databázou hráèov NBA

Delphi & Pascal (èeská wiki)
Pøejít na: navigace, hledání
Kategorija: KMP (Programy mladòakoch

Zrobil: Ján Beèkei
Program: Nba2.pas
Subor exe: Nba2.exe
Uka¾ka: Hraci.dat

Program na prácu s databázou hráèov NBA. Umo¾nuje pridáva», maza», editova», hµada» podµa mena, alebo zoradi» podµa zadaných kritérií. V¹etko v prehµadom menu.
{ NBA2.PAS                                 Copyright (c) Ján Beckei }
{                                                                   }
{ Program na pracu s databazou hracov NBA.                          }
{ Umoznuje: pridavat, mazat, editovat, hladat podla mena            }
{           alebo zoradit podla zadanych kriterii                   }
{                                                                   }
{ Author: Ján Beèkei                                                }
{ Datum: 24.11.2008                           http://www.trsek.com  }
 
program DatabazaNBA;
 uses crt;
 type
 
  TNBA=record
   den:byte;
   mesiac:byte;
   rok:string[4];
   meno,kluby,priezvisko:string;
   zapasy,body,doskoky,asistencie:integer;
  end;
 
  TSubor=file of TNBA;
 
  TDatabaza=record
    pocet:integer;
    hrac:array[1..10] of TNBA;
  end;
 
var
 subor:TSubor;
 hraci:TDatabaza;
 volba:char;
 zadaj:array [1..10] of string;
 kl:char;
 t:boolean;
 
 
procedure CitHracov(var player:TNBA);
var x,y:byte;
 begin
 x:=30;
 y:=14;
  with player do
   begin
    gotoxy(x-15,y);write('Meno: ');
    readln(meno);
    gotoxy(x-15,y+1);write('Priezvisko: ');
    readln(priezvisko);
    gotoxy(x-15,y+2);writeln('Datum narodenia: ');
    gotoxy(x-14,y+3);write('den: '); readln(den);
    gotoxy(x-14,y+4);write('mesiac: '); readln(mesiac);
    gotoxy(x-14,y+5);write('rok: '); readln(rok);
    gotoxy(x+10,y);write('Odohrane zapasy: ');
    readln(zapasy);
    gotoxy(x+10,y+1);write('Kluby: ');
    readln(kluby);
    gotoxy(x+10,y+2);write('Body: ');
    readln(body);
    gotoxy(x+10,y+3);write('Doskoky: ');
    readln(doskoky);
    gotoxy(x+10,y+4);write('Asistencie: ');
    readln(asistencie);
   end;{with player}
 end;{CitHracov}
 
procedure PisHracov(player:TNBA);
var x,y:byte;
 begin
 x:=25;
 y:=15;
  with player do
   begin
    gotoxy(x,y);write('Meno: ',meno);
    gotoxy(x,y+1);write('Priezvisko: ',priezvisko);
    gotoxy(x,y+2);write('Datum narodenia: ',den,'.',mesiac,'.',rok);
    gotoxy(x,y+3);write('Odohrane zapasy: ',zapasy);
    gotoxy(x,y+4);write('Kluby: ',kluby);
    gotoxy(x,y+5);write('Body: ',body);
    gotoxy(x,y+6);write('Doskoky: ',doskoky);
    gotoxy(x,y+7);write('Asistencie: ',asistencie);
   end;{with}
 end;{PisHracov}
 
 
procedure UlozDatabazu (var databaza:TDatabaza;var subor :TSubor);
var
  i:integer;
begin
  rewrite (subor);
  for i:=1 to databaza.pocet do
    write (subor,databaza.hrac[i]);
 close (subor);
end;{procedure UlozDatabazu}
 
procedure NacitDatabazu (var databaza:TDatabaza;var subor:TSubor);
var
  i:integer;
begin
 i:=0;
 reset (subor);
 while not eof(subor) do
 begin
   i:=i+1;
   read (subor, databaza.hrac[i]);
 end;
 close (subor);
 databaza.pocet:=i;
end;{procedure NacitDatabazu}
 
procedure init (var databaza:TDatabaza);
begin
  databaza.pocet:=0;
end;
 
procedure menu2;
 var x,y,i:byte;
 begin
   x:=30;
   y:=1;
   clrscr;
  textbackground(black);
  gotoxy(x,y);   write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŸ');
  gotoxy(x,y+1); write('º*******MENU*******º');
  gotoxy(x,y+2); write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͱ');
  gotoxy(x,y+3); write('º Novy Hrac        º');
  gotoxy(x,y+4); write('º Zobraz Hracov    º');
  gotoxy(x,y+5); write('º Vyhladavanie     º');
  gotoxy(x,y+6); write('º Zrusenie Hraca   º');
  gotoxy(x,y+7); write('º Zoradenie Hracov º');
  gotoxy(x,y+8); write('º Nacitanie        º');
  gotoxy(x,y+9); write('º Ulozenie         º');
  gotoxy(x,y+10);write('º Koniec (Esc)     º');
  gotoxy(x,y+11);write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¥');
  for i:=1 to 80 do
   begin gotoxy(i,y+12);
         write('-');
  end;
end;
 
procedure ZobrazKartu (databaza:TDatabaza; cisloKarty:integer;var klavesa:char );
begin
menu2;
 textcolor (white);
 with databaza do
 begin
    gotoxy(25,14);write ('Zaznam o ',cisloKarty:2,'. hracovi z celkom ',pocet:2);
    PisHracov (hrac[cisloKarty]);
 end;{with databaze}
 klavesa:=readkey;
 if (ord(klavesa)=0) then
    klavesa:=chr(128+ord(readkey));
end;{procedure ZobrazKartu}
 
 
procedure ZobrazDatabazu (var databaza:TDatabaza);
var
 ukazovatko:integer;
 klav:char;
begin
 ukazovatko:=1;
 with databaza do
 begin
   while (ukazovatko>=1) and (ukazovatko<=pocet) do
   begin
      ZobrazKartu (databaza,ukazovatko,klav);
      case ord(klav) of
        200, 201, 203:ukazovatko:=ukazovatko-1;
        205, 208, 209:ukazovatko:=ukazovatko+1;
      end;
     clrscr;
   end;{while}
 end;{with databaze}
end;{Procedura ZobrazDatabazu}
 
 
procedure MazanieHracov (var databaza:TDatabaza);
var
  x,y:byte;
  meno:string;
  i,j  :integer;
begin
 x:=25;
 y:=14;
  gotoxy(x,y);write ('Ktoreho hraca chces odstranit?');
  gotoxy(x,y+1);
  readln (meno);
  i:=1;
  with databaza do
   while i<=pocet do
    begin
     if hrac[i].meno=meno then
      begin
       for j:=i to pocet-1 do
    hrac[j]:=hrac[j+1];
    pocet:=pocet-1;
      end{if nasiel}
      else write('nenasiel');
         i:=i+1;
 
 end;{while}
end;{MazanieHracov}
 
procedure PridajHraca (var databaza:TDatabaza);
 begin
  textcolor (white);
  with databaza do
  begin
    pocet:=pocet+1;
    CitHracov(hrac[pocet]);
   end;{databaza}
end;{procedura PridajHraca}
 
procedure Vyhladaj_podla_mena(var databaza:TDatabaza);
  var x,y:byte;
      m:string;
      i: integer;
 
  begin
   x:=15;
   y:=14;
      gotoxy(x,y);write('Vyhladanie podla mena...vstup mena: ');
      readln(m);
    for i:=1 to databaza.pocet{pocet vsetkych prvkou v databaze} do begin
       if (m=databaza.hrac[i].meno) then begin
         PisHracov (databaza.hrac[i]);
         readln;
                 end;
         end;
 end;
 
procedure Zorad (var databaza:TDatabaza);
var
  i,j:integer;
  pom:TNBA;
  koniec:boolean;
begin
{Usporiadanie metodou bouble sort}
with databaza do
  repeat
   koniec:=true;
   for i:=1 to pocet-1 do
      for j:=1 to i do
         if hrac[j].meno>hrac[j+1].meno {nespravne poradie}
         then
         begin {vymena prvku}
            pom:=hrac[j];
            hrac[j]:=hrac[j+1];
            hrac[j+1]:=pom;
            koniec:=false;
         end;
  until (koniec);
end;{Zorad}
 
procedure menu_zadaj;
 begin
  zadaj[1]:='Novy Hrac     ';
  zadaj[2]:='Zobraz Hracov   ';
  zadaj[3]:='Vyhladavanie    ';
  zadaj[4]:='Zrusenie Hraca ';
  zadaj[5]:='Zoradenie Hracov ';
  zadaj[6]:='Nacitanie       ';
  zadaj[7]:='Ulozenie        ';
  zadaj[8]:='Koniec (Esc)     ';
 end;
 
 
procedure menu;
 var x,y,i:byte;
 begin
   x:=30;
   y:=1;
   clrscr;
   menu_zadaj;
  textbackground(black);
  gotoxy(x,y);   write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŸ');
  gotoxy(x,y+1); write('º*******MENU*******º');
  gotoxy(x,y+2); write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͱ');
  gotoxy(x,y+3); write('º                  º');
  gotoxy(x,y+4); write('º                  º');
  gotoxy(x,y+5); write('º                  º');
  gotoxy(x,y+6); write('º                  º');
  gotoxy(x,y+7); write('º                  º');
  gotoxy(x,y+8); write('º                  º');
  gotoxy(x,y+9); write('º                  º');
  gotoxy(x,y+10);write('º                  º');
  gotoxy(x,y+11);write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¥');
  for i:=1 to 80 do
   begin gotoxy(i,y+12);
         write('-');
  end;
  y:=4;
  x:=32;
  textbackground(black);textcolor(white);
   for i:=1 to 8
    do begin
        gotoxy(x,y);
        write(zadaj[i]);
        y:=y+1;
       end;
 y:=4;i:=1;
    gotoxy(x,y);textbackground(white);textcolor(black);write(zadaj[i]);textbackground(black);textcolor(white);
     repeat
      kl:=readkey;
        case kl of
              #0:
         begin
        kl:=readkey;
        case kl of
              #72:begin case y of 4:begin
                                     gotoxy(x,y);textbackground(black);textcolor(white);
                                     write(zadaj[i]);y:=y+7;i:=i+7;                                      end;
                              5,6,7,8,9,10,11:begin
                                     gotoxy(x,y);textbackground(black);textcolor(white);
                                     write(zadaj[i]);y:=y-1;i:=i-1;
                                    end;
                  end;end;
              #80:begin case y of 11:begin
                                     gotoxy(x,y);textbackground(black);textcolor(white);
                                     write(zadaj[i]);y:=y-7;i:=i-7;
                                    end;
                              10,9,8,7,6,5,4:begin
                                      gotoxy(x,y);textbackground(black);textcolor(white);
                                      write(zadaj[i]);y:=y+1;i:=i+1;
                                     end;
                                     end;
                                     end;
                 end;
             end;
              end;
        gotoxy(x,y);textbackground(white);textcolor(black);write(zadaj[i]);        textbackground(black);textcolor(white);
 
   until (kl=#13) or (kl=#27);
      case kl of
      #13:begin case i of
                      1:PridajHraca (hraci);
                      2:ZobrazDatabazu (hraci);
                      3:Vyhladaj_podla_mena (hraci);
                      4:MazanieHracov (hraci);
                      5:Zorad (hraci);
                      6:NacitDatabazu (hraci, subor);
                      7:UlozDatabazu (hraci, subor);
                      8:t:=true;
 
            end;end;
           #27:t:=true;
      end;
end;
 
 
(*                  Hlavny program                                         *)
begin
  init (hraci);
  assign (subor,'hraci.dat');
  t:=false;
  repeat menu;
  until t;
end.