• Martes 18 de Junio de 2019, 18:51

Autor Tema:  Ayuda Para Completar Un Programa  (Leído 764 veces)

akela

  • Nuevo Miembro
  • *
  • Mensajes: 2
    • Ver Perfil
Ayuda Para Completar Un Programa
« en: Sábado 14 de Agosto de 2004, 20:22 »
0
Necesito ayuda para completar un programa del cual me falta un solo paso.
El programa es basado en listas enlazadas simples sobre el manejo temporal de una biblioteca el cual solo manja los siguientes datos: titulo, autor y materia, el programa esta casi listo solo me hace falta generar la lista de los libros en orden alfabetico segun el autor lo cual no he podido realizar el resto de los listados ya los realice pero ese me tiene trancado ya que no se como hacerlo aqui les mando el codigo para ver si me pueden ayudar:

program trabajo;
uses crt;
type
apt=^nodo;
nodo=record
     titulo:string;
     autor:string;
     materia:string;
     sigte:apt;
     end;
var
com:apt;
M:char;
const
msg='Introduzca el Titulo del libro:';
msg1='Introduzca el Nombre del Autor:';
msg2='Introduzca el Nombre de la Materia:';
msg3='Presione una tecla para continuar';
procedure crear(var com:apt);
var
nuevo:apt;
begin
new(nuevo);
nuevo^.titulo:='Trabajo de procesamiento de datos 1';
nuevo^.autor:='Ambar Martinez y Abraham Quevedo';
nuevo^.materia:='PRD 353';
nuevo^.sigte:=nil;
com:=nuevo;
end;{fin crear}

procedure incluir(var com:apt);
var
nuevo:apt;
begin
    new(nuevo);
    writeln(msg);
    readln(nuevo^.titulo);
    writeln(msg1);
    readln(nuevo^.autor);
    writeln(msg2);
    readln(nuevo^.materia);
    nuevo^.sigte:=com;
    com:=nuevo;
    writeln(msg3);
    M:=readkey;
   end;{fin incluir}

 procedure modificar(var com:apt);
 var
  r:apt;
  valor:string;
  begin
   if (com=nil) then writeln('No existe lista')
   else
    begin
     writeln('Ingrese el titulo del libro a modificar: ');
     readln(valor);
     r:=com;
     while(r<>nil) do
     if valor=r^.titulo then
     begin
     writeln('Datos anteriores');
      writeln('Titulo:  ',r^.titulo);
      writeln('Autor:   ',r^.autor);
      writeln('Materia: ',r^.materia);
      writeln(' ');
      writeln('debe escribir un nuevo titulo lo dem s se puede escribir igual');
       writeln(msg);
    readln(r^.titulo);
    writeln(msg1);
    readln(r^.autor);
    writeln(msg2);
    readln(r^.materia);
    writeln('datos modificados');
    writeln('Titulo:   ',r^.titulo);
    writeln('Autor:    ',r^.autor);
    writeln('Materia:  ',r^.materia);
    writeln(' ');
     end
     else
      r:=r^.sigte;
     end;
     writeln('presione una tecla para continuar');
     M:=readkey;
    end;{fin modificar}

procedure listar(var com:apt);
var
q:apt;
begin
 if (com=nil) then writeln('No existen nodos')
 else
  begin
   q:=com;
    while (q<>nil) do
     begin
      writeln('Titulo:  ',q^.titulo);
      writeln('Autor:   ',q^.autor);
      writeln('Materia: ',q^.materia);
      writeln(' ');
      q:=q^.sigte;
      end;
     end;
     writeln('presione una tecla para continuar');
     M:=readkey;
   end;{fin listar}

procedure listar2(var com:apt);
var
q:apt;
inicial:string;
begin
 if (com=nil) then writeln('No existen nodos')
 else
  begin
   q:=com;
   writeln('Introduzca la inicial del autor para ver los libros');
     readln(inicial);
   while (q<>nil) do
     begin
      if inicial=q^.autor[1] then
      begin
      writeln('Titulo:   ',q^.titulo);
      writeln('Autor:    ',q^.autor);
      writeln('Materia:  ',q^.materia);
      writeln(' ');
      q:=q^.sigte;
      end
      else
      q:=q^.sigte;
      end;
     end;
     writeln('presione una tecla para continuar');
     M:=readkey;
   end;{fin listar 2}

procedure listar3(var com:apt);
var
q:apt;
inicial:string;
begin
 if (com=nil) then writeln('No existen nodos')
 else
  begin
   q:=com;
   writeln('Introduzca el titulo del libro');
     readln(inicial);
   while (q<>nil) do
     begin
      if inicial=q^.titulo then
      begin
      writeln('Titulo:   ',q^.titulo);
      writeln('Autor:    ',q^.autor);
      writeln('Materia:  ',q^.materia);
      writeln(' ');
      q:=q^.sigte;
      end
      else
      q:=q^.sigte;
      end;
     end;
     writeln('presione una tecla para continuar');
     M:=readkey;
   end;{fin listar 3}

procedure listar4(var com:apt);
var
q:apt;
inicial:string;
begin
 if (com=nil) then writeln('No existen nodos')
 else
  begin
   q:=com;
   writeln('Introduzca la materia a buscar');
     readln(inicial);
   while (q<>nil) do
     begin
      if inicial=q^.materia then
      begin
      writeln('Titulo:   ',q^.titulo);
      writeln('Autor:    ',q^.autor);
      writeln('Materia:  ',q^.materia);
      writeln(' ');
      q:=q^.sigte;
      end
      else
      q:=q^.sigte;
      end;
     end;
     writeln('presione una tecla para continuar');
     M:=readkey;
   end;{fin listar 4}

procedure listar5(var com:apt);
var
q:apt;
aux:char;
begin
 if (com=nil) then writeln('No existen nodos')
 else
  begin
   q:=com;
    while (q<>nil) do

      if aux=q^.autor[1] then
      begin
      writeln('Titulo:  ',q^.titulo);
      writeln('Autor:   ',q^.autor);
      writeln('Materia: ',q^.materia);
      writeln(' ');
      end
      else
      q:=q^.sigte;
     end;

     writeln('presione una tecla para continuar');
     M:=readkey;
   end;{fin listar 5}



 function eliminar(var com:apt): string;
 var
 p:apt;
 valor:string;
 begin
      begin
          writeln('Ingrese el Titulo del libro a Eliminar');
          readln(valor);
          p:=com;
          if (valor=p^.titulo) then
            begin
             eliminar:=p^.titulo;
             eliminar:=p^.autor;
             eliminar:=p^.materia;
             p:=com;
             com:=p^.sigte;
             dispose(p);
          end
            else
             p:=p^.sigte;
          end;
     writeln('Se ha eliminado el libro ');
     writeln('presione cualquier tecla para volver al menu');
     M:=readkey;
 end;

 procedure menu;
 var
 opcion:char;
 begin
 clrscr;
 repeat
  clrscr;
 textcolor(10);GOTOXY(12,2);writeln('TRABAJO PRACTICO II CORTE ABRAHAM QUEVEDO Y AMBAR MARTINEZ');
  GOTOXY(35,4);writeln('MENU PRINCIPAL');
  GOTOXY(15,6);writeln('1.-Incluir Libro');
  GOTOXY(15,8);writeln('2.-Modificar Informacion del Libro');
  GOTOXY(15,10);writeln('3.-Ver todos los libros en orden de inclusi¢n');
  GOTOXY(15,12);writeln('4.-Ver libros por titulo especifico');
  GOTOXY(15,14);writeln('5.-Ver libros por inicial del autor');
  GOTOXY(15,16);writeln('6.-Ver libros por materia especifica');
  GOTOXY(15,18);writeln('7.-Eliminar el libro al comienzo de la lista');
  GOTOXY(15,20);writeln('9.-Salir del programa');
  GOTOXY(15,22);writeln('ELIJA UNA OPCION');
  repeat
  opcion:=readkey;
  until opcion in ['1'..'9'];
  clrscr;
  case opcion of
   '1':incluir(com);
   '2':modificar(com);
   '3':listar(com);
   '4':listar3(com);
   '5':listar2(com);
   '6':listar4(com);
   '7':eliminar(com);
   '8':listar5(com);
   end;
   until opcion='9'
   end;

 begin{PROGRAMA PRINCIPAL}
 clrscr;
 com:=nil;
 crear(com);
 menu;
 end.

el procedimiento listar5 es el que tengo destinado para la lista por orden alfabetico aunque no esta reflejado en la pantalla de menu pero si en las opciones agradesco pronta ayuda de todas formas adjunto el codigo fuente...
El mensaje contiene 1 archivo adjunto. Debes ingresar o registrarte para poder verlo y descargarlo.