parcial

program parcial2017;
uses crt;
//van los registros , los vectores matrices,
type
  cadena=String[50];

  Fecha=record
     dia:integer;
     mes:integer;
     anio:integer
  end;

  Producto=record
     codigo:integer;
     descripcion:cadena;
     tipo:char;
     precio:real
  end;

  tvProductos=array[1..100] of Producto;  //es el vector


//declaran las var del algoritmo principal
var
  opc,n:integer;
  resp:char;
  v:tvProductos;




//procedimientos y funciones
procedure menu(var opc:integer); //por referencia cambia .. var
begin
     writeln('1-cargar las ventas de los productos');
     writeln('2-mostrar productos de un tipo, ordenado x descrip. y importe total');
     writeln('3-agregar una venta');
     writeln('4-buscar producto por descripcion');
     writeln('5-mostrar todo el vector');

     writeln('ingrese una opcion: ');
     readln(opc);

end;

function buscarXCodigo(v:tvProductos;n:integer; codigo: integer): integer;
var
  pos,i:integer;

begin
     pos:=0;
     for i:=1 to n do
     begin
          if(v[i].codigo = codigo) then
          begin
               pos:=i;
          end;
     end;

     buscarXCodigo:=pos;
end;


procedure cargarUnProducto(var e:Producto );
var
  codigoBus,posBus:integer;
begin
     writeln('*********************');
     writeln('ingrese un codigo:');
     readln(codigoBus);
     posBus:=buscarXCodigo(v,n,codigoBus);
     while(posBus<>0)do
     begin
            writeln('codigo repetido........');
            writeln('ingrese otro codigo:');
            readln(codigoBus);
            posBus:=buscarXCodigo(v,n,codigoBus);
     end;


     e.codigo:=codigoBus;//el codigo que me ingreso el usuario
     WriteLn('ingrese descripcion:');
     readln(e.descripcion);
     WriteLn('ingrese el tipo:');
     readln(e.tipo);
     WriteLn('ingrese precio:');
     readln(e.precio);
end;



procedure mostrarUnProducto( e:Producto);
begin
     writeln('*********************');
     writeln('codigo= ', e.codigo);
     writeln('descripcion=', e.descripcion);
     writeln('tipo=', e.tipo);
     writeln('precio=', e.precio:4:2);

end;

procedure cargarVectorDeProductos(var v:tvProductos;var N:integer);
var
  i:integer;
begin
     writeln('Ing la cantidad de Producto N: ');
     readln(N);
     for i:=1 to N do
     begin
          cargarUnProducto(v[i]);
     end;
end;

procedure mostrarVectorDeProductos( v:tvProductos; N:integer);
var
  i:integer;
begin
     for i:=1 to N do
     begin
          mostrarUnProducto(v[i]);
     end;
end;




Procedure Swap(Var x, y : Producto);
Var
  //este es le procedimiento de intercambio intercambio 2 registro personas
   aux: Producto;
Begin
  aux:= x;
  x:= y;
  y:= aux;
End;


(*-------------------------- S H E L L S O R T(METODO SHELL) CRECIENTE ---------------------*)
Procedure ShellSortCreciente(Var X : tvProductos; N: Integer);
          Var
             Done: Boolean;
             Jump,I,J: Integer;
          Begin
               Jump := N;
               While (Jump > 1) Do
                     Begin
                          Jump := Jump Div 2;
                          Repeat
                                Done := true;
                                For J := 1 To (N - Jump) Do
                                    Begin
                                         I := J + Jump;
                                 //AGREGAR LOS CAMPOS DEL REGISTRO QUE SE QUIERE ORDENAR < creciente
                                         If (X[J].descripcion > X[I].descripcion) Then //<---aqui elijo el campo a ordenar
                                            Begin
                                                 Swap(X[J], X[I]);
                                                 Done := false
                                            End;
                                    End;
                          Until Done;
                     End;
                mostrarVectorDeProductos(X,N); //mostramos el vector completo

          End;


(*-------------------------- S H E L L S O R T(METODO SHELL) DECRECIENTE ---------------------*)
Procedure ShellSortDecreciente(Var X : tvProductos; N: Integer);
          Var
             Done: Boolean;
             Jump,I,J: Integer;
          Begin
               Jump := N;
               While (Jump > 1) Do
                     Begin
                          Jump := Jump Div 2;
                          Repeat
                                Done := true;
                                For J := 1 To (N - Jump) Do
                                    Begin
                                         I := J + Jump;
                                 //AGREGAR LOS CAMPOS DEL REGISTRO QUE SE QUIERE ORDENAR > decreciente
                                         If (X[J].descripcion < X[I].descripcion) Then //<---aqui elijo el campo a ordenar
                                            Begin
                                                 Swap(X[J], X[I]);
                                                 Done := false
                                            End;
                                    End;
                          Until Done;
                     End;
                mostrarVectorDeProductos(X,N); //mostramos el vector completo

          End;


procedure agregar(var v:tvProductos;var n:integer;elemento:Producto);
begin
  v[n]:=elemento;
  n:=n+1;
end;

procedure mostarProdOrdenadoXDescripcion(v:tvProductos;n:integer);
var
   n2,i:integer;
   v2:tvProductos;
   suma:real;
   tipo:char;
begin
  n2:=1;
  suma:=0;
  writeln('ingrese un tipo de producto');
  readln(tipo);

  for i:=1 to n do
  begin
    if(v[i].tipo = tipo)then
    begin
        agregar(v2,n2,v[i]);
        suma:=suma+v[i].precio;
    end;
  end;
  writeln('*******************');
  ShellSortCreciente(v2,n2);
  writeln('*******************');
  writeln('el acumulado es: ', suma:4:2);
  writeln('*******************');
end;

procedure agregarProducto(var v:tvProductos ;var n:integer);
var
   codigoBus,posBus,pos,i:integer;
begin
     writeln('*********************');
     writeln('ingrese un codigo:');
     readln(codigoBus);
     posBus:=buscarXCodigo(v,n,codigoBus);
     while(posBus<>0)do
     begin
            writeln('codigo repetido........');
            writeln('ingrese otro codigo:');
            readln(codigoBus);
            posBus:=buscarXCodigo(v,n,codigoBus);
     end;
     n:=n+1;
     v[n].codigo:=codigoBus;//el codigo que me ingreso el usuario
     WriteLn('ingrese descripcion:');
     readln(v[n].descripcion);
     writeln('ingrese el tipo: ');
     readln(v[n].tipo);
     WriteLn('ingrese precio:');
     readln(v[n].precio);

end;


procedure buscarXDescripcion(v:tvProductos;n:integer);
var
  i,res:integer;
  descripcion:cadena;

begin
      writeln('ingrese la descripcion a buscar ');
      readln(descripcion);

     for i:=1 to n do
     begin
          res:=Pos(descripcion,v[i].descripcion);
          if (res<>0) then
          begin
              mostrarUnProducto(v[i]);
          end;
     end;
end;






//el principal
begin
     repeat
          ClrScr;//limpio la pantalla
           menu(opc);
           case opc of
                1:cargarVectorDeProductos(v,n);
                2:mostarProdOrdenadoXDescripcion(v,n);
                3:agregarProducto(v,n);
                4:buscarXDescripcion(v,n);
                5:mostrarVectorDeProductos(v,n);

           end;

          writeln('DESEA CONTINUAR S/N: ');   //la repeticion es apedido del operador
          readln(resp);

     until (resp='N')or(resp='n');
     readKey;         //hace una pausa a la ejecucion y tiene que estar..

end.