registro de comercio

program comercio;

uses
    crt;

const
    max = 10000;

type
   // tipo de registro de producto
   Rproducto = record
    Nro : integer;
        Producto: string[20];
    Marca : string[20];
    Tipo : string[10];
    Costo : real;
    Stockmin : integer;
    Stockact : integer;
   end;
   // tipo de array de registro
   Tarray = array[1..max] of Rproducto;

procedure insertar(var reg:Tarray;var len:integer);
var
    opc : char;i : 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('Numero de producto: ');
        readln(reg[i].Nro);
        write('Producto: ');
        readln(reg[i].Producto);
        write('Marca: ');
        readln(reg[i].Marca);
        write('Tipo: ');
        readln(reg[i].Tipo);
        write('Costo: ');
        readln(reg[i].Costo);
        write('Stock minimo: ');
        readln(reg[i].Stockmin);
        write('Stock Actual: ');
        readln(reg[i].Stockact);
        writeln;
        len := len + 1;
        repeat
                writeln('Desea agregar otro producto (S/N): ');
           opc := readkey;
            opc := upcase(opc);
        until (opc in ['S','N']);
        i := i + 1;
    end;
end;

procedure ordenar(var reg:Tarray;len:integer);
var ordenado:boolean; j : integer;
var aux : Rproducto;
begin
    ordenado := false;
    while (not ordenado)  do begin
            ordenado := true;
         for j := 1 to (len-1) do begin
            if (reg[j].Nro > reg[j+1].Nro) then begin
                aux := reg[j+1];
               reg[j+1] := reg[j];
               reg[j] := aux;
               ordenado := false;
            end;
         end;
    end;
end;

function busquedabinaria(reg:Tarray;len:integer;x:integer):integer;
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].Nro = x) then begin
            encontrado:= true;
         end else begin
            if (reg[k].Nro > x) 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 Busqueda(reg:Tarray;len:integer);
var  num,pos : integer;
begin
    clrscr;
    writeln('Busqueda de productos');
    write('Ingrese numero de producto: ');
    readln(num);
    pos := busquedaBinaria(reg,len,num);
    if (pos < 0) then begin
            writeln('El producto no existe');
         exit;
    end else begin
        write('Numero de producto: ');
        writeln(reg[pos].Nro);
        write('Producto: ');
        writeln(reg[pos].Producto);
        write('Marca: ');
        writeln(reg[pos].Marca);
        write('Tipo: ');
        writeln(reg[pos].Tipo);
        write('Costo: ');
        writeln(reg[pos].Costo);
        write('Stock minimo: ');
        writeln(reg[pos].Stockmin);
        write('Stock Actual: ');
        writeln(reg[pos].Stockact);
    end;
end;

procedure eliminar(var reg:Tarray;pos:integer;var len:integer);
var i : integer;
begin
     for i := pos to (len-1) do begin
            reg[i] := reg[i+1];
     end;
     len := len - 1;
end;

procedure borrar(var reg:Tarray;len:integer);
var num : integer; pos : integer;
    opc : char;
begin
    repeat
    clrscr;
    writeln('Borrar registro de un producto');
    writeln('Ingrese numero de producto: ');
    readln(num);
    pos := busquedaBinaria(reg,len,num);
    if (pos < 0) then begin
            writeln('El producto no se encuentra');
    end else begin
            writeln('Producto: ',reg[pos].Producto);
         writeln('Marca: ',reg[pos].Marca);
    end;
    repeat
            writeln('Esta seguro de borrar el registro (S/N): ');
            opc := readkey;
            opc := upcase(opc);
    until (opc in ['S','N']);
    if (opc = 'S') then begin
            eliminar(reg,pos,len);
    end;
    repeat
        writeln('Desea borrar otro producto (S/N): ');
        opc := readkey;
      opc := upcase(opc);
    until (opc in ['S','N']);
    until (opc = 'N');
end;

procedure modificar(var reg:Tarray;len:integer);
var  Producto,Marca,Tipo : string;opc : char;
var Costo : real; Stockmin,Stockact : integer;
var num,pos:integer;
begin
    repeat
    clrscr;
    writeln('Modificacion de productos');
    writeln('Ingrese el numero de producto: ');
    readln(num);
    pos := busquedaBinaria(reg,len,num);
    if (pos < 0) then begin
            writeln('El producto no existe');
         exit;
    end else begin
        write('Producto: ');
        readln(Producto);
        write('Marca: ');
        readln(Marca);
        write('Tipo: ');
        readln(Tipo);
        write('Costo: ');
        readln(Costo);
        write('Stock minimo: ');
        readln(Stockmin);
        write('Stock Actual: ');
        readln(Stockact);
        reg[pos].Producto := Producto;
        reg[pos].Marca := Marca;
        reg[pos].Tipo := Tipo;
        reg[pos].Costo := Costo;
        reg[pos].Stockmin := Stockmin;
        reg[pos].Stockact := Stockact;
    end;
    writeln('El registro se ha modificado');
    repeat
        writeln('Desea modificar otro producto (S/N): ');
        opc := readkey;
      opc := upcase(opc);
    until (opc in ['S','N']);
    until (opc = 'N');
end;

procedure menu(reg:Tarray;len:integer);
var  fin:boolean;opc:char;
begin
    fin := false;
    repeat
            clrscr;
         writeln('************MENU GENERAL*************');
         writeln('Insertar nuevos productos.....[1]');
         writeln('Borrar productos..............[2]');
         writeln('Modificar productos...........[3]');
         writeln('Buscar un producto............[4]');
         writeln('Salir.........................[5]');
         repeat
            writeln('Escoja una opcion:  ');
            opc := readkey;
         until (opc in ['1'..'5']);
         case opc of
         '1' : begin
               insertar(reg,len);
               ordenar(reg,len);
                end;
         '2' : begin
                    borrar(reg,len);
               ordenar(reg,len);
               end;
         '3' : modificar(reg,len);
         '4' : busqueda(reg,len);
         '5' : fin := true;
         end;
    until fin;
end;

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