Pascal/Turbo Pascal - Trabajo de computación I en pascal ayuda por favor

 
Vista:
sin imagen de perfil

Trabajo de computación I en pascal ayuda por favor

Publicado por Saimon (3 intervenciones) el 10/08/2021 07:27:24
Screenshot_2021-08-08-13-12-15
Screenshot_2021-08-08-13-11-49
Screenshot_2021-08-08-13-11-38

Buenas noches compañeros alguno que tenga experiencia y me pueda ayudar con el código para la programación de este trabajo, que debo de realizar estoy nuevo en la programación de pascal y estaré agradecido del cualquier ayuda de parte de ustedes muchas gracias
Adjunto imágenes del trabajo
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Trabajo de computación I en pascal ayuda por favor

Publicado por ramon (2158 intervenciones) el 16/08/2021 16:50:22
Espero esto te sirva.

program lajubilacion;
uses
crt;
type
string100 = string[100];

registro = record
edad : integer;
mes : string[12];
apellido : string100;
nombre : string100;
cedula : string100;
nacimiento : string;
end;

const
jubilacion : array[1..3] of string[32] = ('JUBILACION POR EDAD',
'JUBILACION POR ANTIGUEDAD JOVEN','JUBILACION POR ANTIGUEDAD ADULTA');


var
datos : registro;
f : file of registro;


procedure guarda_registro;
begin
assign(f,'datos.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,datos);
close(f);
end
else
begin
seek(f,filesize(f));
write(f,datos);
close(f);
end;
end;


procedure carga_registro(cedu : string100);
var
rec : longint;
rp : integer;
begin
assign(f,'datos.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln('Error de archivo o no existe pulse una tecla');
readkey;
exit;
end
else
begin
for rp := 1 to length(cedu) do
cedu[rp] := upcase(cedu[rp]);
for rec := 0 to filesize(f) - 1 do
begin
seek(f,rec);
read(f,datos);
for rp := 1 to length(datos.cedula) do
datos.cedula[rp] := upcase(datos.cedula[rp]);
if datos.cedula = cedu then
begin
clrscr;
writeln('Edad : ',datos.edad);
writeln('Mes : ',datos.mes);
writeln('Apellido : ',datos.apellido);
writeln('Nombre : ',datos.nombre);
writeln('Cedula : ',datos.cedula);
writeln('Nacimiento : ',datos.nacimiento);
writeln;
writeln('Pulse Una Tecla');
readkey;
break;
end;
end;
close(f);
end;
end;

procedure crea_registro;
var
da : char;
begin
clrscr;
writeln('******** Creacion De Registro ********');
writeln;
write('Entre Cedula : ');readln(datos.cedula);
write('Entre Nombre : ');readln(datos.nombre);
write('Entre Apellido : ');readln(datos.apellido);
write('Entre Edad : ');readln(datos.edad);
write('Entre Mes : ');readln(datos.mes);
write('Entre Fecha Nacimiento : ');readln(datos.nacimiento);
writeln;
write('((((((( Datos Correctos [S/N/F = Salir]');
repeat
da := upcase(readkey);
until da in['S','N','F'];
if da = 'F' then
exit;
if da = 'N' then
crea_registro;
if da = 'S' then
guarda_registro;
end;

procedure muestra_reporte;
var
rp : longint;
m : integer;
mess : string[12];
tt : char;
begin
clrscr;
writeln('******* Reporte *******');
writeln;
writeln(' [E]= ',jubilacion[1]);
writeln(' [M]= ',jubilacion[2]);
writeln(' [D]= ',jubilacion[3]);
writeln;
writeln('Elije Reporte');
repeat
tt := upcase(readkey);
until tt in['E','M','D'];
case tt of
'E' : mess := 'ENERO';
'M' : mess := 'MAYO';
'D' : mess := 'DICIEMBRE';
end;
assign(f,'datos.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln('Error de archivo o no existe pulse una tecla');
readkey;
exit;
end
else
begin
clrscr;
writeln('<<<<<< Reporte >>>>>>');
writeln('Mes Apellido Nombre Cedula Nacimiento Edad');
writeln;
for rp := 0 to filesize(f) - 1 do
begin
seek(f,rp);
read(f,datos);
for m := 1 to length(datos.mes) do
datos.mes[m] := upcase(datos.mes[m]);
if datos.mes = mess then
begin
writeln(datos.mes,' ',datos.apellido,' ',datos.nombre,' ',
datos.cedula,' ',datos.nacimiento,' ',datos.edad);
end;
end;
close(f);
end;
writeln;
writeln('Pulse Una Tecla');
readkey;
end;

procedure menu;
var
tec : char;
sal : boolean;
ced : string100;
begin
sal := false;
repeat
clrscr;
writeln('********> MENU PRINCIPAL <********');
writeln;
writeln(' [C] = Crear Registro');
writeln(' [B] = Ver un Registro');
writeln(' [M] = Mostrar Reporte');
writeln(' [S] = Salir');
writeln;
writeln(' Elija Opcion ');
repeat
tec := upcase(readkey);
until tec in['C','B','M','S'];
case tec of
'C' :crea_registro;
'B' : begin
write('Entre Cedula : ');
readln(ced);
carga_registro(ced);
end;
'M' :muestra_reporte;
'S' : sal := true;
end;
until sal = true;
end;



begin

clrscr;
menu;
end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar