Pascal/Turbo Pascal - free pascal

 
Vista:

free pascal

Publicado por Adrian (1 intervención) el 17/06/2011 15:16:23
Por favor necesito ayuda con este problema...

gracias de antemano


Generar un archivo de libros de una librería con los siguientes campos: ISBN (identificación
del libro), Título de la obra, Año de edición, cantidad vendida por título de la obra, precio del
libro.
2-Diseñar un algoritmo que lea los datos del archivo de libros de la librería (creado en el
punto anterior) y obtenga la siguiente información:
- Visualizar por pantalla los datos de los libros: ISBN, Título de la obra, año de edición,
cantidad vendida de los libros cuyo precio supera los $45.
- Un vector de cantidad de libros por año de edición. Para esto previamente se debe
generar un vector con los años de edición: 1999, 2000, 2002, 2003, 2008, para obtener el
índice del vector de cantidades que almacenará la suma de cada año.
- Recorrer el vector de cantidades y determinar el año de edición que tiene mayor cantidad
de libros.
- Al final del programa mostrar por pantalla la cantidad de libros cuyo precio supera los $45
y el año de edición con mayor cantidad de libros y esa cantidad.
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

free pascal

Publicado por ramon (2158 intervenciones) el 20/06/2011 18:00:06
{Espero Este programa te ayude.
{Tiene 2 partes}
program libreria;
uses
crt, dos;
type
archilibros = record
ISBN : string[20];
Titulo_obra : string[50];
Ano_edicion : string[4];
cantidad_vendida : integer;
precio_libro : real;
end;


var
fli : file of archilibros;
tomamos : archilibros;
librosarray : array[0..50] of archilibros;
tec : char;
err, x, y, i : integer;
usado : boolean;
cantid : array[1..5] of word;
totalano : array[1..5] of word;

procedure guarga_datos(df : archilibros);
var
cc, grava, co : longint;
begin
assign(fli,'Datoslib.lib');
{$I-} reset(fli); {$I+}
if ioresult <> 0 then
begin
rewrite(fli);
seek(fli,grava);
write(fli,df);
close(fli);
end
else
begin
grava := filesize(fli);
seek(fli,grava);
write(fli,df);
close(fli);
end;
end;

procedure finales;
var
final : archilibros;
archi, busca : longint;
error, nano : integer;
fin : char;
cont : array[1..5] of integer;
anosd : string[4];
totallibrosano : array[1..5] of integer;
begin
clrscr;
fillchar(cantid,sizeof(cantid),0);
assign(fli,'Datoslib.lib');
{$I-} reset(fli); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
busca := 0;
fillchar(cont,sizeof(cont),0);
fillchar(totallibrosano,sizeof(totallibrosano),0);
archi := filesize(fli) - 1;
repeat
seek(fli,busca);
read(fli,final);
if final.precio_libro >= 45 then
begin
val(final.Ano_edicion,nano,error);
case nano of
1999 : begin
writeln(' ',final.Ano_edicion,' ',final.precio_libro:8:2);
cont[1] := cont[1] + 1;
totallibrosano[1] := totallibrosano[1] + final.cantidad_vendida;
end;
2000 : begin
writeln(' ',final.Ano_edicion,' ',final.precio_libro:8:2);
cont[2] := cont[2] + 1;
totallibrosano[2] := totallibrosano[2] + final.cantidad_vendida;
end;
2002 : begin
writeln(' ',final.Ano_edicion,' ',final.precio_libro:8:2);
cont[3] := cont[3] + 1;
totallibrosano[3] := totallibrosano[3] + final.cantidad_vendida;
end;
2003 : begin
writeln(' ',final.Ano_edicion,' ',final.precio_libro:8:2);
cont[4] := cont[4] + 1;
totallibrosano[4] := totallibrosano[4] + final.cantidad_vendida;
end;
2008 : begin
writeln(' ',final.Ano_edicion,' ',final.precio_libro:8:2);
cont[5] := cont[5] + 1;
totallibrosano[5] := totallibrosano[5] + final.cantidad_vendida;
end;
end;
end;
busca := busca + 1;
until busca > archi;
close(fli);
nano := cont[1];
for error := 2 to 5 do
begin
if cont[error] > nano then
begin
nano := cont[error];
busca := error;
end;
end;
case busca of
1 : anosd := '1999';
2 : anosd := '2000';
3 : anosd := '2002';
4 : anosd := '2003';
5 : anosd := '2008';
end;
writeln('*** A¤o Mallor Venta ***');
writeln(' ',cont[busca],' ',anosd,' ',totallibrosano[busca]);
writeln;
writeln('**** PULSE ENTER PARA SALIR ****');
repeat
fin := readkey;
until fin = #13;
end;
end;

procedure presenta_ano_edicion;
var
archi, busca : longint;
muest : archilibros;
error, nano : integer;
sal1 : char;
begin
fillchar(cantid,sizeof(cantid),0);
assign(fli,'Datoslib.lib');
{$I-} reset(fli); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
busca := 0;
archi := filesize(fli) - 1;
repeat
seek(fli,busca);
read(fli,muest);
val(muest.Ano_edicion,nano,error);
case nano of
1999 : cantid[1] := cantid[1] + 1;
2000 : cantid[2] := cantid[2] + 1;
2002 : cantid[3] := cantid[3] + 1;
2003 : cantid[4] := cantid[4] + 1;
2008 : cantid[5] := cantid[5] + 1;
end;
busca := busca + 1;
until busca > archi;
close(fli);
clrscr;
writeln('**** Los libros por a¤o de edicion ****');
writeln;
writeln(' A¥O 1999 = ',cantid[1]);
writeln(' A¥O 2000 = ',cantid[2]);
writeln(' A¥O 2002 = ',cantid[3]);
writeln(' A¥O 2003 = ',cantid[4]);
writeln(' A¥O 2008 = ',cantid[5]);
nano := cantid[1];
error := 1;
for busca := 2 to 5 do
begin
if nano < cantid[busca] then
begin
nano := cantid[busca];
error := busca;
end
else
nano := nano;
end;
writeln;
writeln(' *** mayor cantidad de libros el A¤o *** ');
case error of
1 : writeln(' 1999 = ',nano);
2 : writeln(' 2000 = ',nano);
3 : writeln(' 2002 = ',nano);
4 : writeln(' 2003 = ',nano);
5 : writeln(' 2008 = ',nano);
end;
writeln;
writeln(' PULSE ENTER PARA SALIR.......');
repeat
sal1 := readkey;
until sal1 = #13;
end;
end;




procedure pantalla_datos(quees : string);
begin
clrscr;
gotoxy(1,2);write('**** ',quees,' ****');
gotoxy(2,3);write('--------------------');
gotoxy(1,4);write(' identificacion : ');
gotoxy(2,5);write('-------------------');
gotoxy(1,6);write(' Titulo de la Obra : ');
gotoxy(2,7);write('-------------------');
gotoxy(1,8);write(' A¤o Edicion : ');
gotoxy(2,9);write('-------------------');
gotoxy(1,10);write(' Cantidad Vendida : ');
gotoxy(2,11);write('-------------------');
gotoxy(1,12);write(' Precio del Libro : ');
gotoxy(2,13);write('--------------------');
gotoxy(23,4);
end;

procedure entrada_datos_libro;
var
posy : integer;
fin : boolean;
datoen : string[80];
valorint, error, h : integer;
preci : real;
begin
fillchar(datoen,81,' ');
datoen[0] := chr(80);
posy := 4;
fin := false;
pantalla_datos('Entre Los Datos [Enter = Acectar Datos] [Esc = Avandonar]');
gotoxy(23,posy);
h := 1;
repeat
tec := readkey;
if tec <> #27 then
begin
if posy in[4,6,8] then
if tec in[#40..#126,#164,#165,#32] then
begin
datoen[h] := upcase(tec);
datoen[0] := chr(h);
gotoxy(22 + h,posy);write(datoen[h]);
h := h + 1;
if h > 80 then
h := 80;
end;
if posy in[10,12] then
if tec in[#48..#57] then
begin
datoen[h] := upcase(tec);
datoen[0] := chr(h);
gotoxy(22 + h,posy);write(datoen[h]);
h := h + 1;
if h > 80 then
h := 80;
end;
if tec = #8 then
begin
h := h - 1;
if h < 1 then
h := 1;
datoen[h] := ' ';
datoen[0] := chr(h);
gotoxy(22 + h,posy);write(datoen[h]);
end;
if tec = #13 then
begin
case posy of
4 : begin
tomamos.ISBN := copy(datoen,1,h - 1);
gotoxy(23,posy);clreol;
gotoxy(23,posy);write(tomamos.ISBN);
fillchar(datoen,81,' ');
datoen[0] := chr(80);
h := 1;
end;
6 : begin
tomamos.Titulo_obra := copy(datoen,1,h - 1);
gotoxy(23,posy);clreol;
gotoxy(23,posy);write(tomamos.Titulo_obra);
fillchar(datoen,81,' ');
datoen[0] := chr(80);
h := 1;
end;
8 : begin
tomamos.Ano_edicion := copy(datoen,1,h - 1);
gotoxy(23,posy);clreol;
gotoxy(23,posy);write(tomamos.Ano_edicion);
fillchar(datoen,81,' ');
datoen[0] := chr(80);
h := 1;
end;
10 : begin
val(datoen,valorint,error);
tomamos.cantidad_vendida := valorint;
gotoxy(23,posy);clreol;
gotoxy(23,posy);write(tomamos.cantidad_vendida);
fillchar(datoen,81,' ');
datoen[0] := chr(80);
h := 1;
end;
12 : begin
val(datoen,preci,error);
tomamos.precio_libro := preci;
gotoxy(23,posy);clreol;
gotoxy(23,posy);write('$',tomamos.precio_libro:8:2);
fillchar(datoen,81,' ');
datoen[0] := chr(80);
h := 1;
end;
end;
posy := posy + 2;
gotoxy(23,posy);
if posy > 12 then
begin
gotoxy(12,15);write(' Estan Correctas las Entradas [S/N]..');
repeat
tec := readkey;
until tec in['s','S','n','N'];
if tec in['s','S'] then
begin
fin := true;
end;
if tec in['n','N'] then
begin
clrscr;
entrada_datos_libro;
end;
end;
end;
end;
until (tec = #27) or (fin = true);
if fin = true then
begin
guarga_datos(tomamos);
end;
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

free pascal

Publicado por ramon (2158 intervenciones) el 20/06/2011 18:02:36
{2 paste}

procedure presenta_libros;
var
puls : char;
asta, mr : longint;
begin
assign(fli,'Datoslib.lib');
{$I-} reset(fli); {$I+}
if ioresult <> 0 then
begin
end
else
begin
mr := 0;
asta := filesize(fli) - 1;
fillchar(tomamos,sizeof(archilibros),0);
seek(fli,mr);
read(fli,tomamos);
clrscr;
pantalla_datos('Ver Datos Libros Flechas Mas ESC fin');
repeat
if mr < asta then
begin
gotoxy(23,4);write(tomamos.ISBN);
gotoxy(23,6);write(tomamos.Titulo_obra);
gotoxy(23,8);write(tomamos.Ano_edicion);
if tomamos.precio_libro >= 45 then
begin
gotoxy(23,10);write(tomamos.cantidad_vendida);
gotoxy(23,12);write(tomamos.precio_libro:10:2);
end
else
begin
gotoxy(23,10);
gotoxy(23,12);write(tomamos.precio_libro:10:2);
end;
textcolor(10);
gotoxy(48,4);write(chr(24));
gotoxy(48,14);write(chr(25));
gotoxy(48,6);write('U');
gotoxy(48,7);write('S');
gotoxy(48,8);write('E');
gotoxy(48,10);write('L');
gotoxy(48,11);write('A');
gotoxy(48,12);write('S');
textcolor(15);
gotoxy(23,10);
end
else
begin
gotoxy(23,12);write('*** FIN DE ARCGIVOS ***');
textcolor(10);
gotoxy(48,14);write(chr(25));
gotoxy(48,6);write('U');
gotoxy(48,7);write('S');
gotoxy(48,8);write('E');
gotoxy(48,10);write('L');
gotoxy(48,11);write('A');
gotoxy(48,12);write('S');
textcolor(15);
gotoxy(23,12);
end;
puls := readkey;
gotoxy(23,4);clreol;
gotoxy(23,6);clreol;
gotoxy(23,8);clreol;
gotoxy(23,10);clreol;
gotoxy(23,12);clreol;
if puls = #80 then
begin
mr := mr - 1;
if mr < 0 then
mr := 0;
end;
if puls = #72 then
begin
mr := mr + 1;
if mr > asta then
mr := asta;
end;
fillchar(tomamos,sizeof(archilibros),0);
seek(fli,mr);
read(fli,tomamos);
until (mr > filesize(fli) - 1) or (puls = #27);
close(fli);
end;
end;



procedure barramenu(xp, yp : integer; pres : boolean);
begin
if pres = true then
begin
gotoxy(xp,yp);write('-------------------------');
gotoxy(xp - 1,yp + 1);write('|');
gotoxy(xp + 25,yp + 1);write('|');
gotoxy(xp,yp + 2);write('-------------------------');
end
else
begin
gotoxy(xp,yp);write(' ');
gotoxy(xp - 1,yp + 1);write(' ');
gotoxy(xp + 25,yp + 1);write(' ');
gotoxy(xp,yp + 2);write(' ');
end;
end;

procedure textomenu;
begin
clrscr;
gotoxy(20,1);write('*** Menu Libro ***');
gotoxy(20,2);write('------------------');
gotoxy(20,4);write('Entrada Libro');
gotoxy(20,6);write('Ver Libros');
gotoxy(20,8);write('Anular Libro');
gotoxy(20,10);write('Libros Vendidos Por A¤o');
gotoxy(20,12);write('Mayor Venta De Libro');
gotoxy(20,14);write('Salir');
textcolor(10);
gotoxy(48,4);write(chr(24));
gotoxy(48,14);write(chr(25));
gotoxy(48,6);write('U');
gotoxy(48,7);write('S');
gotoxy(48,8);write('E');
gotoxy(48,10);write('L');
gotoxy(48,11);write('A');
gotoxy(48,12);write('S');
textcolor(15);
gotoxy(20,18);write('... ESC = Salida Rapisa ...');
end;


procedure menu;
var
opcion, xb, yb : integer;
tr, temenu : char;
mas, final : boolean;
begin
xb := 19;
yb := 3;
textomenu;
barramenu(xb,yb,true);
final := false;
opcion := 1;
repeat
temenu := readkey;
barramenu(xb,yb,false);
if temenu = #80 then
begin
opcion := opcion + 1;
if opcion > 6 then
opcion := 6;
yb := yb + 2;
if yb > 13 then
yb := 13;
end;
if temenu = #72 then
begin
opcion := opcion - 1;
if opcion < 1 then
opcion := 1;
yb := yb - 2;
if yb < 3 then
yb := 3;
end;
case opcion of
1 : begin
barramenu(xb,yb,true);
end;
2 : begin
barramenu(xb,yb,true);
end;
3 : begin
barramenu(xb,yb,true);
end;
4 : begin
barramenu(xb,yb,true);
end;
5 : begin
barramenu(xb,yb,true);
end;
6 : begin
barramenu(xb,yb,true);
end;
end;
if temenu = #13 then
begin
case opcion of
1 : begin
mas := true;
repeat
if mas = true then
entrada_datos_libro;
mas := false;
gotoxy(10,24);write('Desea Entrar Mas Libros [S/N]..');
tr := readkey;
if tr in['s','S'] then
begin
mas := true;
gotoxy(10,24);clreol
end;
until tr in['n','N'];
clrscr;
textomenu;
barramenu(xb,yb,true);
end;
2 : begin
presenta_libros;
clrscr;
textomenu;
barramenu(xb,yb,true);
end;
3 : begin
clrscr;
writeln('****** NO ACTIBO ******');
delay(2000);
clrscr;
textomenu;
barramenu(xb,yb,true);
end;
4 : begin
presenta_ano_edicion;
clrscr;
textomenu;
barramenu(xb,yb,true);
end;
5 : begin
finales;
clrscr;
textomenu;
barramenu(xb,yb,true);
end;
6 : final := true;
end;
end;
until (final = true) or (temenu = #27);

end;
begin
clrscr;
textcolor(15);
usado := false;
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