P109_E5-Ejercicio+poblacion+bilbaina+modificado

=__**Ejercicio de la población bilbaina modificado**__=

Ejercicio basado en el siguiente menú de opciones:

>> 1 Añadir nueva persona al censo >> 2 Mostrar todo el censo >> 3 Crear fichero con mayores de cierta edad >> 0 Terminar

Nombre, Primer apellido, Segundo apellido, Año de nacimiento y Dirección.
 * 1. Añadir un nuevo registro** con la siguiente información:

Leer nombre del fichero y mostrar todo su contenido
 * 2. Mostrar todo el contenido del fichero:**

Leer año actual Leer edad limite Volcar a array los mayores de esa edad Mostrar array (para comprobarlo) Volcar el array al fichero por orden de edad
 * 3. Crear fichero con mayores de una determinada edad**

code format="pascal" PROGRAM P109_E_5 ; USES Crt, SysUtils ; CONST MAX_LONG = 400 ; TYPE tsCadenas  = STRING [40] ;

trgPersonas = RECORD sNombre, sApellido1, sApellido2, sDomicilio : tsCadenas ; iAnyoNacim            : Integer END ;

tfbrgFicherosCenso = FILE OF trgPersonas ;

targListaPersonas = ARRAY [1..MAX_LONG] OF trgPersonas ;

FUNCTION fncLeerOpcion : Char ; VAR cOpcion : Char ; BEGIN ClrScr ; WriteLn ('********* MENU DE OPCIONES *********') ; WriteLn ('1.- Añadir nueva persona al censo') ; WriteLn ('2.- Mostra fichero') ; WriteLn ('3.- Crear fichero con mayores de cierta edad') ; WriteLn ('0.- Terminar') ; WriteLn ; Write (' Pulsa la tecla de la opción: ') ; REPEAT cOpcion := ReadKey UNTIL ('0' <= cOpcion) AND (cOpcion <= '3') ; WriteLn (cOpcion) ; fncLeerOpcion := cOpcion END ;

PROCEDURE LeerPersona (VAR rgPersona : trgPersonas) ; BEGIN WITH rgPersona DO       BEGIN Writeln ; Write ('          Nombre: ') ; ReadLn (sNombre) ; Write (' Primer apellido: ') ; ReadLn (sApellido1) ; Write ('Segundo apellido: ') ; ReadLn (sApellido2) ; Write ('       Direccion: ') ; ReadLn (sDomicilio) ; Write ('Año de nacimiento: ') ; Readln (iAnyoNacim) ; END ; END ;

PROCEDURE MostrarPersona (CONST rgPersona : trgPersonas) ; BEGIN WITH rgPersona DO       BEGIN WriteLn ('          Nombre: ',                  sApellido1, ' ', sApellido2, ', ', sNombre) ; WriteLn ('       Dirección: ', sDomicilio) ; WriteLn ('Año de nacimiento: ', iAnyoNacim) ; END ; END ;

PROCEDURE CrearFichero (sNomFich : tsCadenas) ; VAR fbrgFich : tfbrgFicherosCenso ; BEGIN Assign (fbrgFich, sNomFich) ; ReWrite (fbrgFich) ; Close (fbrgFich) ; END ;

PROCEDURE AnyadirUnaPersona (CONST rgPersona : trgPersonas ;                                 sNomFich : tsCadenas);

VAR fbrgFich      : tfbrgFicherosCenso ; rgPersonaNueva : trgPersonas ; BEGIN Assign (fbrgFich, sNomFich) ; Reset (fbrgFich) ; Seek  (fbrgFich, FileSize (fbrgFich)) ;

rgPersonaNueva := rgPersona ;

Write (fbrgFich, rgPersonaNueva) ;

Close (fbrgFich) END ;

PROCEDURE MostrarFichero (sNomFich : tsCadenas) ; VAR fbrgFich : tfbrgFicherosCenso ; rgPersona : trgPersonas ; cEspera  : Char ; BEGIN Assign (fbrgFich, sNomFich) ; Reset (fbrgFich) ;

WHILE NOT Eof (fbrgFich) DO     BEGIN Read (fbrgFich, rgPersona) ;

MostrarPersona (rgPersona) ; Writeln ; cEspera := Readkey END ; Close (fbrgFich) ; END ;

PROCEDURE CrearListaMayores (sNomFichCenso : tsCadenas ;                            VAR argListaMayores: targListaPersonas ;                             VAR iLongLista : Integer ;                                 iEdadLimite, iAnyoActual : Integer) ; VAR fbrgFichCenso : tfbrgFicherosCenso ; rgPersona    : trgPersonas ; BEGIN Assign (fbrgFichCenso, sNomFichCenso) ; Reset  (fbrgFichCenso) ;

iLongLista := 0 ;

WHILE NOT Eof (fbrgFichCenso) DO      BEGIN Read (fbrgFichCenso, rgPersona) ;

IF (iAnyoActual - rgPersona.iAnyoNacim) > iEdadLimite THEN IF iLongLista < MAX_LONG THEN BEGIN iLongLista := iLongLista + 1 ; argListaMayores [iLongLista] := rgPersona ; END ; END ; Close (fbrgFichCenso) ; END ;

PROCEDURE MostrarLista (CONST argLista: targListaPersonas ;                                  iLong: Integer) ; VAR i      : Integer ; cEspera : Char ; BEGIN FOR i := 1 TO iLong DO       BEGIN MostrarPersona (argLista [i] ) ; Writeln ; cEspera := Readkey END ; END ;

FUNCTION fniBuscarPosMayorEdad (CONST argListaMayores: targListaPersonas ;                               iLongLista : Integer) : Integer ; VAR iMenorAnyoNacim,                { es el de menor año de nacimiento } i, iPosic       : Integer ; BEGIN iMenorAnyoNacim := argListaMayores[1].iAnyoNacim ; iPosic         := 1 ; FOR i := 2 TO iLongLista DO      IF  argListaMayores[1].iAnyoNacim  < iMenorAnyoNacim  THEN BEGIN iMenorAnyoNacim := argListaMayores[i].iAnyoNacim ; iPosic         := i ; END ;

fniBuscarPosMayorEdad := iPosic ; END ;

PROCEDURE BorrarPersonaLista (VAR argLista: targListaPersonas ;                               VAR    iLong: Integer;                                     iPosic: Integer) ; VAR i : Integer ; BEGIN FOR i := iPosic + 1 TO iLong DO      argLista [i-1] := argLista [i] ;

iLong := iLong - 1 ; END ;

PROCEDURE VolcarListaFicheroEnOrden (VAR argListaMayores: targListaPersonas ;                                             iLongLista: Integer ;                                         sNomFichMayores: tsCadenas) ; VAR iPosic  : Integer ; BEGIN CrearFichero (sNomFichMayores) ;

WHILE iLongLista > 0 DO        BEGIN iPosic := fniBuscarPosMayorEdad (argListaMayores, iLongLista) ;

AnyadirUnaPersona (argListaMayores[iPosic], sNomFichMayores) ;

BorrarPersonaLista (argListaMayores, iLongLista, iPosic) ; END ; END ;

VAR { Variables del programa principal -} sNomFichCenso, sNomFichMayores, sNomFich : tsCadenas; cOpcion, cEspera        : Char ; rgPersona               : trgPersonas ; iAnyoActual, iEdadLimite : Integer ;

argListaMayores : targListaPersonas ; iLongLista     : Integer ;

BEGIN {--- programa principal -} Writeln ; Write ('Nombre del fichero del censo: ') ; Readln (sNomFichCenso) ;

IF NOT FileExists (sNomFichCenso) THEN WriteLN ('ERROR: No existe el archivo de censo "', sNomFichCenso, '"') ELSE REPEAT cOpcion := fncLeerOpcion ;

CASE cOpcion OF         '1' : BEGIN Writeln ('Escribe los datos de la nueva persona: ') ; LeerPersona (rgPersona) ; AnyadirUnaPersona (rgPersona, sNomFichCenso) ; END ;

'2' : BEGIN Writeln ; Write ('Nombre del fichero a mostrar: ') ; Readln (sNomFich) ; Writeln ;

IF NOT FileExists (sNomFich) THEN WriteLN ('ERROR: No existe el archivo "',                           sNomFich, '"') ELSE BEGIN Writeln ('Contenido del fichero: ', sNomFich) ; MostrarFichero (sNomFich) ; Writeln ('===================================') ; END ; END ;

'3' :BEGIN Writeln ; Write ('   Año actual : ') ; Readln (iAnyoActual) ; Write ('Limite de edad : ') ; Readln (iEdadLimite) ;

Writeln ; Write ('Nombre del fichero de mayores de ', iEdadLimite, ': ') ; Readln (sNomFichMayores) ;

iLongLista := 0 ; CrearListaMayores (sNomFichCenso, argListaMayores, iLongLista,                                  iEdadLimite, iAnyoActual) ; Writeln ; Writeln ('Lista de mayores de ', iEdadLimite, ': ') ; MostrarLista (argListaMayores, iLongLista) ; Writeln ('===================================') ;

VolcarListaFicheroEnOrden (argListaMayores, iLongLista,                                         sNomFichMayores) ; END ; END ; { Case }

IF cOPcion <> '0' THEN cEspera := ReadKey ;

UNTIL cOPcion = '0' ;

WriteLn ; WriteLn ('====================================================') ; WriteLn ('           Pulsa RETURN para terminar') ; Write  ('___________________________________________________') ; ReadLn ; END. { FIN del PROGRAMA } code