Algoritmos y Estructura de datos - TP 2

program tp2;
{Comisión 02 - Agustín Gómez}
uses CRT;

type
    codigobarra = array[1..8] of integer;
    codempre = array[1..3] of integer;
    imp = array[1..8] of integer;
    {Arreglos del QR}
    qr=array[1..4] of integer;

const
     r = 'aprobame'; {Clave}
     izqsup = 201; {Constantes para el menú de opciones}
     izqinf = 200;
     dersup = 187;
     derinf = 188;
     fila = 205;
     columna = 186;
     cuad = 254;   {Constantes para el QR}
     rec = 219;

var ch,op,x: char;
    contra: string[8];
    codigo:codigobarra;
    codempresa:codempre;
    codiqr:qr;
    importe:imp;
    I,J,aux,cont,auxp,pospar,posimp:integer;



{--------------Contrasegna-------------}
procedure encriptaclave;
BEGIN
  cont:= 0;
  ClrScr;
  Gotoxy(43,7);
  Textcolor(14);
  writeln('INGRESE UNA CLAVE DE 8 CARACTERES');
  writeln();
  Repeat
  textcolor(15);
  ch:= readkey;
  While (ch<>#13) do
  Begin
   contra:=contra + ch;
   write('*');
   ch:=readkey
  End;
  If (contra = r) then
   begin
    ClrScr;
    Gotoxy(5,3);
    Textcolor(10);
    writeln('>CLAVE CORRECTA');
   end
  Else
   begin
     ClrScr;
     Gotoxy(5,3);
     Textcolor(12);
     writeln('>CLAVE INCORRECTA, INTENTE OTRA VEZ');
     writeln();
     textcolor(15);
     cont:= cont+1;
     contra:='';
   end;
  Until (contra = r) or (cont=3);
readkey;
ClrScr;
End;



{--------------Codigo de barra----------------}
procedure barra;
begin
     ClrScr;
     Textcolor(15);
     Repeat
     writeln('Ingrese el codigo de la empresa digito por digito, para salir ingrese x');
     for i:= 1 to 3 do
     readln(codempresa[i]);
     Until (codempresa[i] >= 0) and (codempresa[i] <= 9);
     while x <> 'x' do
     begin
           Textcolor(15);
           Repeat
           writeln('Ingrese importe digito por digito, para salir ingrese x');
           for i:= 4 to 7 do
           readln(importe[i]);
           Until (importe[i] >= 0) and (importe[i] <= 9);


           {Asignación}
           for i:= 1 to 8 do
           codigo[i]:= 0;
           for i:= 1 to 3 do
           codigo[i]:= codempresa[i];
           for i:= 4 to 7 do
           codigo[i]:= importe[i];


           {---------Suma de pares--------}
           auxp := 0;
           pospar := 0;
           while(auxp <= 6) do
           begin
           auxp := auxp + 2;
           pospar := pospar + codigo[auxp];
           end;

           {---------------Suma de impares------------}
           auxp := 1;
           posimp := 0;
           while(auxp <= 7) do
           begin
           auxp := auxp + 2;
           posimp := posimp + codigo[auxp];
           end;

           {Verificador}
           codigo[8]:= (abs(pospar - posimp)mod 10);

           textcolor(13);
           for I := 1 to 8 do
           begin
           auxp := codigo[I];
                case auxp of
                0:write('****');
                1:write('***|');
                2:write('**|*');
                3:write('**||');
                4:write('*|**');
                5:write('*|*|');
                6:write('*||*');
                7:write('*|||');
                8:write('|***');
                9:write('|**|');
                end;

           end;
           writeln();
     end;
ClrScr;
end;


{---------------------Codigo QR-----------------------}
procedure binario;
begin
for I:= 1 to 4 do
begin
aux := codiqr[I];
case aux of
0:write('**|| ****');
1:write('**|| ***|');
2:write('**|| **|*');
3:write('**|| **||');
4:write('**|| *|**');
5:write('**|| *|*|');
6:write('**|| *||*');
7:write('**|| *|||');
8:write('**|| |***');
9:write('**|| |**|');
end;
end;
end;

procedure dibuja1;
begin
for I := 1 to 8 do
begin
gotoxy(I,1);
textcolor(9);
write(chr(cuad));
gotoxy(I,8);
write(chr(cuad));
gotoxy(I,14);
write(chr(cuad));
gotoxy(I,21);
write(chr(cuad));
end;
for I := 14 to 21 do
begin
gotoxy(I,1);
write(chr(cuad));
gotoxy(I,8);
write(chr(cuad));
end;
for I := 9 to 13 do
begin
gotoxy(I,7);
write(chr(cuad));
end;
end;

procedure dibuja2;
begin
for J := 1 to 8 do
begin
gotoxy(1,J);
textcolor(9);
write(chr(rec));
gotoxy(8,J);
write(chr(rec));
gotoxy(14,J);
write(chr(rec));
gotoxy(21,J);
write(chr(rec));
end;
for J := 14 to 21 do
begin
gotoxy(1,J);
write(chr(rec));
gotoxy(8,J);
write(chr(rec));
end;
for J := 8 to 14 do
begin
gotoxy(7,J);
write(chr(rec));
end;
end;

procedure partevar;
begin
Writeln('Ingrese cuatro numeros del 0 al 9');
writeln();
For I := 1 to 4 do
begin
writeln('Ingrese digito por digito');
readln(codiqr[I]);
binario;
end;
end;

procedure grafico;
begin
for I := 18 to 21 do
begin
textcolor(4);
gotoxy(I,10);
end;
end;

procedure qrcod;
begin
ClrScr;
partevar;
ClrScr;
grafico;
dibuja1;
dibuja2;
readkey
end;




{--------------Menu de opciones---------------}
procedure menulindo;
begin
gotoxy(9,3);
write(chr(izqsup));
gotoxy(9,8);
write(chr(izqinf));
gotoxy(50,3);
write(chr(dersup));
gotoxy(50,8);
write(chr(derinf));
end;

procedure menux;
begin
for I := 10 to 49 do
begin
gotoxy(I,3);
write(chr(fila));
gotoxy(I,8);
write(chr(fila));
end;
end;

procedure menuy;
begin
for I := 4 to 7 do
begin
gotoxy(9,I);
write(chr(columna));
gotoxy(50,I);
write(chr(columna));
end;
end;

procedure casos;
begin
Repeat
textbackground(0);
gotoxy(10,4);
textcolor(11);
writeln('Pulse 1 para introducir una clave');
gotoxy(10,5);
writeln('Pulse 2 para generar un codigo de barras');
gotoxy(10,6);
writeln('Pulse 3 para generar un QR');
gotoxy(10,7);
writeln('Pulse 4 para salir');
writeln();
writeln();
readln(op);
Until (op >= '1') and (op <= '4');
case op of
'1':encriptaclave;
'2':barra;
'3':qrcod;
'4':exit;
end;


Begin
ClrScr;
textcolor(4);
menulindo;
menux;
menuy;
While (#13 <> op) do
begin
gotoxy(10,4);
textcolor(11);
write('Bienvenido al menu de opciones');
gotoxy(10,6);
writeln('Pulse enter para continuar');
writeln();
writeln();
readln(op);
ClrScr;
end;
textcolor(4);
menulindo;
menux;
menuy;
casos;
end;
End;

begin
textcolor(4);
menulindo;
menux;
menuy;
While (#13 <> op) do
begin
gotoxy(10,4);
textcolor(11);
write('Bienvenido al menu de opciones');
gotoxy(10,6);
writeln('Pulse enter para continuar');
writeln();
writeln();
readln(op);
end;
casos;
readkey
end.