array de registro de comerciio

program ArrayComercio;


uses
  crt;
const
    max = 5; // cantidad maxima de productos
type
    // tipo de registro para cada producto
    Rproducto = record
    cod : integer; // codigo del producto
      nom : string[20]; // nombre
      prov :string[30]; // proveedor
      prec : real; // precio
   end;
   // tipo de  array de registro
   Tarray = array[1..max] of Rproducto;

procedure listado(reg:Tarray;len:integer;pos:integer);
var  i : integer;
begin
    i := pos;
   clrscr;
    while (i <= len) do begin
            write('Codigo de producto: ');
         writeln(reg[i].cod);
         write('Nombre:  ');
         writeln(reg[i].nom);
         write('Proveedor:  ');
         writeln(reg[i].prov);
         write('Precio:  $ ');
         writeln(reg[i].prec:4:2);
         i := i + 1;
    end;
end;

procedure ordenarXprecio(var reg:Tarray;len:integer);
// ordenamiento burbuja por campo precio
var ordenado : boolean;
var aux:Rproducto;i:integer;
begin
    ordenado := false;
    while (not ordenado) do begin
           ordenado:= true;
            for i := 1 to (len-1) do begin
                if (reg[i].prec > reg[i].prec) then
               begin
                   aux := reg[i+1];
                   reg[i+1] := reg[i];
                   reg[i] := aux;
                   ordenado := false;
               end;
         end;
    end;
    writeln('Listado por precio Ascendente: ');
    listado(reg,len,1);
end;

procedure ordenarXprov(var reg:Tarray;len:integer);
// ordenamiento burbuja por campo proveedor
var ordenado : boolean;
var aux:Rproducto;i:integer;
begin
    ordenado := false;
    while (not ordenado) do begin
           ordenado:= true;
            for i := 1 to (len-1) do begin
                if (reg[i].prov > reg[i].prov) then
               begin
                   aux := reg[i+1];
                   reg[i+1] := reg[i];
                   reg[i] := aux;
                   ordenado := false;
               end;
         end;
    end;
    writeln('Listado por orden alfabetico de proveedor ');
    listado(reg,len,1);
end;

procedure ordenarXnom(var reg:Tarray;len:integer);
// ordenamiento burbuja por campo nombre
var ordenado : boolean;
var aux:Rproducto;i:integer;
begin
    ordenado := false;
    while (not ordenado) do begin
           ordenado:= true;
            for i := 1 to (len-1) do begin
                if (reg[i].nom > reg[i].nom) then
               begin
                   aux := reg[i+1];
                   reg[i+1] := reg[i];
                   reg[i] := aux;
                   ordenado := false;
               end;
         end;
    end;
end;

function busquedabinaria(reg:Tarray;len:integer;nom:string):integer;
// busqueda binaria adaptada para buscar producto por nombre
var i,j,k : integer;
var encontrado : boolean;
begin
    encontrado:= false;
    i := 1;
    j := len;
    while (i <= j) and (not encontrado) do begin
            k := (i+j) div 2;
         if (reg[k].nom = nom) then begin
            encontrado:= true;
         end else begin
            if (reg[k].nom > nom) then begin
                i := k + 1;
            end  else begin
                j := k - 1;
            end;
         end;
    end;
    if (i > j) then begin
            busquedaBinaria := -1;
    end else begin
            busquedaBinaria := k;
    end;
end;

procedure buscar(reg:Tarray;len:integer);
// procedimiento de busqueda de producto por nombre
var pos:integer;nombre:string;
begin
    clrscr;
    writeln('Busqueda de producto por nombre');
    write('Nombre del producto: ');
    readln(nombre);
    pos := busquedaBinaria(reg,len,nombre);
     if (pos < 0) then begin
            writeln('El producto no se encuentra');
         exit;
    end else begin
         listado(reg,len,pos);
    end;
    writeln('La busqueda ha finalizado');
    writeln('Presione una tecla');
    readkey();
end;

function busquedaSecuencial(reg:Tarray;len:integer;num:integer):integer;
var  i : integer;
begin
    i := 1;
    while (i <= len) and (reg[i].cod <> num) do begin
            i := i + 1;
    end;
    if (i > len) then
            busquedaSecuencial := -1
    else
            busquedaSecuencial := i;
end;

procedure insertar(var reg:Tarray;var len:integer);
var
    opc : char;i : integer; cod,pos:integer;
begin
    opc := 'S';
     if (len = 0) then
        i := 1
    else
        i := len;
      writeln('Insertar nuevos productos');
    while (opc = 'S') and (i <= max) do
    begin
        clrscr;
        write('Codigo de producto: ');
        readln(cod);
        pos := busquedaSecuencial(reg,len,cod);
        if (pos > 0) then
                writeln('El producto ya existe')
        else begin
              reg[i].cod := cod;
              write('Nombre: ');
              readln(reg[i].nom);
              write('Proveedor: ');
              readln(reg[i].prov);
              write('Precio: ');
              readln(reg[i].prec);
              writeln;
              len := len + 1;
              i := i + 1;
        end;
        repeat
                writeln('Desea agregar otro producto (S/N): ');
           opc := readkey;
            opc := upcase(opc);
        until (opc in ['S','N']);

    end;
end;

procedure menu(reg:Tarray;len:integer);
var fin : boolean; opc : char;
begin
     fin := false;
    repeat
            clrscr;
         writeln('************MENU GENERAL*************');
         writeln('Insertar Productos................[1]');
         writeln('Orden Ascendente por precio.......[2]');
         writeln('Orden Alafabetico por proveedor...[3]');
         writeln('Orden Alfabetico por nombre.......[4]');
         writeln('Buscar un producto................[5]');
         writeln('Salir.............................[6]');
         repeat
            writeln('Escoja una opcion:  ');
            opc := readkey;
         until (opc in ['1'..'6']);
         case opc of
         '1' : insertar(reg,len);
         '2' : ordenarXprecio(reg,len);
         '3' : ordenarXprov(reg,len);
         '4' : begin
               ordenarXnom(reg,len);
               listado(reg,len,1);
               end;
          '5' : buscar(reg,len);
         '6' : fin := true;
         end;
    until fin;
end;

// programa principal
var
    productos : Tarray;
   len:integer;
begin
      clrscr;
      len := 0;
      menu(productos,len);
end.