• Viernes 8 de Noviembre de 2024, 07:59

Mostrar Mensajes

Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.


Mensajes - twipsy

Páginas: [1]
1
Pascal / elminacion de registros en archivo
« en: Viernes 21 de Enero de 2011, 20:35 »
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

2
La taberna del BIT / Re: ¿porqué Los Nicks?
« en: Martes 18 de Enero de 2011, 20:41 »
mi nick es el nombre de la mascota de la expo 2000 de Hanover creado por Javier Mariscal. tambien es el nombre de una serie de television con dicha mascota de 23 capitulos que se emitio en Televisio de Catalunya

3
Pascal / tratamiento de archivos
« en: Martes 18 de Enero de 2011, 20:35 »
buenas tardes. alguien podria explicarme un poco como funciona el tema del tratamiento de ficheros?

4
Pascal / Re: metodos de ordenacion
« en: Viernes 10 de Diciembre de 2010, 21:24 »
por fin he conseguido terminarlo y ya esta entregado. muchas gracias por la ayuda

5
Pascal / Re: metodos de ordenacion
« en: Viernes 10 de Diciembre de 2010, 16:14 »
ya he arreglado el switch y funciona perfectamente. ahora debo arreglar la parte del burbuja ya que no me sale el resultado que debe salir (directamente solo ordena 1 numero, el resto nada).

estoy trabajando en la solucion pero me seria de ayuda si me pudierais decir que debo cambiar del codigo

6
Pascal / metodos de ordenacion
« en: Jueves 9 de Diciembre de 2010, 22:51 »
estoy haciendo unos ejercicios de ordenacion que me ha mandado el g*********. el caso es que en el de ordenacion switch me da un error de compilacion que o acabo de entender
Código: Pascal
  1. program vectores01;
  2.  
  3. uses crt;
  4. const mini = 1;
  5.       maxi = 100;
  6. type vector = array [mini..maxi] of integer;
  7.  
  8. Procedure despide;
  9.   begin
  10.     gotoxy(5,22); write('Pulsa una tecla para continuar...');
  11.     readkey;
  12.   end;
  13.  
  14. procedure escribe_vector(v:vector;N:byte);
  15. var i : integer;
  16.   begin
  17.     for i := mini to N do write(v[i]:5);
  18.     writeln;  
  19.   end;
  20.    
  21. procedure SeleccionDirecta (v : vector; N:byte);
  22. var vuelta,recorrido,
  23.     valor_mas_peque,pos_del_mas_peque : integer;
  24.   begin
  25.     escribe_vector(v,N);
  26.     for vuelta := mini to N - 1 do
  27.        begin
  28.          valor_mas_peque := v[vuelta];
  29.          pos_del_mas_peque := vuelta;
  30.          for recorrido := vuelta + 1 to N do
  31.             if v[recorrido] < valor_mas_peque
  32.                 then begin
  33.                        valor_mas_peque := v[recorrido];
  34.                        pos_del_mas_peque := recorrido;
  35.                      end;
  36.          if vuelta < pos_del_mas_peque
  37.             then begin
  38.                    v[pos_del_mas_peque] := v[vuelta];
  39.                    v[vuelta] := valor_mas_peque;
  40.                  end;
  41.          escribe_vector(v,N);               
  42.        end;
  43.     despide;
  44.   end;
  45.  
  46. procedure Baraja(v:vector;N:byte);
  47. Var
  48.    i, j, index : Integer;
  49.  
  50. Begin
  51.  For i := 1 to N do
  52.   Begin
  53.    index := v[i];
  54.    j := i-1;
  55.    While ((j >= 0) AND (v[j] > index)) do
  56.     Begin
  57.      v[j+1] := v[j];
  58.      j := j - 1;
  59.     End;
  60.    v[j+1] := index;
  61.    escribe_vector(v,N);
  62.    
  63.   End;
  64.  despide;
  65. end;
  66.  
  67. procedure Burbuja(v:vector;N:byte);
  68. var
  69. i,j,index:integer;
  70. begin
  71. for i:=1 to N-1 do
  72. for j:=1 to N-i do
  73. begin
  74. if v[i] > v[j+1] then
  75. begin
  76. index:=v[j];
  77. v[j]:=v[j+1];
  78. v[j+1]:=index;
  79. end;
  80. escribe_vector(v,N);
  81. end;
  82. despide;
  83. end;
  84.  
  85. procedure Switch(v:vector;N:byte);
  86.   var i,j,index:integer;
  87.    cambiado: boolean;
  88.  begin
  89.    clrscr;
  90.    repeat
  91.      cambiado := false;
  92.      for i := N downto 2 do
  93.      if v[i] < v[j+1] then {esta es la linea que da error}
  94.          begin
  95.          index:=v[j];
  96.          v[j]:=v[j+1];
  97.          v[j+1]:=index;
  98.          cambiado := true;              
  99.          end;
  100.    until not cambiado;                  
  101.    despide;
  102.  end;
  103.  
  104. procedure Sacudida(v:vector;N:byte);
  105.   begin
  106.     clrscr;
  107.     gotoxy(5,5); write('Este método aún no lo tengo implementado');
  108.     despide;
  109.   end;
  110.  
  111. procedure Shell(v:vector;N:byte);
  112.   begin
  113.     clrscr;
  114.     gotoxy(5,5); write('Este método aún no lo tengo implementado');
  115.     despide;
  116.   end;
  117.  
  118. procedure presenta(var N:byte);
  119.   begin
  120.     clrscr;
  121.     gotoxy(5,5); write('Este programa nos ordena un  vector de N valores');
  122.     gotoxy(5,6); write('Primero  me  rellena  aleatoriamente  el  vector');
  123.     gotoxy(5,7); write('Y luego el usuario elige un método de ordenación');
  124.     gotoxy(5,8); write('================================================');
  125.     gotoxy(5,10); write('Dime cuántos valores quieres que tengamos: ');
  126.     readln(N);
  127.     despide;
  128.   end;
  129.  
  130. procedure rellena_vector(var v:vector; N:byte);
  131. var i : integer;
  132.   begin
  133.     randomize;
  134.     for i := mini to N do v[i] := random(1000);
  135.   end;
  136.  
  137. function menu(v:vector;N:byte):char;
  138. var c : char;
  139.   begin
  140.     clrscr;
  141.     gotoxy(5,5);  write('M E N U   D E   O R D E N A C I O N');
  142.     gotoxy(5,6);  write('===================================');
  143.     gotoxy(5,8);  write('1.- Método selección directa');
  144.     gotoxy(5,9);  write('2.- Método baraja');
  145.     gotoxy(5,10); write('3.- Método burbuja');
  146.     gotoxy(5,11); write('4.- Método switch');
  147.     gotoxy(5,12); write('5.- Método sacudida');
  148.     gotoxy(5,13); write('6.- Método shell');
  149.     gotoxy(5,14); write('7.- Salir');
  150.     gotoxy(5,17); write('Pulsa el número de tu elección: ');
  151.     repeat c := readkey; until c IN ['1'..'7'];
  152.     clrscr;
  153.     case c of
  154.       '1' : SeleccionDirecta(v,N);
  155.       '2' : Baraja(v,N);
  156.       '3' : Burbuja(v,N);
  157.       '4' : Switch(v,N);
  158.       '5' : Sacudida(v,N);  {Opcional, sólo para sacar un 10}
  159.       '6' : Shell(v,N);     {Opcional, sólo para sacar un 10}
  160.     end;
  161.     menu := c;
  162.   end;
  163.  
  164. var v : vector;
  165.     N : byte;
  166. BEGIN
  167.   presenta(N);
  168.   rellena_vector(v,N);
  169.   repeat until menu(v,N) = '7';
  170. END.
  171.  
  172.  

el error en cuestion es el siguiente:
sin título.pas(94,20) Warning: Local variable "j" does not seem to be initialized (uso geany)

como lo puedo solucionar? esta bien el resto del codigo?

gracias y disculpen las molestias

7
Pascal / procedure dentro de procedure
« en: Jueves 9 de Diciembre de 2010, 20:04 »
tengo una pregunta. es posible insertar un procedure dentro de otro procedure?

8
La taberna del BIT / Re: Cuentame Un Chiste
« en: Martes 23 de Noviembre de 2010, 21:03 »
Esto es un francés, un japonés y un español. Dice el japonés:
-en mi país hay un tren tan rápido que se llama el tren bala
Y dice es francés:
-en mi país hay un tren que va por debajo del agua y que une París con Londres
Y dice el español:
-tss! en mi país hay un tren que va de Madrid a Sevilla, parando en ciudad-real, Puertollano y Córdoba. En 2 horas y un poquito.
Y dice el japonés:
-quilo! Que pasa? Que va volando?
Y dice el español:
-AVE

9
Pascal / Re: primera letra de cada palabra en mayusculas
« en: Martes 23 de Noviembre de 2010, 20:47 »
He conseguido resolver el ejercicio y lo he entregado. El profe me ha puesto un 7,5

10
La taberna del BIT / Re: me presento
« en: Sábado 20 de Noviembre de 2010, 13:11 »
en esa tarea de las mayusculas os pondre el codigo en cuanto pueda sacarlo de la particion de linux donde esta el archivo

muchas gracias por el recibimiento

11
Pascal / Re: contar pepes (o cualquier otra palabra)
« en: Sábado 20 de Noviembre de 2010, 13:09 »
muchas gracias

12
Pascal / contar pepes (o cualquier otra palabra)
« en: Sábado 20 de Noviembre de 2010, 11:34 »
tengo que hacer un programa que me cuente cuantas veces se repite la palabra "pepe" en una frase. el problema esta en que no consigo que me cuente un solo pepe. os mando el codigo a ver como se puede solucionar

Código: Pascal
  1. Program Pepe;
  2. uses crt;
  3. var
  4.     frase : string;
  5.     cont, i : integer;
  6. begin
  7.     clrscr;
  8.     writeln('Ingresa frase');
  9.     readln(frase);
  10.     cont := 1;
  11.     for i:=1 to length(frase) do
  12.         if frase[i] = 'pepe' then
  13.             cont := cont + 1;
  14.     writeln('La frase contiene ',cont,' pepe/s...');
  15.     readkey;
  16. end.
  17.  

13
Pascal / Re: primera letra de cada palabra en mayusculas
« en: Miércoles 17 de Noviembre de 2010, 17:40 »
os pondre el codigo en cuanto pueda conectar el disco duro externo. lo que si os puedo decir es que tengo el formulario hecho y me devuelve la frase tal cual esta escrita ya que no funciona la funcion. ni siquiera se como tengo que hacerlo ya que mi profe de programacion es un g*********(disculpen el comentario, pero me tiene frito)

14
Pascal / primera letra de cada palabra en mayusculas
« en: Martes 16 de Noviembre de 2010, 22:51 »
a ver si podeis ayudarme a hacer este programa:


Pedimos una frase por teclado y que nos la muestre de forma que todas las palabras estén con la primera letra en mayúscula y las demás en minúscula, Todo ello independientemente de cómo se hayan introducido.

muchas gracias

15
La taberna del BIT / me presento
« en: Martes 16 de Noviembre de 2010, 22:49 »
buenas noches, soy nuevo en este lugar y actualmente estoy estudiando programacion (eso si no envio a mi profe a la...), asi que espero que me ayudeis con las dudas que tenga

Páginas: [1]