Allow to command different things (pizza, bevarages) in a school cafeteria (open at lunch time) using uniquely the arrows of the keyboard and make the total to pay automatically

Kategórie: KMP (Programy mladých programátorů)
Program: Cafet.pas
Soubor exe: Cafet.exe
Potřebné: Cafet.lst
Allow to command different things (pizza, bevarages) in a school cafeteria (open at lunch time) using uniquely the arrows of the keyboard and make the total to pay automatically. At the end of the week, recapitulate all the totals of the week (before year 2000 !) .
{ CAFET.PAS                                                         }
{ Allow to command different things (pizza, bevarages) in a school  }
{ cafeteria (open at lunch time) using uniquely the arrows of the   }
{ keyboard and make the total to pay automatically.                 }
 
{                                                                   }
{ At the end of the week, recapitulate all the totals of the week   }
{ (before year 2000 !)                                              }
{                                                                   }
{ Author: Unknown                                                   }
{ Datum: 20.01.2009                            http://www.trsek.com }
 
program caf44cga;
uses crt,dos;
const
  max = 40;
var
  col0, col1, col14, col15            : integer;
  t1, t2, ch, cat                     : char;
  n, no, col, lig, x, y, code, fl, i  : integer;
  tot, ben, total, benef              : real;
  totsem, bensem, num                 : real;
  strn                                : string;
  mot_p, pw                           : string[5];
  nom_f, jjmm                         : string[6];
  des                                 : string[16];
  fic                                 : text;
  suite                               : boolean;
  nbr                                 : array [1..max] of real;
  totj, benj                          : array[1..10] of real;
  datjour, totjour, benjour           : array[1..10] of string;
  ch1, ch2, ch3                       : array [0..max] of string[16];
  fich                                : array [0..10] of string[6];
  regs                                : registers;
  keyflag                             : byte absolute $40:$17;
 
Function Frs(rl:real):real;
var
  i:longint;  s:string;
begin
  i :=round(rl);
  str(i,s);
  case length(s) of
    1 :  s:=' 0.0'+s;
    2 :  s:=' 0.'+s;
    else s:=copy(s,1,length(s)-2)+'.'+copy(s,length(s)-1,2);
  end;
  write(' ':8-length(s),s);
end;
 
Function Chfr(ch:string):string;
begin
write(' ':6-length(ch));
if length(ch)=2 then write('0')else write(' ');
write(copy(ch,1,length(ch)-2),',');
write(copy(ch,length(ch)-1,2));
end;
 
Function FFrs(rl:real):real;
var  i:longint;  s:string;
begin
  write(Fic,'FS ');
  i :=round(rl);
  str(i,s);
  case length(s) of
    1 :  s:=' 0.0'+s;
    2 :  s:=' 0.'+s;
    else s:=copy(s,1,length(s)-2)+'.'+copy(s,length(s)-1,2);
  end;
  writeln(Fic,' ':8-length(s),s);
end;
 
Procedure CursOff;
Begin
  FillChar(Regs,SizeOf(Regs),0);
  With Regs Do
    Begin
    AH:=$01;
    CH:=20;
    CL:=0;
    End;
  Intr($10,Regs);
End;
 
Procedure CursOn;
Begin
  FillChar(Regs,SizeOf(Regs),0);
  With Regs Do
    Begin
    CH:=6;
    CL:=7;
    AH:=$01;
    End;
  Intr($10,Regs);
End;
 
procedure mot_de_passe;
begin
  ch := ' ';
  gotoxy(15,19);
  writeln('Veuillez taper le mot de passe ( ESC pour terminer )');
  writeln;
  mot_p := '';
  gotoxy(37,21);
  ch:=upcase(readkey);
  if ch <> #27 then
  repeat
    mot_p := mot_p + ch;write('.');
    gotoxy(37,21);
    for n:= 1 to 4 do
    begin
      gotoxy(37+2*n,21);
      ch:=upcase(readkey);
      mot_p := mot_p + ch;write('.');
    end;
    if mot_p <> pw then
    begin
      write(#7); write('.'); gotoxy(37,21);clreol;
      mot_p := '';
      ch := upcase(readkey);
    end;
  until mot_p = pw
  else
  begin
    curson;
    clrscr; writeln; writeln;
    write('Avec le bonjour de Jean-Daniel Greub !');
    writeln; writeln;
  end;
  gotoxy(37,21);clreol;
end;
 
procedure saisir_nom_fichier;
{seuls noms de fichiers admis: DATES DU TYPE JJMMAA}
begin
  ch := ' ';
  while ch <> 'O' do
    begin
    nom_f:='';
    gotoxy(57,19);write('      ');gotoxy(57,19);
    repeat ch:=readkey until ch in ['0'..'3'];
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch in ['0'..'9'];
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch in ['0'..'1'];
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch in ['0'..'9'];
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch = '9';
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch in ['5'..'9'];
    write(ch); nom_f:=nom_f + ch;
    gotoxy(15,21);write('Cette date est-elle correcte  ( O / N )  ? ');
    repeat ch :=upcase(readkey) until ch in['O','N']; writeln(ch);
    gotoxy(14,21);clreol;
    end;
  clrscr;
end;
 
procedure ouvrir_fichier;
var i     : integer;
    ch    : char;
begin
  gotoxy (15,19);clreol; curson;
  write('Veuillez taper la date au format JJMMAA  [      ]');
  textcolor(col15);
  saisir_nom_fichier; cursoff;
  assign(fic,nom_f);
  {$I-}
    reset(fic);
    i := ioresult;
  {$I+}
  if i<>0 then rewrite(fic);
  gotoxy(1,24);clreol;
  gotoxy(76,23);
end;
 
Procedure lire_fichier_donnees;
(***
Cette procÂdure commence par lire les donnÂes du fichier < CAFET.LST >
qui fichier DOIT Âtre constituÂ de 40 groupes de 3 ÂlÂments :
LIGNE 1  : dÂsignation (doit contenir 16 caractÂres ou espaces)
LIGNE 2  : prix en centimes (min = 0), suivi immÂdiatement d'un <return>
LIGNE 3  : bÂnÂfice en centimes (min = 0), suivi immÂdiatement d'un <return>
***)
begin
clrscr;
  no := 1;
  Assign(Fic, 'cafet.lst');  { Standard output }
  Reset(Fic);
  des := ' ';
  for n:= 1 to max do
  begin
    Readln(Fic,des); ch1[no] := des;
    Readln(Fic,des); ch2[no] := des;
    Readln(Fic,des); ch3[no] := des;
    inc(no);
  end;
  Close(Fic);
end;
 
procedure titre;
begin
cursoff;
ch:=' ';
textcolor(col14);
textbackground(col1);
clrscr;
gotoxy(28,05);writeln('COLLEGE  DE  LA  FLORENCE');
gotoxy(32,07);writeln('Jean-Daniel Greub');
gotoxy(14,09);write(#218);for n:=1 to 51 do write(#196);writeln(#191);
gotoxy(14,10);write(#179);for n:=1 to 51 do write(#032);writeln(#179);
gotoxy(14,11);writeln(#179,'    ĂĂĂĂĂĂÂą  ĂĂĂĂĂĂÂą  ĂĂĂĂĂĂÂą  ĂĂĂĂĂĂÂą  ĂĂĂĂĂĂÂą    ',#179);
gotoxy(14,12);writeln(#179,'    ĂĂÂą      ĂĂÂą ĂĂÂą  ĂĂÂą      ĂĂÂą        ĂĂÂą      ',#179);
gotoxy(14,13);writeln(#179,'    ĂĂÂą      ĂĂĂĂĂĂÂą  ĂĂĂĂÂą    ĂĂĂĂÂą      ĂĂÂą      ',#179);
gotoxy(14,14);writeln(#179,'    ĂĂÂą      ĂĂÂą ĂĂÂą  ĂĂÂą      ĂĂÂą        ĂĂÂą      ',#179);
gotoxy(14,15);writeln(#179,'    ĂĂĂĂĂĂÂą  ĂĂÂą ĂĂÂą  ĂĂÂą      ĂĂĂĂĂĂÂą    ĂĂÂą      ',#179);
gotoxy(14,16);write(#179);for n:=1 to 51 do write(#032);writeln(#179);
gotoxy(14,17);write(#192);for n:=1 to 51 do write(#196);writeln(#217);
gotoxy(31,19);textcolor(col14);
pw := #84+#69+#70+#65+#67;
end;
 
procedure enregistrer;
{sauvegarde des donnÂes sur disque dans un fichier ayant une date pour titre}
begin
  Assign(Fic,nom_f);
  Rewrite(Fic);
  Writeln(Fic,'------------------------------');
  Writeln(Fic,'Date du jour     : ',nom_f);
  Writeln(Fic,'------------------------------');
  Write(Fic,'Total des ventes : '); FFrs(Total);
  Write(Fic,'BÂnÂfice total   : '); FFrs(Benef);
  Writeln(Fic,'------------------------------');
  num := 1;
  for n := 1 to 40 do
  begin
    if nbr[trunc(num)] > 0 then
    Writeln(Fic,ch1[trunc(num)],'  ',nbr[trunc(num)]:3:0);
    num := num + 1;
  end;
  Writeln(Fic,'------------------------------');
  Close(Fic);
  clrscr;
  gotoxy(01,4);
  for n:=1 to 79 do write('-');
  gotoxy(01,6);
  writeln('Le nom du fichier de sauvegarde est < ',nom_f,' >');
  writeln('                                      ------');
  writeln;
  writeln('Il peut Âtre aisÂment visualisÂ en tapant < L > pour L.COM');
  writeln;
  for n:=1 to 79 do write('-');
  gotoxy(01,13); writeln ('avec le bonjour de Jean-Daniel Greub !');
  textcolor(col15);textbackground(col1);
end;
 
procedure recap;
begin
 
  { ENTREE DES NOMS DES n FICHIERS }
  curson;
  n:=1; clrscr; gotoxy(1,2);
  writeln('RÂcapitulation des rÂsultats de plusieurs journÂes');
  writeln('--------------------------------------------------');
  write('Taper  0000  pour terminer !            ');
  writeln('AnnÂe 19',copy(nom_f,5,2));
  while jjmm <> '0000' do
  begin
    writeln;
    write('Taper sous la forme JJMM la date du ');
    write ('fichier numÂro ',n,'   [    ]');
    gotoxy(57,wherey);
    jjmm := '';
    repeat ch:=readkey until ch in ['0'..'3']; write(ch);jjmm := jjmm + ch;
    repeat ch:=readkey until ch in ['0'..'9']; write(ch);jjmm := jjmm + ch;
    repeat ch:=readkey until ch in ['0'..'1']; write(ch);jjmm := jjmm + ch;
    repeat ch:=readkey until ch in ['0'..'9']; write(ch);jjmm := jjmm + ch;
    fich[n] := jjmm + copy(nom_f,5,2);
    assign(fic,fich[n]);
    {$I-}
    reset(fic);
    i := ioresult;
    {$I+}
    if i<>0 then rewrite(fic);
    if i=2 then begin gotoxy(63,wherey); write(' N''EXISTE PAS !'); end;
    if i= 0 then
      begin
        if eof(fic) = true then
          begin
            gotoxy(63,wherey); write(' FICHIER VIDE !');
          end;
        inc(n);
      end;
    close(fic);
  end;
 
 
  gotoxy(01,5+n);clreol;writeln;
  clrscr;
  totsem := 0; bensem := 0;
  writeln('RÂcapitulation des rÂsultats de la semaine');
  writeln('------------------------------------------'); writeln;
  writeln('Date         Total    BÂnÂfice'); writeln;
 
 
  { LECTURE LIGNE PAR LIGNE DES NOMS DES n FICHIERS }
  for n := 1 to n - 1 do
  begin
    assign(fic,fich[n]);
    {$I-}
    reset(fic);
    i := ioresult;
    {$I+}
    strn := '';
    Readln(Fic,strn);                                           {LIGNE 1}
    Readln(Fic,strn);                                           {LIGNE 2}
    datjour[n]:=copy(strn,length(strn)-5,6);                    {LIGNE 3}
    Readln(Fic,strn);                                           {LIGNE 4}
    Readln(Fic,strn);                                           {LIGNE 5}
    totjour[n]:=copy(strn,length(strn)-7,5) + copy(strn,length(strn)-1,2);
    { writeln; writeln(totjour[n]) }
    Readln(Fic,strn);                                           {LIGNE 7}
    benjour[n]:=copy(strn,length(strn)-7,5) + copy(strn,length(strn)-1,2);
    val(totjour[n],totj[n],code); totj[n] := totj[n]/100;
    val(benjour[n],benj[n],code); benj[n] := benj[n]/100;
    gotoxy (01,wherey); write(datjour[n]);
    gotoxy (12,wherey); write(totj[n]:8:2);
    gotoxy (24,wherey); write(benj[n]:7:2); writeln;
    totsem := totsem + totj[n];
    bensem := bensem + benj[n];
  close(Fic);
  end;
  writeln('------------------------------');
  gotoxy (12,wherey); write(totsem:8:2);
  gotoxy (24,wherey); write(bensem:7:2); writeln;
  curson;
  writeln; writeln;
  write('Avec le bonjour de Jean-Daniel Greub !');
  writeln; writeln;
end;
 
procedure lire_nombre;
begin
strn := '';
ch := ' ';
while ch <> #13 do
  begin
    repeat ch:= readkey until ch in ['0'..'9',#13];
    if ch <> #13 then begin write(ch); strn:=strn + ch; end;
  end;
val(strn,n, Code);
{les caractÂres numÂriques de la chaÂne passe dans l'integer n}
end;
 
procedure saisie;
begin
fl := 0; cursoff; clrscr;
 
{ affichage des articles Â choisir }
textcolor(col15); textbackground(col1); clrscr; no := 1; lig:=1;
repeat
  gotoxy(01,lig); write(ch1[no]); inc(no);
  gotoxy(21,lig); write(ch1[no]); inc(no);
  gotoxy(41,lig); write(ch1[no]); inc(no);
  gotoxy(61,lig); write(ch1[no]); inc(no);
  lig := lig + 2;
until no > max;
gotoxy(01,22);
writeln('Utiliser les flÂches pour choisir puis presser < RETURN >');
GOTOXY(01,24);
writeln('Presser la touche < ESC > quand tout est saisi');
 
{*********************************************************************}
 
{SAISIES MULTIPLES, SORITE AVEC <ESC>}
 
no := 1; col := 01; lig := 01; gotoxy(col,lig);
t1:=' ';t2:=' ';
while t1 <> #27 do
begin
  repeat t1:=readkey until t1 in [#0,#13,#27];
  if ord(t1)= 0 then
  begin
    t2 := readkey;
    textcolor(col15); textbackground(col1); writeln(ch1[trunc(num)]);
    if ord(t2)=72 then fl:=1; if ord(t2)=75 then fl:=1;
    if ord(t2)=77 then fl:=1; if ord(t2)=80 then fl:=1;
    if (ord(t2)=72) and (lig > 01) then lig := lig - 02;
    if (ord(t2)=75) and (col > 01) then col := col - 20;
    if (ord(t2)=77) and (col < 60) then col := col + 20;
    if (ord(t2)=80) and (lig < 19) then lig := lig + 02;
    num := (col + 19) / 20 + (lig-1) * 2; gotoxy(col, lig);
    x := wherex; y := wherey;
    textcolor(col1); textbackground(col15); writeln(ch1[trunc(num)]);
    gotoxy(01,23);clreol;{write('col ',col,'  lig ',lig,'  num ',num:3:0);}
    gotoxy(x,y);
  end else
  if (ord(t1)=13) and (fl = 1) then
  begin
    des := ch1[trunc(num)]; n := 0; gotoxy(01,22); clreol;
    writeln('Taper le nombre d''articles, puis presser < RETURN >');
    gotoxy(1,23); clreol;
    curson; write('Nb de < ',des,'>  ');
    lire_nombre; cursoff;
    gotoxy(1,23); clreol; gotoxy(01,22); clreol;
    writeln('Utiliser les flÂches pour choisir puis presser < RETURN >');
    nbr[trunc(num)] := n;
  end;
end;
clrscr; total := 0; benef := 0;
for n:=1 to 79 do write('-'); writeln;
 
{affichage des valeurs venant d'Âtre saisies}
textcolor(col15); textbackground(col1); clrscr;
num := 1;          {real}
lig := 1;
for n := 1 to 40 do
begin
  if (nbr[trunc(num)] > 0) and (ch2[trunc(num)] <> '0') then
  begin
    write(nbr[trunc(num)]:3:0,' ',ch1[trunc(num)],' Â ');
    chfr(ch2[trunc(num)]);
    val(ch2[trunc(num)], Tot, Code); gotoxy(34,wherey);
    write (' Prix total : '); Frs(Tot * nbr[trunc(num)]);
    val(ch3[trunc(num)], Ben, Code); gotoxy(60,wherey);
    write ('BÂnÂfice : ');   Frs(Ben * nbr[trunc(num)]);
    writeln;
    Total := Total + Tot * nbr[trunc(num)];
    Benef := Benef + Ben * nbr[trunc(num)];
    inc(lig);
  end;
  num := num + 1;
  IF lig = 21 THEN
  BEGIN
  WRITELN; WRITE('Presser une touche pour continuer !');
  READKEY; WRITELN; WRITELN;
  END;
end;
 
for n:=1 to 79 do write('-'); writeln;
gotoxy(01,wherey); write('DATE  : ',nom_f);
gotoxy(35,wherey); write('TOTAL      : '); Frs(Total);
gotoxy(60,wherey); write('BENEFICE : ');   Frs(Benef);
writeln;
ch := ' ';
curson;
writeln;
write('Les donnÂes ci-dessus sont-elles correctes (O / N) ? ');
ch := upcase(readkey);
if upcase(ch) = 'O' then
begin write (ch);enregistrer;end
else begin write (ch);saisie;end;
end;
 
procedure choix;
begin
clrscr;
gotoxy(16,09);write('Voulez-vous...');
gotoxy(16,12);write('1. EnrÂgistrer les rÂsultats d''une journÂe ?');
gotoxy(16,14);write('2. RÂcapituler les rÂsultats de plusieurs journÂes ?');
gotoxy(16,18);write('Taper  1  ou  2');
repeat ch:=readkey until ch in ['1'..'2'];
if ch = '1' then saisie;
if ch = '2' then recap;
end;
 
procedure choix_ecran;
begin
 
col0 := 0;
col1 := 0;
col14:= 2;
col15:= 3;
 
{0, 1, 14, 15 pour Âcran VGA 16 couleurs }
{0, 0,  2,  3 pour Âcran CGA monochrome  }
 
{ en VGA 16 couleurs text=14 back=1  ... jaune sur fond bleu  }
{ en VGA 16 couleurs text=15 back=0  ... blanc sur fond noir  }
{ en VGA 16 couleurs text=0  back=15 ... noir  sur fond blanc }
 
end;
 
begin
choix_ecran;
lire_fichier_donnees;
titre;
mot_de_passe;
  if ch <> #27 then
  begin
    ouvrir_fichier;
    choix;
    curson;
  end;
end.
Allow to command different things (pizza, bevarages) in a school cafeteria (open at lunch time) using uniquely the arrows of the keyboard and make the total to pay automatically

Navigační menu

Osobní nástroje

Hledat

Pascal programy

Pascal Wiki

Bonus

Kontakty

V jiných jazycích
