Here's the second part... I couldn't post it as a whole because of characters limit on the forum:
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure cosecha(c, c1: string);
(* Carga o modifica el archivo que registra las cosechas.
Precondición: c= Nombre del archivo a modificar
c1= Nombre del archivo de referencia para verificar la existencia de la especie.
Poscondición: arch= Archivo de nombre c, modificado con un registro nuevo.
*)
Var
archCult: tArchCult;
arch: tArchSiemCos;
reg: tSiemCos;
clave: integer;
begin
Assign(arch, c1);
reset(arch);
Assign(archCult, c);
Reset(archCult);
If (FileSize(archCult)>=0) then
begin
Repeat
begin
Write('Ingrese el codigo de especie: ');
Read(clave);
If existeCult(archCult, clave) then
begin
reg.codEsp:= clave;
completaCosecha(reg);
insertaReg(arch, reg);
end
else
Writeln('No existe Cultivo');
end;
Until confirma('Finalizar? (S/N)');
end
else
Writeln('No hay Cultivos activos');
Close(arch);
Close(archCult);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure completaSiemb(var reg:tSiemCos);
(* Completa los datos del registro de siembra.
Precondición: reg= Registro a modificar. Ingresado como parámetro.
Poscondición: reg= Registro modificado.
*)
Var
a, m, d: integer;
begin
Repeat
begin
Repeat
begin
Writeln('Ingresar el anio de la siembra: ');
Read(a);
m:= enteroEnRango('Ingresar el mes de la siembra: ', 1, 12);
d:= enteroEnRango('Ingresar el dia de la siembra: ', 1, 31);
end;
Until fechaValida(a, m, d);
writeln ('Anio: ',a, ', Mes: ', m, ', Dia: ', d);
end;
Until confirma('Fecha Correcta? (S/N)');
reg.anio:=a;
reg.mes:=m;
reg.dia:=d;
Writeln('Ingresar las unidades sembradas');
Repeat
Read(reg.cant);
Until (reg.cant>0);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure siembra(c, c1: string);
(* Carga o modifica el archivo que registra las siembras
Precondición: c= Nombre del archivo a modificar (Ingresado como parámetro).
Poscondición: arch= Modificado con el nuevo registro añadido.
*)
Var
archCult: tArchCult;
arch: tArchSiemCos;
reg: tSiemCos;
clave: integer;
begin
Assign(arch, c1);
Reset(arch);
Assign(archCult, c);
Reset(archCult);
If (fileSize(archCult)>=0) then
begin
Repeat
begin
Writeln('Ingrese el código de especie: ');
Read(clave);
If existeCult(archCult, clave) then
begin
reg.codEsp:= clave;
completaSiemb(reg);
insertaReg(arch, reg);
end
else
writeln('No existe Cultivo');
end;
Until confirma('Finalizar? (S/N)');
end
else
Writeln('No hay Cultivos activos');
Close(arch);
Close(archCult);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Function claveEnUso(var arch:tArchCult; dato: integer): boolean;
(* Busca en el archivo si la clave está en uso
Precondición: arch= Archivo abierto e ingresado como parámetro.
dato= Código de especie ingresado por parámetro para la verificación.
Poscondición: Verdadero= Si la clave está en uso.
Falso= Si la clave no está en uso.
*)
Var
pos: integer;
val: boolean;
reg: tCult;
begin
val:= false;
pos:= FilePos(arch);
seek(arch, 0);
while ((not Eof(arch)) and (not val)) do
begin
read(arch, reg);
if (reg.codEsp=dato) then
val:=true;
end;
seek(arch,pos);
claveEnUso:= val
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure ingresarResistenciaHeladas(var res: integer);
(* Valida el ingreso del tipo de resistencia a heladas del cultivo siendo procesado
Precondición: res= Variable de tipo entero ingresada por parámetro.
Poscondición: res= R, Valor entero representativo del tipo de resistencia a las heladas.
*)
begin
writeln('Indique la resistencia del cultivo a las heladas.');
writeln(' 1. Muy Resistente');
writeln(' 2. Resistente');
writeln(' 3. Muy Sensible');
writeln(' 4. Sensible');
Writeln('');
res:= enteroEnRango('Ingrese el tipo de resistencia: ', 1, 4);
Writeln('');
Writeln('');
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure ingresarMetodoSiembra(var res: integer);
(* Valida el ingreso del método de siembra del cultivo siendo procesado.
Precondición: res= Variable de tipo entero ingresada como parámetro.
Poscondición: res= R, Valor representativo del método de siembra utilizado para el cultivo.
*)
begin
writeln('Ingrese el metodo de siembra del cultivo.');
writeln(' 1. Directo');
writeln(' 2. Almacigo');
Writeln('');
res:= enteroEnRango('Ingrese el metodo de siembra: ', 1, 2);
Writeln('');
Writeln('');
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Function confirmaNomb(var arch: tArchCult; nomb:string): boolean;
var
reg: tCult;
encontre: boolean;
pos:integer;
begin
pos:= FilePos(arch);
encontre:=false;
seek (arch,0);
while ((not Eof(arch))and(not encontre)) do
begin
read(arch, reg); // Recupera el primer registro del archivo
if (nomb=reg.nomb) then // Si los nombres son iguales...
encontre:= true
// else
// begin
// if not Eof(arch)then
// read(arch, reg); // Si los nombres no son iguales sigue leyendo
// end;
end;
confirmaNomb:= encontre;
seek(arch,pos);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure completaCult(var reg:tCult);
(* Completa el registro con los valores del cultivo.
Precondición:
Poscondición:
*)
Var
res, dia: integer;
begin
res:= 0;
Write('Ingrese el nombre del cultivo: ');
REPEAT
readln(reg.nomb);
until (reg.nomb<>'');
Writeln('');
Writeln('');
ingresarResistenciaHeladas(res);
case res of
1: reg.resist:= 'Muy Resistente.';
2: reg.resist:= 'Resistente.';
3: reg.resist:= 'Muy Sensible.';
4: reg.resist:= 'Sensible.';
end;
ingresarMetodoSiembra(res);
case res of
1: reg.metod:= 'Directo.';
2: reg.metod:= 'Almacigo.';
end;
reg.mes:= enteroEnRango('Ingrese el mes de plantacion: ', 1, 12);
write('Ingrese la cantidad de dias antes de la cosecha: ');
Repeat
Read(dia);
Until (dia>0);
reg.dia:= dia;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure modifCult(c: string);
(* Modifica el cultivo seleccionado
Precondición: c= Nombre del archivo a modificar. Ingresa como parámetro.
Poscondición: arch= Archivo modificado con el registro nuevo en la posición(clave) del registro
anterior.
*)
Var
arch: tArchCult;
reg: tCult;
clave: integer;
begin
assign(arch, c);
reset(arch);
If FileSize(arch)>0 then
begin
Repeat
begin
Repeat
begin
Writeln('Ingrese el código de especie: ');
Read(clave);
end;
Until confirma('Dato correcto? (S/N)');
If claveEnUso(arch,clave) then
begin
Seek(arch, clave);
Read(arch, reg);
completaCult(reg);
Seek(arch, clave);
Write(arch, reg);
Writeln('Cultivo ', reg.nomb, ' modificado.');
end
else
Writeln('Codigo de especie no existente.');
end;
Until confirma('Finalizar modificacion? (S/N)');
end;
If FileSize(arch)=0 then
Writeln('Archivo vacio. No se hizo nada.');
Writeln('');
Close(arch);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure altaCult(c: string);
(* Modifica el archivointroduciendo un nuevo registro de cultivo.
Precondición: c= Nombre del archivo a modificar. Ingresa como parámetro.
Poscondición: archCu= Con un nuevo registro escrito en una nueva posición.
*)
Var
arch: tArchCult;
reg: tCult;
begin
Assign(arch, c);
Reset(arch); // Abre el archivo
Repeat
begin
Seek(arch, FileSize(arch)); // Se posiciona al final del archivo
reg.codEsp:= FileSize(arch); // Guarda la ultima posición del archivo como clave
Writeln('Se va a realizar el alta de un cultivo.');
Writeln('');
If (fileSize(arch)>=0) then
begin
completaCult(reg);
If not confirmaNomb(arch,reg.nomb) then
begin
Write(arch, reg);
Writeln('Cultivo ', reg.nomb, ' dado de alta con el codigo ', reg.codEsp);
end
else
begin
Writeln('Nombre de cultivo en uso. Ingrese otro.');
end;
end;
end;
until confirma('Finalizar carga? (S/N)');
close(arch);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure menu(var o1:integer; var o2:integer);
begin
clrscr;
Repeat
Writeln('1. Realizar altas/modificaciones.');
Writeln('2. Mostrar listado de siembras/cosechas.');
o1:= enteroEnRango('Ingrese opcion: ', 1, 2);
Writeln('');
If o1=1 then
begin
Writeln('1. Dar de alta un cultivo.');
Writeln('2. Modificar un cultivo.');
Writeln('3. Registrar siembra.');
Writeln('4. Registrar cosecha.');
o2:= enteroEnRango('Ingrese opcion: ', 1, 4);
Writeln('');
end;
If o1=2 then
begin
Writeln('1. Listar siembras.');
Writeln('2. Listar cosechas.');
o2:= enteroEnRango('Ingrese opcion: ', 1, 2);
Writeln('');
end;
Until not confirma('Reingresar opciones? (S/N)');
clrscr;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Procedure creaArchivos(c1, c2, c3: string);
(* Crea los archivos necesarios para la ejecución del programa.
Precondición: c1, c2, c3= nombres de los archivos a crear.
Poscondición: --
*)
Var
archCult: tArchCult;
archSiemCos: tArchSiemCos;
begin
if not existeArch(c1) then
begin
assign(archCult, c1);
rewrite(archCult);
close(archCult);
end;
if not existeArch(c2) then
begin
assign(archSiemCos, c2);
rewrite(archSiemCos);
close(archSiemCos);
end;
if not existeArch(c3) then
begin
assign(archSiemCos, c3);
rewrite(archSiemCos);
close(archSiemCos);
end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
// Programa principal //
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
Var
opc1, opc2: integer;
c1, c2, c3: string[70];
begin
opc1:= 0;
opc2:= 0;
c1:= 'Cultivos.dat';
c2:= 'Cosecha.dat';
c3:= 'Siembra.dat';
creaArchivos(c1, c2, c3);
Repeat
begin
menu(opc1, opc2);
if opc1=1 then
begin
case opc2 of
1: altaCult(c1);
2: modifCult(c1);
3: siembra(c1, c3);
4: cosecha(c1, c2);
end;
end;
if opc1=2 then
begin
case opc2 of
1: listaCos(c2, c1);
2: listaSie(c3, c1);
end;
end;
end;
until confirma('Salir? (S/N)');
end.
I didn't wanted to put the code in here because it's for an assignment I have in college. So I just wanted some posibilities on why the program may behave like that so I could fix it myself instead of feeling like I'm cheating asking for help in here and get the code solved. But whatever... at this point I'm desperated and can't see the mistake -.-
Thanks!
Recent
