{Esto te ser vira}
program el_proveedor;
uses
crt;
type
vendio = record
bebida : string[40];
canti : integer;
end;
enalmac = record
bebida : string[40];
canti : integer;
end;
prove = record
codigo : longint;
nombre : string[100];
direcc : string[100];
venta : vendio;
dispo : enalmac;
end;
var
proveedor : array[1..5] of prove;
cont : integer;
tecla : char;
procedure altas(n : integer);
begin
clrscr;
writeln('**** Alta De Proveedores ****'); writeln;
write(' Entre Numero Codigo : '); readln(proveedor[cont].codigo);
write(' Entre Nombre Prov. : '); readln(proveedor[cont].nombre);
write(' Entre Direccion Prov. : '); readln(proveedor[cont].direcc);
write(' Entre Nombre Producto : '); readln(proveedor[cont].dispo.bebida);
write(' Entre Cantidad Produ. : '); readln(proveedor[cont].dispo.canti);
cont := cont + 1;
if cont > 5 then
cont := 5;
end;
procedure ventas(d : longint);
var
b, p : integer;
vedi : integer;
begin
for p := 1 to cont - 1 do
begin
if proveedor[p].codigo = d then
begin
b := p;
break;
end;
end;
if b > 0 then
begin
writeln(' Producto = ',proveedor[b].dispo.bebida); write(' Entre Ventas Cantidad : '); readln(vedi);
proveedor[b].venta.canti := proveedor[b].venta.canti + vedi;
proveedor[b].dispo.canti := proveedor[b].dispo.canti -
proveedor[b].venta.canti;
proveedor[b].venta.bebida := proveedor[b].dispo.bebida;
end
else
begin
writeln(' El Codigo Entrado No Existe Pulse Una Tecla'); readkey;
end;
end;
procedure bajas(n : longint);
var
j, b, p : integer;
begin
clrscr;
for p := 1 to cont - 1 do
begin
if proveedor[p].codigo = n then
begin
b := p;
break;
end;
end;
writeln('*** Baja De Producto ***'); writeln;
write(' Desea Anular Al Proveedor : ',proveedor[p].nombre,' [S/N]'); repeat
tecla := upcase(readkey);
until tecla in['S','N'];
if tecla = 'S' then
begin
for j := b + 1 to cont - 1 do
proveedor[j - 1] := proveedor[j];
cont := cont - 1;
end;
end;
procedure modificacion(c : longint);
var
b, p : integer;
vedi : integer;
begin
b := 0;
clrscr;
for p := 1 to cont - 1 do
begin
if proveedor[p].codigo = c then
begin
b := p;
break;
end;
end;
if b > 0 then
begin
writeln('**** Modificacion De Datos ****'); writeln;
writeln(' 1 = Codigo'); writeln(' 2 = Nombre'); writeln(' 3 = Direcc'); writeln(' 4 = Venta'); writeln(' 5 = Almacen'); writeln(' 6 = Todo'); writeln(' 7 = Nada'); writeln;
writeln(' Elija Opcion '); repeat
tecla := readkey;
until tecla in['1','2','3','4','5','6','7'];
clrscr;
case tecla of
'1' : begin
write(' Entre Codigo : '); readln(proveedor[b].codigo);
end;
'2' : begin
write(' Entre Nombre :'); readln(proveedor[b].nombre);
end;
'3' : begin
write(' Entre Direccion : '); readln(proveedor[b].direcc);
end;
'4' : begin
vedi := 0;
write(' Entre Ventas Producto : '); readln(proveedor[b].venta.bebida);
write(' Entre Ventas Cantidad : '); readln(vedi);
proveedor[b].venta.canti := proveedor[b].venta.canti + vedi;
proveedor[b].dispo.canti := proveedor[b].dispo.canti -
proveedor[b].venta.canti
end;
'5' : begin
vedi := 0;
write(' Entre Compra Producto : '); readln(proveedor[b].dispo.bebida);
write(' Entre Compra Cantidad : '); readln(vedi);
proveedor[b].dispo.canti := proveedor[b].dispo.canti + vedi;
end;
'6' : begin
write(' Entre Codigo : '); readln(proveedor[b].codigo);
write(' Entre Nombre :'); readln(proveedor[b].nombre);
write(' Entre Direccion : '); readln(proveedor[b].direcc);
write(' Entre Ventas Producto : '); readln(proveedor[b].venta.bebida);
write(' Entre Ventas Cantidad : '); readln(proveedor[b].venta.canti);
write(' Entre Compra Producto : '); readln(proveedor[b].dispo.bebida);
write(' Entre Compra Cantidad : '); readln(proveedor[b].dispo.canti);
end;
end;
end
else
begin
writeln(' El Codigo Entrado No Existe Pulse Una Tecla'); readkey;
end;
end;
procedure consultas;
var
nc : longint;
g : integer;
si : boolean;
begin
clrscr;
si := false;
writeln('***** Consulta De Proveedor *****'); writeln;
write(' Entre Numero Codigo : '); readln(nc);
for g := 1 to cont - 1 do
begin
if proveedor[g].codigo = nc then
begin
si := true;
break;
end;
end;
if si = true then
begin
writeln('>>>>> Informacion Proveedor <<<<<'); writeln;
writeln(' Codigo : ',proveedor[g].codigo); writeln(' Nombre : ',proveedor[g].nombre); writeln(' Direccion : ',proveedor[g].direcc); writeln(' Venta Producto : ',proveedor[g].venta.bebida); writeln(' Venta Cantidad : ',proveedor[g].venta.canti); writeln(' Esistencias Producto : ',proveedor[g].dispo.bebida); writeln(' Esistencias Cantidad : ',proveedor[g].dispo.canti); writeln;
writeln(' Pulse Una Tecla '); readkey;
end
else
begin
writeln(' El Codigo Entrado No Existe Pulse Una Tecla'); readkey;
end;
end;
procedure menu;
var
sal : boolean;
code : longint;
tec : char;
begin
sal := false;
repeat
clrscr;
writeln('///// Menu Jeneral \\\\\'); writeln;
writeln(' A = Altas'); writeln(' V = Ventas'); writeln(' B = Bajas'); writeln(' M = Modificaciones'); writeln(' C = Consultas'); writeln(' S = Salir'); writeln;
writeln('.... Elija Opcion ....'); repeat
tec := upcase(readkey);
until tec in['A','V','B','M','C','S'];
clrscr;
case tec of
'A' : altas(cont);
'V' : begin
write(' Entre Numero Codigo : '); readln(code);
ventas(code);
end;
'B' : begin
write(' Entre Numero Codigo : '); readln(code);
bajas(code);
end;
'M' : begin
write(' Entre Numero Codigo : '); readln(code);
modificacion(code);
end;
'C' : consultas;
'S' : sal := true;
end;
until sal = true;
end;
begin
cont := 1;
menu;
end.
Crear cuenta