• Sábado 20 de Abril de 2024, 17:47
« anterior próximo »
Páginas: [1]

Autor Tema:  elminacion de registros en archivo  (Leído 2423 veces)

twipsy

  • Nuevo Miembro
  • *
  • Mensajes: 11
    • Ver Perfil
elminacion de registros en archivo
« en: Viernes 21 de Enero de 2011, 20:35 »
0
tengo un problema con un programa que tengo que hacer. el programa trata sobre una agenda de amigos en el que los datos se guardan en un archivo y la parte que me da problemas consiste en lo siguiente

-compactar los datos de forma que eliminemos los marcados como borrados (o sea, que si teníamos 23 ocupados y 5 estaban marcados como borrados, al final he de tener 18 ocupados, 0 marcados como borrados y han de ocupar las 18 primeras posiciones en el vector).

como podreis observar en el codigo, todo el programa esta bien excepto el procedure en el que se eliminan esos datos borrados
Código: Pascal
  1. program registres;
  2.  
  3. uses crt;
  4. {
  5. type vector = array [1..100] of integer;
  6. type matriz = array [1..10,1..5] of integer;
  7. type mezcla = array [1..10] of matriz;}
  8.  
  9. type persona = record
  10.                  nombre    : string[15];
  11.                  ap1,ap2   : string[12];
  12.                  varon     : boolean;
  13.                  direccion : string[30];
  14.                  any_nac   : integer;
  15.                  mes_nac   : byte;
  16.                  dia_nac   : byte;
  17.                  borrado   : boolean;
  18.                end;
  19. type vecpersonas = array [1..100] of persona;              
  20. type agenda = record
  21.                 num_ocupados : byte;
  22.                 num_borrados : byte;
  23.                 personas     : vecpersonas;
  24.               end;
  25. Type fichero = file of agenda;
  26.              
  27. procedure pulsa_tecla;
  28.   begin
  29.     gotoxy(1,24); write('Pulsa una tecla para continuar...');
  30.     readkey;
  31.     clrscr;  
  32.   end;
  33.    
  34. procedure presenta;
  35.   begin
  36.     clrscr;
  37.     gotoxy(5,10);
  38.     write('Programa de mantenimiento de una agenda');
  39.     gotoxy(5,11);
  40.     write('=======================================');
  41.     pulsa_tecla;
  42.   end;  
  43.  
  44. procedure ficha;
  45.   begin
  46.     clrscr;
  47.     gotoxy(10,5);  write('Persona num :');
  48.     gotoxy(10,7);  write('Nombre      :');
  49.     gotoxy(10,8);  write('Apellido 1  :');
  50.     gotoxy(10,9);  write('Apellido 2  :');
  51.     gotoxy(10,10); write('Varón (s/n)?:');
  52.     gotoxy(10,11); write('Dia nacim.  :');
  53.     gotoxy(10,12); write('Mes nacim.  :');
  54.     gotoxy(10,13); write('Any nacim.  :');
  55.   end;
  56.  
  57. procedure muestra(i:byte; p:persona);
  58.   begin
  59.     ficha;
  60.     gotoxy(24,5);  write(i);
  61.     gotoxy(24,7);  write(p.nombre);
  62.     gotoxy(24,8);  write(p.Ap1);
  63.     gotoxy(24,9);  write(p.Ap2);
  64.     gotoxy(24,10); if p.varon then write('Sí') else write('No');
  65.     gotoxy(24,11); write(p.dia_nac);
  66.     gotoxy(24,12); write(p.mes_nac);
  67.     gotoxy(24,13); write(p.any_nac);
  68.     pulsa_tecla;
  69.   end;
  70.    
  71. procedure lee(i:byte; var p:persona);
  72. var op : char;
  73.   begin
  74.     ficha;
  75.     gotoxy(24,5);  write(i);
  76.     gotoxy(24,7);  readln(p.nombre);
  77.     gotoxy(24,8);  readln(p.Ap1);
  78.     gotoxy(24,9);  readln(p.Ap2);
  79.     gotoxy(24,10); repeat op := readkey until op in ['s','S','n','N'];
  80.         write(op);
  81.         if op in ['s','S'] then p.varon := true
  82.                            else p.varon := false;
  83.     gotoxy(24,11); readln(p.dia_nac);
  84.     gotoxy(24,12); readln(p.mes_nac);
  85.     gotoxy(24,13); readln(p.any_nac);
  86.     p.borrado := false;
  87.     pulsa_tecla;
  88.   end;
  89.  
  90.  procedure nuevo(var a:agenda);
  91.  var p : persona;
  92.   begin
  93.     inc(a.num_ocupados);
  94.     lee(a.num_ocupados,p);
  95.     a.personas[a.num_ocupados] := p;
  96.   end;
  97.  
  98. procedure modifica(var a:agenda);
  99. var num : byte;
  100.     p   : persona;
  101.   begin
  102.     clrscr;
  103.     gotoxy(10,5); write('Dime el número de persona que quieres modificar: ');
  104.     readln(num);
  105.     lee(num,p);
  106.     a.personas[num] := p;
  107.   end;
  108.  
  109. procedure lista(var a:agenda);
  110. var i : byte;
  111.   begin
  112.     clrscr;
  113.     if (a.num_ocupados - a.num_borrados) = 0
  114.        then begin
  115.               gotoxy(10,5); write('La agenda está vacía');  
  116.             end
  117.        else for i := 1 to a.num_ocupados do
  118.                            if not (a.personas[i].borrado)
  119.                                  then muestra(i,a.personas[i]);
  120.     pulsa_tecla;                
  121.   end;
  122.  
  123. procedure borra(var a:agenda);
  124. var num : byte;
  125.   begin
  126.     clrscr;
  127.     gotoxy(10,5); write('Dime el número de persona que quieres borrar: ');
  128.     readln(num);
  129.     a.personas[num].borrado := true;
  130.     inc(a.num_borrados);
  131.   end;
  132.  
  133. procedure recupera(var a:agenda);
  134. var num : byte;
  135.   begin
  136.     clrscr;
  137.     gotoxy(10,5); write('Dime el número de registro que quieres recuperar: ');
  138.     readln(num);
  139.     a.personas[num].borrado := false;
  140.     dec(a.num_borrados);
  141.   end;
  142.  
  143. procedure elimina(var a:agenda); {este es la parte que no me funciona}
  144.  var num: byte;
  145.  var i: byte;
  146.   begin
  147.   for num:= 1 to a.num_ocupados do
  148.     begin
  149.         if not a.personas[num].borrado then
  150.             begin
  151.                 inc (i);
  152.                     a.personas[i] := a.personas[num];
  153.             end;
  154.     end;
  155.  
  156. a.num_ocupados := num;
  157. a.num_borrados := 0;
  158.   end;
  159.  
  160. procedure menu(var a:agenda);
  161. var op : char;
  162.   begin
  163.     repeat
  164.       clrscr;
  165.       gotoxy(10,5);  write('M E N U');
  166.       gotoxy(10,6);  write('=======');
  167.       gotoxy(10,8);  write('1 - Nuev@ amig@');
  168.       gotoxy(10,9);  write('2 - Modifica amig@');
  169.       gotoxy(10,10); write('3 - Lista amig@s');
  170.       gotoxy(10,11); write('4 - Elimina amig@s');
  171.       gotoxy(10,12); write('5 - Recupera amig@s');
  172.       gotoxy(10,13); write('6 - Compacta amig@s');
  173.       gotoxy(10,14); write('7 - Salir del programa');
  174.       gotoxy(10,17); write('Pulsa el número de tu elección: ');
  175.       repeat op := readkey until op IN ['1'..'7'];
  176.       case op of
  177.         '1' : nuevo(a);
  178.         '2' : modifica(a);
  179.         '3' : lista(a);
  180.         '4' : borra(a);
  181.         '5' : recupera(a);
  182.         '6' : elimina(a);
  183.       end;      
  184.     until op = '7';  
  185.   end;  
  186.  
  187. procedure lee_del_fichero(var f:fichero; var a:agenda);
  188.   begin
  189.     assign(f,'agenda.dat');
  190.     {$I-} reset(f); {$I+}
  191.     if IOresult > 0 then begin
  192.                            a.num_ocupados := 0;
  193.                            a.num_borrados := 0;                    
  194.                          end
  195.                     else read(f,a);  
  196.   end;
  197.        
  198. procedure guarda_al_fichero(var f:fichero; a:agenda);
  199.   begin
  200.     rewrite(f);
  201.     write(f,a);
  202.     close(f);
  203.   end;
  204.        
  205. var a:agenda;  
  206.     f:fichero;
  207. begin
  208.   presenta;
  209.   lee_del_fichero(f,a);
  210.   menu(a);
  211.   guarda_al_fichero(f,a);
  212. end.          
  213.  
  214.  
como puedo solucionarlo?
gracias y disculpen las molestias, pero empiezo a creer que soy un negado en la programacion

epayan

  • Miembro activo
  • **
  • Mensajes: 41
  • Nacionalidad: mx
    • Ver Perfil
    • http://www.pillin-slk.blogspot.com
Re: elminacion de registros en archivo
« Respuesta #1 en: Domingo 3 de Abril de 2011, 03:29 »
0
aqui un code con los que requieres de archivos y registros y su tratamiento: alta, modificaciones, bajas fisicas, consultas y listados.

Código: Pascal
  1.  
  2.  
  3. program ejemplo_archivos;
  4. uses crt,dos,sysutils;
  5. {en este ejemplo se refleja  el uso de registros con archivos
  6. haciendo el uso de insercion, modificacion , y borrado fisico de los
  7. registros}
  8.  
  9. type
  10.       TipoRegistro = Record
  11.       Numero : Longint;
  12.       Nombre : String[40];
  13.       Direccion : String[40];
  14.       Telefono : String[10];
  15. End;
  16.  
  17. TipoArchivo = File Of TipoRegistro;
  18.  
  19. {*------|------|------|------|------|------|------|------|------|------|----*}
  20.  
  21. Procedure AperturaDeArchivo(var TArchivo:Tipoarchivo);
  22. var
  23.    Error: Word;
  24.    Tecla:Char;
  25. Begin
  26.     Assign(TArchivo,'c:Archivo.dat');
  27.    {$I-}
  28.    Reset(TArchivo);
  29.    Error:=IOResult;
  30.    {$I+}
  31.    If Error <> 0 Then
  32.       Begin
  33.               textattr:=14+4*16;
  34.               gotoxy(4,24);write('Creando Bases Temporal !! ');
  35.               rewrite(TArchivo);
  36.       End;
  37. End;
  38.  
  39. {*------|------|------|------|------|------|------|------|------|------|----*}
  40.  
  41. procedure AperturaDeArchivoTemporal(var TTmpAArchivo:TipoArchivo);
  42. var
  43.    Error: word;
  44.    Tecla:Char;
  45. Begin
  46.      Assign(TTmpAArchivo,'c:Archivo.Tmp');
  47.      {$I-}
  48.      Reset(TTmpAArchivo);
  49.      Error:=IOResult;
  50.      {$I+}
  51.      If Error <> 0 Then
  52.         Begin
  53.                textattr:=14+4*16;
  54.                 gotoxy(4,24);write('Creando Bases Temporal !! ');
  55.                 rewrite(TTmpAArchivo);
  56.         End;
  57. End;
  58.  
  59. {*------|------|------|------|------|------|------|------|------|------|----*}
  60.  
  61. function BuscaRegistro(Var AArchivo:tipoArchivo;Var TIRegistro:TipoRegistro;Numero:LongInt):longint;
  62. Var
  63.    Encontrado:longint;
  64. Begin
  65.        textattr:=14+4*16;
  66.        gotoxy(4,24);write('Buscando Registro..');
  67.        Encontrado :=-1; {inicializamos Encontrado a -1, valor inexistente}
  68.        Seek(AArchivo,0); {Posicionamos al inicio el puntero del archivo}
  69.        While not EOF(AArchivo) do {iniciamos ciclode recorrido del archivo}
  70.         Begin
  71.               Read(AArchivo,TIRegistro); {Leemos el Registro segun posicion del puntero}
  72.               IF TIRegistro.Numero = Numero then{Comparamos el n£mero de registo con el numero solicitado}
  73.                   Begin {si es igual el registro encontrado}
  74.                          Encontrado:=FilePos(AArchivo)-1; {se envia la posicion del registro hallado}
  75.                          Seek(AARchivo,FileSize(AArchivo)); {se envia el puntero al final del archivo para terminar ciclo}
  76.                  End;
  77.          End;
  78.          IF Encontrado <> -1 then {si Encontrado no es igual a -1 , mandamos el valor de la funcion}
  79.              Begin
  80.                      BuscaRegistro:=Encontrado;
  81.              End
  82.          Else {si no fue encontrado regresamos -1 a la busqueda}
  83.              Begin
  84.                      BuscaRegistro:=-1;
  85.              End;
  86.          textattr:=0+2*16;
  87.          gotoxy(4,24);write(' ');
  88. End;
  89.  
  90. {*------|------|------|------|------|------|------|------|------|------|----*}
  91. Procedure BorraRegistro(Var AArchivo:Tipoarchivo; TIRegistro:TipoRegistro;Numero:LongInt);
  92. var
  93.     TmpArchivo:tipoArchivo;
  94.     TmpRegistro:tipoRegistro;
  95.     EncontradoB:longint;
  96. Begin {Buscamos si existe el Registro a borrar}
  97.         EncontradoB:=BuscaRegistro(AArchivo,TIRegistro,Numero);
  98.         IF EncontradoB <> -1 then {Si existe}
  99.            Begin
  100.               seek(AArchivo,0); {nos posicionamos al inicio del archivo}
  101.               While not eof(AArchivo) do {hacemos un ciclo de vaciado de registros a un archivo temporal menos el eliminado}
  102.                     Begin
  103.                         Read(AArchivo,TIRegistro); {leemos el registro completo}
  104.                         IF TIRegistro.Numero <> Numero then {comparamos el campo Registro.numero con el solicitado }
  105.                            Begin
  106.                                AperturaDeArchivoTemporal(TmpArchivo); {creamos el temporal}
  107.                                seek (TmpArchivo,filesize(TmpArchivo)); {nos posicionamos al final del archivo temporal}
  108.                                write(TmpArchivo,TIRegistro); {escribimos el registro}
  109.                                Close(TmpArchivo);{cerramos el registro}
  110.                            End;
  111.                     End;
  112.               Close(AArchivo); {cerramos la bd de trabajo}
  113.               erase(AArchivo); {eliminamos la bd de trabajo}
  114.               { se puede usar en caso de no contar con la utileria sysutils
  115.                    Assign(TmpArchivo,'c:Archivo.Tmp');
  116.                    Rename(TmpArchivo,'c:Archivo.dat'), en el caso de RenameFile }
  117.               If RenameFile ('c:Archivo.tmp','c:Archivo.dat') then
  118.                  begin
  119.                       Gotoxy(3,24);write('Registro Eliminado');
  120.                       Delay(600);
  121.                  End;
  122.            End {encontrado <> -1}
  123.        Else
  124.            Begin
  125.                textattr:=14+4*16;
  126.                gotoxy(27,12);write('No Hallado ......!! ');
  127.                Delay(1000);
  128.                Close(AArchivo); {cerramos la bd de trabajo}
  129.            End;
  130. End;
  131.  
  132.  
  133. {*------|------|------|------|------|------|------|------|------|------|----*}
  134.  
  135. Procedure InicializaRegistro(Var TiRegistro : TipoRegistro);
  136. Begin
  137.        TiRegistro.Numero :=0;
  138.        TiRegistro.Nombre :='';
  139.        TiRegistro.Direccion:='';
  140.        TiRegistro.Telefono :='';
  141. End;
  142.  
  143. {*------|------|------|------|------|------|------|------|------|------|----*}
  144.  
  145. Procedure Alta(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
  146. Var
  147.     Encontrado:Longint;
  148.     TmpNumero:Longint;
  149.     Salir:char;
  150. Begin
  151.        Repeat
  152.               InicializaRegistro(TiRegistro);
  153.               textattr:=7+0*16;{atributos de pantalla}
  154.               Clrscr;
  155.               Gotoxy(25,4);write('Alta de Registro');
  156.               Gotoxy(25,10);write('Proporcione Numero : ');
  157.               readln(TmpNumero);
  158.  
  159.               AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  160.               Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TmpNumero); {buscamos el registro}
  161.               Close(Tiarchivo); {cerramos el archivo}
  162.               If Encontrado = -1 Then {no existe}
  163.                  Begin
  164.                         textattr:=7+0*16;{atributos de pantalla}
  165.                         Tiregistro.Numero:=TmpNumero;
  166.                         Gotoxy(25,12);write('Proporcione Nombre : ');
  167.                         readln(TiRegistro.Nombre );
  168.                         Gotoxy(25,14);write('Proporcione Direccion : ');
  169.                         readln(TiRegistro.Direccion );
  170.                         Gotoxy(25,16);write('Proporcione Tel‚fono : ');
  171.                         readln(TiRegistro.Telefono);
  172.                         {posicionamos el puntero al final del archivo y guardamos}
  173.                          AperturaDeArchivo(TIArchivo);
  174.                          Seek (TIArchivo,filesize(TIArchivo));{posicionamos el puntero al final del archivo}
  175.                          Write(TiArchivo,TiRegistro);{guardamos el registro al final del archivo}
  176.                          Close(TiArchivo);
  177.                          delay(100);
  178.                  End
  179.              else {si existe}
  180.                  begin
  181.                         Gotoxy(15,17);write('Registro Existente,Pulse Enter');
  182.                         readkey;
  183.                  end;
  184.              gotoxy(20,22);write('Desea Continuar Almacenando Registros [S/N]');
  185.              Salir:=Readkey;
  186.        Until (Salir='n') or (Salir='N');
  187. End;
  188.  
  189. {*------|------|------|------|------|------|------|------|------|------|----*}
  190.  
  191. Procedure Baja(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
  192. Var
  193.    Encontrado:Longint;
  194.    TmpNumero:Longint;
  195.    Salir:char;
  196. Begin
  197.        Repeat
  198.                InicializaRegistro(TiRegistro);
  199.                textattr:=7+0*16;{atributos de pantalla}
  200.                Clrscr;
  201.                Gotoxy(25,4);write('Baja de Registro');
  202.                Gotoxy(25,10);write('Proporcione Numero : ');
  203.                readln(TmpNumero);
  204.                AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  205.                Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TmpNumero); {buscamos el registro}
  206.                Close(Tiarchivo); {cerramos el archivo}
  207.                If Encontrado <> -1 Then {existe}
  208.                   Begin
  209.                         AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  210.                         BorraRegistro(Tiarchivo,TIRegistro,TmpNumero); {llamada al procedimiento de borrado fisico}
  211.                   End
  212.                Else {si no esxiste el registro}
  213.                   Begin
  214.                         Gotoxy(15,17);write('Registro No Existe,Pulse Enter');
  215.                         readkey;
  216.                  End;
  217.                Gotoxy(20,22);Write('Desea Continuar Dando de Baja a Registros [S/N]');
  218.                Salir:=Readkey;
  219.      Until (Salir='n') or (Salir='N');
  220.  
  221. End;
  222.  
  223. {*------|------|------|------|------|------|------|------|------|------|----*}
  224.  
  225. Procedure Modificacion(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
  226. Var
  227.     Encontrado:Longint;
  228.     Salir:char;
  229. Begin
  230.         Repeat
  231.                 InicializaRegistro(TiRegistro);
  232.                 textattr:=7+0*16;{atributos de pantalla}
  233.                 Clrscr;
  234.                 Gotoxy(25,4);write('Modificacion de Registro');
  235.                 Gotoxy(25,10);write('Proporcione Numero : ');
  236.                 readln(TiRegistro.Numero);
  237.                 AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  238.                 Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TiRegistro.Numero); {buscamos el registro}
  239.                 Close(Tiarchivo); {cerramos el archivo}
  240.                 If Encontrado <> -1 Then {existe}
  241.                    Begin
  242.                           textattr:=7+0*16;{atributos de pantalla}
  243.                           Gotoxy(25,12);write('Proporcione Nombre : ');
  244.                           readln(TiRegistro.Nombre );
  245.                           Gotoxy(25,14);write('Proporcione Direccion : ');
  246.                           readln(TiRegistro.Direccion );
  247.                           Gotoxy(25,16);write('Proporcione Tel‚fono : ');
  248.                           readln(TiRegistro.Telefono);
  249.                           AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  250.                           seek (TIArchivo,Encontrado);{posicionamos el p£ntero en la posici¢n donde se   encontr¢ el registro en el archivo}
  251.                           write(TiArchivo,TiRegistro);{escribimos el registor modificado}
  252.                           close(TiArchivo);
  253.                   End
  254.              Else
  255.                   Begin
  256.                          Gotoxy(15,17);write('Registro No Existe,Pulse Enter');
  257.                          readkey;
  258.                   End;
  259.             Gotoxy(20,22);Write('Desea Continuar Modificando Registros [S/N]');
  260.             Salir:=Readkey;
  261.       Until (Salir='n') or (Salir='N');
  262. End;
  263.  
  264. {*------|------|------|------|------|------|------|------|------|------|----*}
  265.  
  266. Procedure Consulta(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
  267. Var
  268.     Encontrado:Longint;
  269.     Salir:char;
  270. Begin
  271.        Repeat
  272.                 InicializaRegistro(TiRegistro);
  273.                 textattr:=7+0*16;{atributos de pantalla}
  274.                 Clrscr;
  275.                 Gotoxy(25,4);write('Consulta de Registro');
  276.                 Gotoxy(25,10);write('Proporcione Numero : ');
  277.                 readln(TiRegistro.Numero);
  278.                 AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  279.                 Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TiRegistro.Numero); {buscamos el registro}
  280.                 Close(Tiarchivo); {cerramos el archivo}
  281.                 If Encontrado <> -1 Then {existe}
  282.                    Begin
  283.                         textattr:=7+0*16;{atributos de pantalla}
  284.                         Gotoxy(25,12);write('Nombre : ',TiRegistro.Nombre );
  285.                         Gotoxy(25,14);write('Direccion : ',TiRegistro.Direccion );
  286.                         Gotoxy(25,16);write('Tel‚fono : ',TiRegistro.Telefono);
  287.                    End
  288.                 Else {si no existe el registro}
  289.                    Begin
  290.                          Gotoxy(15,17);write('Registro No Existe,Pulse Enter');
  291.                          readkey;
  292.                    End;
  293.                Gotoxy(20,22);Write('Desea Continuar Consultando Registros [S/N]');
  294.                Salir:=Readkey;
  295.      Until (Salir='n') or (Salir='N');
  296. End;
  297.  
  298. {*------|------|------|------|------|------|------|------|------|------|----*}
  299.  
  300. Procedure Listado(TiRegistro:TipoRegistro;var TiArchivo:tipoArchivo);
  301. Var
  302.     Contador:integer;
  303. Begin
  304.        textattr:=7+0*16;{atributos de pantalla}
  305.        Clrscr;
  306.        Gotoxy(2,2);write('Numero Nombre Direccion');
  307.        Seek(TiArchivo,0); {Posicionamos al inicio el puntero del archivo}
  308.        contador:=3;
  309.        While not eof(TiArchivo) do
  310.            Begin
  311.                  Read(TiArchivo,TIRegistro); {Leemos el Registro segun posicion del puntero}
  312.                  gotoxy(2,contador); Write(TIRegistro.Numero);
  313.                  gotoxy(17,contador); Write(TIRegistro.Nombre);
  314.                  gotoxy(47,contador); Write(TIRegistro.Direccion);
  315.                  inc(contador);
  316.           End;
  317.       readkey;
  318. End;
  319.  
  320. {*------|------|------|------|------|------|------|------|------|------|----*}
  321.  
  322. Procedure Menu(TiRegistro:TipoRegistro; Var TiArchivo:TipoArchivo);
  323. Var
  324.     Tecla:Char;
  325. Begin
  326.       ClrScr;
  327.       Repeat
  328.                textattr:=7+0*16;{atributos de pantalla}
  329.                ClrScr;
  330.                Gotoxy(25,6);Write('Alta de Registro ..............[1]');
  331.                Gotoxy(25,8);Write('Modificacion de Registro ......[2]');
  332.                Gotoxy(25,10);Write('Baja de Registro ..............[3]');
  333.                Gotoxy(25,12);Write('Consulta de Registro ..........[4]');
  334.                Gotoxy(25,14);Write('Listado de Registros...........[5]');
  335.                Gotoxy(25,16);Write('Salir .........................[6]');
  336.                Tecla:=Readkey;
  337.                Case Tecla of
  338.                          '1':Begin
  339.                                     Alta(Tiregistro,TiArchivo);
  340.                              End;
  341.                          '2':Begin
  342.                                    Modificacion(TiRegistro,TiArchivo );
  343.                              End;
  344.                          '3':Begin
  345.                                    Baja(TiRegistro,TiArchivo );
  346.                              End;
  347.                         '4':Begin
  348.                                   Consulta(TiRegistro,TiArchivo );
  349.                             End;
  350.                         '5':Begin
  351.                                   AperturaDeArchivo(Tiarchivo);
  352.                                   Listado(TiRegistro,TiArchivo);
  353.                                   Close(TiArchivo);
  354.                             End;
  355.                End;
  356.        Until Tecla = '6';
  357. end;
  358.  
  359. {*------|------|------|------|------|------|------|------|------|------|----*}
  360.  
  361. { Cuerpo del programa }
  362. var
  363.     TiArchivo : TipoArchivo;
  364.     TiRegistro : TipoRegistro;
  365. Begin
  366.      Menu(TiRegistro,TiArchivo);
  367. end.
  368.  
  369.  
  370.  
Páginas: [1]
« anterior próximo »