[ Foro de Pascal ]
Hola a todos, soy nuevo en esto de los foros, estoy haciendo un ejercicio en pascal, y necesito ayuda porque no se como borrar un elemento de un registro, leí que con un procedure puedo borrar un registro ya guardado en un record, solo que no he encontrado algun ejemplo. Agradeceria cual ayuda que pudieran darme... Gracias de antemano.
No entiendo a qué te refieres. Para mí, un "registro" es lo mismo que un "record". Pon un fuente de ejemplo que deje ver la duda exacta.
Ok, sorry, soy nuevo en esto, te anexo el código que estoy trabajando. El procedure de eliminar el registro es el que no logro armar..
program estadistica;
uses
crt;
const
tipove : array[1..4] of string[20] = (
'particulares','porpuesto','taxi','transporte publicos');
acion : array['A'..'B'] of string[5] = (
'Sale','Entra');
type
regvehiculo = record
nplaca : string[20];
npasaj : integer;
alcabala : string[20];
fecha : string[10];
tipovl : byte;
salent : string[5];
end;
var
datos : array[0..200] of regvehiculo;
cont : integer;
tecla : char;
procedure entrada_datos;
var
d : integer;
cu : char;
begin
writeln('***** Entrada De Datos Vehiculos *****');
writeln;
write(' Numero Placa : ');
readln(datos[cont].nplaca);
for d := 1 to length(datos[cont].nplaca) do
datos[cont].nplaca[d] := upcase(datos[cont].nplaca[d]);
write(' Numero Pasajeros : ');
readln(datos[cont].npasaj);
write(' Alcabala : ');
readln(datos[cont].alcabala);
write(' Fecha d/m/a : ');
readln(datos[cont].fecha);
writeln(' Tipo Vehiculo : 1=particulares 2=porpuesto 3=taxi',
' 4=transporte publicos');
write(' Tipo Veiculo : ');
readln(datos[cont].tipovl);
write(' Accion [A]=Sale [B]=entra : ');
repeat
readln(cu);
until upcase(cu) in['A','B'];
datos[cont].salent := acion[upcase(cu)];
cont := cont + 1;
if cont > 200 then
cont := 200;
end;
procedure consulta;
var
nume : string[20];
nn : integer;
enco : boolean;
begin
writeln(' ****** Consulta Entre Numero Matricula ******');
writeln;
write(' Numero : ');
readln(nume);
for nn := 1 to length(nume) do
nume[nn] := upcase(nume[nn]);
nn := 0;
enco := false;
repeat
if datos[nn].nplaca = nume then
enco := true
else
nn := nn + 1;
until (nn > cont - 1) or (enco = true);
if enco = true then
begin
clrscr;
writeln(' ***** Datos Consultados Son *****');
writeln;
writeln(' Numero Placa = ',datos[nn].nplaca);
writeln(' Numero Pasajeros = ',datos[nn].npasaj);
writeln(' Alcabala = ',datos[nn].alcabala);
writeln(' Fecha = ',datos[nn].fecha);
writeln(' Tipo Vehiculo = ',tipove[datos[nn].tipovl]);
writeln(' Sale/Entra = ',datos[nn].salent);
writeln;
writeln(' >>>>> Pulse Una Tecla <<<<<');
readkey;
end;
end;
procedure modifica;
var
termina, si : boolean;
pu, tec : char;
nn : integer;
num : string[20];
begin
if cont > 0 then
begin
writeln('***** Modificacion De Datos *****');SALE
writeln;
write(' Entre Nume Matricula : ');
readln(num);
for nn := 1 to length(num) do
num[nn] := upcase(num[nn]);
nn := 0;
si := false;
termina := false;
repeat
if datos[nn].nplaca = num then
si := true
else
nn := nn + 1;
until (nn > cont) or (si = true);
if si = true then
begin
repeat
clrscr;
writeln('*** Elija Elemento A Modificar ***');
writeln;
writeln(' A = Numero Placa ');
writeln(' B = Numero Pasajeros');
writeln(' C = Alcabala ');
writeln(' D = Fecha');
writeln(' E = Tipo Vehiculo');
writeln(' F = Sale/Entra');
writeln(' S = Nada');
writeln;
repeat
tec := upcase(readkey);
until tec in['A','B','C','D','E','F','S'];
clrscr;
case tec of
'A' : begin write(' Numero Placa : '); readln(datos[nn].nplaca); end;
'B' : begin write(' Numero Pasajeros : '); readln(datos[nn].npasaj); end;
'C' : begin write(' Alcabala : '); readln(datos[nn].alcabala); end;
'D' : begin write(' Fecha : '); readln(datos[nn].fecha); end;
'E' : begin write(' Tipo Vehiculo : '); readln(datos[nn].tipovl); end;
'F' : begin write(' Sale/Entra : '); readln(datos[nn].salent); end;
'S' : termina := true;
end;
if tec <> 'S' then
begin
writeln('** Desea Modificar Mas [S/N] **');
repeat
pu := upcase(readkey);
until pu in['S','N'];
if pu = 'N' then
termina := true;
end;
until termina = true;
end;
end
else
begin
writeln('<<<<<<< Sin Datos En Registro Pulse Una Tecla >>>>>>>>>');
readkey;
end;
end;
procedure ordena;
var
pu : char;
porque : string;
kk, nn : integer;
temp : regvehiculo;
begin
if cont > 1 then
begin
for kk := 0 to cont - 1 do
for nn := cont - 1 downto kk + 1 do
begin
if datos[kk].alcabala > datos[nn].alcabala then
begin
temp := datos[kk];
datos[kk] := datos[nn];
datos[nn] := temp;
end;
end;
end;
end;
procedure eliminaregistro;
var
tt, nn : integer;
reg : regvehiculo;
placa : string[20];
sal : boolean;
pul : char;
begin
if cont > 1 then
begin
writeln(' **** Eliminicain De Un Registro ****');
writeln;
write(' Entre Numero Placa : ');
readln(placa);
for nn := 1 to length(placa) do
placa[nn] := upcase(placa[nn]);
sal := false;
nn := 0;
repeat
if datos[nn].nplaca = placa then
sal := true
else
nn := nn + 1;
until (nn > cont - 1) or (sal = true);
if sal = true then
begin
writeln('???? Se Anulara El Registro Matricula = ',datos[nn].nplaca);
writeln('****** Desea Anularlo [S/N] *******');
repeat
pul := upcase(readkey);
until pul in['S','N'];
if pul = 'S' then
begin
for tt := 0 to cont do
begin
if tt <> nn then
datos[tt] := datos[tt];
end;
cont := tt;
end;
end;
end;
end;
procedure ordenafecha(d : array of regvehiculo; num : integer);
var
j, t : integer;
auxil : regvehiculo;
begin
for j := 1 to num do
for t := num downto j + 1 do
if d[j].fecha > d[t].fecha then
begin
auxil := d[j];
d[j] := d[t];
d[t] := auxil;
end;
end;
procedure visualizatodos;
var
tm, poe, pos, entr, sale, paso, cc : integer;
tempo : array[1..20] of regvehiculo;
conp, alca : string[20];
begin
cc := 0;
tm := 1;
poe := 0;
pos := 0;
entr := 0;
sale := 0;
if cont > 1 then
begin
ordena;
for cc := 0 to cont - 1 do
begin
if (datos[cc].fecha = datos[cc + 1].fecha) and
(datos[cc].alcabala = datos[cc + 1].alcabala) then
begin
tempo[tm] := datos[cc];
tm := tm + 1;
end
else
begin
if tm > 1 then
begin
tempo[tm] := datos[cc];
tm := tm + 1;
ordenafecha(tempo,tm - 1);
for paso := 1 to tm - 1 do
begin
if tempo[paso].salent = acion['B'] then
poe := poe + 1;
if tempo[paso].salent = acion['A'] then
pos := pos + 1;
end;
if poe > 0 then
entr := (100 * poe) div (poe + pos);
if pos > 0 then
sale := (100 * pos) div (poe + pos);
writeln(' Alcabala = ',tempo[paso].alcabala);
writeln;
writeln(' Fecha Entran Salen %entran %salen');
writeln(tempo[paso].fecha,' ',poe,' ',pos,
' ',entr,' ',sale);
writeln;
writeln(' Fechas = ',tm - 1);
end
else
begin
if datos[cc].salent = acion['B'] then
poe := poe + 1;
if datos[cc].salent = acion['A'] then
pos := pos + 1;
if poe > 0 then
entr := (100 * poe) div (poe + pos);
if pos > 0 then
sale := (100 * pos) div (poe + pos);
writeln(' Alcabala = ',datos[cc].alcabala);
writeln;
writeln(' Fecha Entran Salen %entran %salen');
writeln(datos[0].fecha,' ',poe,' ',pos,
' ',entr,' ',sale);
writeln;
writeln(' Fechas = 1');
end;
tm := 1;
poe := 0;
pos := 0;
entr := 0;
sale := 0;
end;
end;
end
else
begin
clrscr;
writeln(' Alcabala = ',datos[0].alcabala);
writeln;
if datos[0].salent = acion['B'] then
begin
entr := 1;
end
else
begin
entr := 0;
poe := 0;
end;
if datos[0].salent = acion['A'] then
begin
sale := 1;
end
else
begin
sale := 0;
pos := 0;
end;
if entr > 0 then
poe := (100 * entr) div (entr + sale);
if sale > 0 then
pos := (100 * sale) div (sale + entr);
writeln(' Fecha Entran Salen %entran %salen');
writeln(datos[0].fecha,' ',entr,' ',sale,
' ',poe,' ',pos);
writeln;
writeln(' Fechas = 1');
end;
readkey;
end;
procedure menu;
var
sal : boolean;
pul : char;
begin
sal := false;
cont := 0;
repeat
clrscr;
writeln(' **** Menu Jeneral ****');
writeln;
writeln(' 1 = Incluir');
writeln(' 2 = Consultar');
writeln(' 3 = Modificar');
writeln(' 4 = Eliminar');
writeln(' 5 = Reporte de estadisticas');
writeln(' 6 = Salida');
writeln;
writeln(' *** Elija Opcion ***');
repeat
pul := readkey;
until pul in['1','2','3','4','5','6'];
clrscr;
case pul of
'1' : entrada_datos;
'2' : consulta;
'3' : modifica;
'4' : eliminaregistro;
'5' : visualizatodos;
'6' : sal := true;
end;
until sal = true;
end;
begin
menu;
end.
Por lo que veo, te refieres a un "array de records", en el que quieres borrar un "record". Tu esqueleto de borrado es
for tt := 0 to cont do
begin
if tt <> nn then
datos[tt] := datos[tt];
end;
cont := tt;
Pero eso no hace nada, deja todo exactamente igual que estaba. La forma habitual de borrar en un array es mover todos los elementos "hacia abajo" a partir de la posición deseada, y finalmente disminuir el contador.
Debería ser algo como
for posicion := nn to cont-1 do
datos[tt] := datos[tt+1];
cont := cont-1;
No tenia idea de como podía hacerse, estudio a distancia y a veces se me complica investigar todo, ya que en ocasiones ni siquiera se como empezar a buscar lo que desconozco...muchísimas gracias...ese ejemplo me ayudara mucho...por cierto es la segunda vez que me ayudas, ya me había ayudado un poco con el Cupas version 4...Saludos
Dicen que no hay dos sin tres, así que ya sabes... no tengas reparo en preguntar las dudas que te vayan surgiendo, que te ayudaré en lo que pueda.
Suelo entrar al foro con frecuencia, así que lo habitual es que conteste en menos de 24 horas.
Hola, de nuevo yo, sabes que hice lo que me dijiste y bien, el programa corre, pero tengo un problema, cuando lo ejecuto, el menú funciona casi perfecto, pues hay una opción del menú a la cual no puedo ingresar simplemente no hace nada, revise pero veo todo bien....no estaría de más una segunda opinión...solo me falta solventar eso y pulir los demás errores. anexo el codigo por si lo puedes correr.
program estadistica;
uses
crt;
const
tipove : array[1..4] of string[20] = (
'particulares','porpuesto','taxi','transporte publicos');
acion : array['A'..'B'] of string[5] = (
'Sale','Entra');
type
regvehiculo = record
nplaca : string[20];
npasaj : integer;
alcabala : string[20];
fecha : string[10];
tipovl : byte;
salent : string[5];
end;
var
datos : array[0..200] of regvehiculo;
cont : integer;
tecla : char;
procedure entrada_datos;
var
d : integer;
cu : char;
begin
writeln('***** Entrada De Datos Vehiculos *****');
writeln;
write(' Numero Placa : ');
readln(datos[cont].nplaca);
for d := 1 to length(datos[cont].nplaca) do
datos[cont].nplaca[d] := upcase(datos[cont].nplaca[d]);
write(' Numero Pasajeros : ');
readln(datos[cont].npasaj);
write(' Alcabala : ');
readln(datos[cont].alcabala);
write(' Fecha d/m/a : ');
readln(datos[cont].fecha);
writeln(' Tipo Vehiculo : 1=particulares 2=porpuesto 3=taxi',
' 4=transporte publicos');
write(' Tipo Veiculo : ');
readln(datos[cont].tipovl);
write(' Accion [A]=Sale [B]=entra : ');
repeat
readln(cu);
until upcase(cu) in['A','B'];
datos[cont].salent := acion[upcase(cu)];
cont := cont + 1;
if cont > 200 then
cont := 200;
end;
procedure consulta;
var
nume : string[20];
nn : integer;
enco : boolean;
begin
writeln(' ****** Consulta Entre Numero Matricula ******');
writeln;
write(' Numero : ');
readln(nume);
for nn := 1 to length(nume) do
nume[nn] := upcase(nume[nn]);
nn := 0;
enco := false;
repeat
if datos[nn].nplaca = nume then
enco := true
else
nn := nn + 1;
until (nn > cont - 1) or (enco = true);
if enco = true then
begin
clrscr;
writeln(' ***** Datos Consultados Son *****');
writeln;
writeln(' Numero Placa = ',datos[nn].nplaca);
writeln(' Numero Pasajeros = ',datos[nn].npasaj);
writeln(' Alcabala = ',datos[nn].alcabala);
writeln(' Fecha = ',datos[nn].fecha);
writeln(' Tipo Vehiculo = ',tipove[datos[nn].tipovl]);
writeln(' Sale/Entra = ',datos[nn].salent);
writeln;
writeln(' >>>>> Pulse Una Tecla <<<<<');
readkey;
end;
end;
procedure modifica;
var
termina, si : boolean;
pu, tec : char;
nn : integer;
num : string[20];
begin
if cont > 0 then
begin
writeln('***** Modificacion De Datos *****');
writeln;
write(' Entre Nume Matricula : ');
readln(num);
for nn := 1 to length(num) do
num[nn] := upcase(num[nn]);
nn := 0;
si := false;
termina := false;
repeat
if datos[nn].nplaca = num then
si := true
else
nn := nn + 1;
until (nn > cont) or (si = true);
if si = true then
begin
repeat
clrscr;
writeln('*** Elija Elemento A Modificar ***');
writeln;
writeln(' A = Numero Placa ');
writeln(' B = Numero Pasajeros');
writeln(' C = Alcabala ');
writeln(' D = Fecha');
writeln(' E = Tipo Vehiculo');
writeln(' F = Sale/Entra');
writeln(' S = Nada');
writeln;
repeat
tec := upcase(readkey);
until tec in['A','B','C','D','E','F','S'];
clrscr;
case tec of
'A' : begin write(' Numero Placa : '); readln(datos[nn].nplaca); end;
'B' : begin write(' Numero Pasajeros : '); readln(datos[nn].npasaj); end;
'C' : begin write(' Alcabala : '); readln(datos[nn].alcabala); end;
'D' : begin write(' Fecha : '); readln(datos[nn].fecha); end;
'E' : begin write(' Tipo Vehiculo : '); readln(datos[nn].tipovl); end;
'F' : begin write(' Sale/Entra : '); readln(datos[nn].salent); end;
'S' : termina := true;
end;
if tec <> 'S' then
begin
writeln('** Desea Modificar Mas [S/N] **');
repeat
pu := upcase(readkey);
until pu in['S','N'];
if pu = 'N' then
termina := true;
end;
until termina = true;
end;
end
else
begin
writeln('<<<<<<< Sin Datos En Registro Pulse Una Tecla >>>>>>>>>');
readkey;
end;
end;
procedure ordena;
var
pu : char;
porque : string;
kk, nn : integer;
temp : regvehiculo;
begin
if cont > 1 then
begin
for kk := 0 to cont - 1 do
for nn := cont - 1 downto kk + 1 do
begin
if datos[kk].alcabala > datos[nn].alcabala then
begin
temp := datos[kk];
datos[kk] := datos[nn];
datos[nn] := temp;
end;
end;
end;
end;
procedure eliminaregistro;
var
tt, nn : integer;
reg : regvehiculo;
placa : string[20];
sal : boolean;
pul : char;
begin
if cont > 1 then
begin
writeln(' **** Eliminicain De Un Registro ****');
writeln;
write(' Entre Numero Placa : ');
readln(placa);
for nn := 1 to length(placa) do
placa[nn] := upcase(placa[nn]);
sal := false;
nn := 0;
repeat
if datos[nn].nplaca = placa then
sal := true
else
nn := nn + 1;
until (nn > cont - 1) or (sal = true);
if sal = true then
begin
writeln('???? Se Anulara El Registro Matricula = ',datos[nn].nplaca);
writeln('****** Desea Anularlo [S/N] *******');
repeat
pul := upcase(readkey);
until pul in['S','N'];
if pul = 'S' then
for tt := 0 to cont-1 do
datos[tt] := datos[tt+1];
cont := tt-1;
end;
end;
end;
procedure ordenafecha(d : array of regvehiculo; num : integer);
var
j, t : integer;
auxil : regvehiculo;
begin
for j := 1 to num do
for t := num downto j + 1 do
if d[j].fecha > d[t].fecha then
begin
auxil := d[j];
d[j] := d[t];
d[t] := auxil;
end;
end;
procedure visualizatodos;
var
tm, poe, pos, entr, sale, paso, cc : integer;
tempo : array[1..20] of regvehiculo;
conp, alca : string[20];
begin
cc := 0;
tm := 1;
poe := 0;
pos := 0;
entr := 0;
sale := 0;
if cont > 1 then
begin
ordena;
for cc := 0 to cont - 1 do
begin
if (datos[cc].fecha = datos[cc + 1].fecha) and
(datos[cc].alcabala = datos[cc + 1].alcabala) then
begin
tempo[tm] := datos[cc];
tm := tm + 1;
end
else
begin
if tm > 1 then
begin
tempo[tm] := datos[cc];
tm := tm + 1;
ordenafecha(tempo,tm - 1);
for paso := 1 to tm - 1 do
begin
if tempo[paso].salent = acion['B'] then
poe := poe + 1;
if tempo[paso].salent = acion['A'] then
pos := pos + 1;
end;
if poe > 0 then
entr := (100 * poe) div (poe + pos);
if pos > 0 then
sale := (100 * pos) div (poe + pos);
writeln(' Alcabala = ',tempo[paso].alcabala);
writeln;
writeln(' Fecha Entran Salen %entran %salen');
writeln(tempo[paso].fecha,' ',poe,' ',pos,
' ',entr,' ',sale);
writeln;
writeln(' Fechas = ',tm - 1);
end
else
begin
if datos[cc].salent = acion['B'] then
poe := poe + 1;
if datos[cc].salent = acion['A'] then
pos := pos + 1;
if poe > 0 then
entr := (100 * poe) div (poe + pos);
if pos > 0 then
sale := (100 * pos) div (poe + pos);
writeln(' Alcabala = ',datos[cc].alcabala);
writeln;
writeln(' Fecha Entran Salen %entran %salen');
writeln(datos[0].fecha,' ',poe,' ',pos,
' ',entr,' ',sale);
writeln;
writeln(' Fechas = 1');
end;
tm := 1;
poe := 0;
pos := 0;
entr := 0;
sale := 0;
end;
end;
end
else
begin
clrscr;
writeln(' Alcabala = ',datos[0].alcabala);
writeln;
if datos[0].salent = acion['B'] then
begin
entr := 1;
end
else
begin
entr := 0;
poe := 0;
end;
if datos[0].salent = acion['A'] then
begin
sale := 1;
end
else
begin
sale := 0;
pos := 0;
end;
if entr > 0 then
poe := (100 * entr) div (entr + sale);
if sale > 0 then
pos := (100 * sale) div (sale + entr);
writeln(' Fecha Entran Salen %entran %salen');
writeln(datos[0].fecha,' ',entr,' ',sale,
' ',poe,' ',pos);
writeln;
writeln(' Fechas = 1');
end;
readkey;
end;
procedure menu;
var
sal : boolean;
pul : char;
begin
sal := false;
cont := 0;
repeat
clrscr;
writeln(' **** Menu General ****');
writeln;
writeln(' 1 = Incluir');
writeln(' 2 = Consultar');
writeln(' 3 = Modificar');
writeln(' 4 = Eliminar');
writeln(' 5 = Reporte de estadisticas');
writeln(' 6 = Salida');
writeln;
writeln(' *** Elija Opcion ***');
repeat
pul := readkey;
until pul in['1','2','3','4','5','6'];
clrscr;
case pul of
'1' : entrada_datos;
'2' : consulta;
'3' : modifica;
'4' : eliminaregistro;
'5' : visualizatodos;
'6' : sal := true;
end;
until sal = true;
end;
begin
menu;
end.
Si das detalles sobre qué opción es la que falla, quizá te pueda/podamos ayudar con rapidez, porque muchas veces el error resulta evidente para alguien con más experiencia.
Pero si no das detalles, no podremos ayudarte hasta que tengamos un compilador de Pascal delante, o el tiempo necesario para analizar todo el programa de principio a fin (algo que puede ser difícil, porque cuando uno empieza, suele a hacer las cosas de forma mucho más enrevesada de lo que realmente sería necesario; en el caso de tu fuente es más difícil aún, porque no tiene ningún comentario ni está tabulado).
Es verdad disculpa, es en el procedure de eliminar registro...la opcion 4 del menu, cuando se ejecuta esa aplicacion, no se puede tomar la opcion...
Sé practico: ese procedure empieza con "if cont > 1 then ..." así que prueba a incluir al principio:
writeln(cont);
readkey;
para poder comprobar el valor de esa variable.
Verás que sí se entra, y que si lo pruebas al principio, "cont" vale 0 y se sale (correctamente). El problema es que si lo pruebas con un único dato, se seguirá saliendo porque la condición (¿incorrecta?) es que el contador sea mayor que 1. Para poder borrar, deberás entrar con al menos dos datos, y en ese caso sí te lo debería permitir.
Ah es verdad.... tienes toda la razón, cambie el valor del contador a 0 y así podre borrar desde el 1 registro, muchísimas gracias de verdad......Saludos
(No se puede continuar esta discusión porque tiene más de dos meses de antigüedad. Si tienes dudas parecidas, abre un nuevo hilo.)