El código que has hecho es un poco difícil de modificar, necesita hacer muchos arreglos para lograr los resultados que deseas. Luego verás los motivos.
Primero:
No te muestra los datos porque no se lo indicas. ¿Qué te parece si empleas la sentencia "WRITE"?
procedure lee_fichero(nombre:string; VAR cuadros:Tcuadro);
var
fichero:Tfichero;
begin
assign(fichero, nombre);
reset(fichero);
read(fichero, cuadros);
writeln(cuadros.numcuadro);
writeln(cuadros.titulo);
writeln(cuadros.autor);
writeln(cuadros.precio:2:2);
close(fichero)
end;
O mejor aún empleas el procedimiento "imprime_cuadro"
procedure lee_fichero(nombre:string; VAR cuadros:Tcuadro);
var
fichero:Tfichero;
begin
assign(fichero, nombre);
reset(fichero);
read(fichero, cuadros);
imprime_cuadro(cuadros);
close(fichero)
end;
Ejecuta ahora el programa y verás los resultados. ¿No es lo que esperabas... verdad?
Eso sucede porque tu archivo solo tiene guardado un registro, debido a que la sentencia "rewrite" (reescribir) abre un archivo, borra todo su contenido y graba los nuevos datos.
Es decir cuando se ejecuta esta línea: graba_fichero(nombre, cuadro1); se guardan los datos del cuadro1 correctamente.
Pero en la siguiente línea: graba_fichero(nombre, cuadro2); está el error. Ya que se abre el archivo, se destruye su contenido y se reemplaza por los del segundo cuadro. Con lo cual al final el archivo tendrá un solo registro con los datos del cuadro2.
Posibles Soluciones
1) Abrir el fichero y no cerrarla hasta que se ingresen todos los datos.
Más o menos así:
Si se trata del primer cuadro
Abrir fichero
Escribir datos
Dejar el fichero abierto
Si se trata del segundo fichero
Escribir datos
Cerrar fichero
procedure graba_fichero(nombre:string; VAR cuadros:Tcuadro; ind:integer);
var
fichero:Tfichero;
begin
if ind=1 then
begin
assign (fichero, nombre);
rewrite(fichero)
end;
write(fichero, cuadros);
if ind=2 then
close(fichero);
end;
Una modificación similar debes hacer en el procedimiento "lee_fichero"
2) Otra opción (mucho mejor que la anterior) es el uso de un array de registros
Type
Tcoleccion = array[1..tamcoleccion] of Tcuadro
...
Var
todosloscuadros:Tcoleccion;
Un array que almacene los datos de todos los cuadros, así el procedimiento, quedaría:
procedure graba_fichero(nombre:string; todosloscuadros:Tcoleccion);
var
fichero:Tfichero;
begin
assign(fichero,nombre);
rewrite(fichero);
for i:=1 to tamcoleccion do
write(fichero,todosloscuadros[i]);
close(fichero);
end;
Saludos.
Mostrar Mensajes
) en mi win98 y va bien.