Pascal/Turbo Pascal - Problema borrado de lista!!!

   
Vista:

Problema borrado de lista!!!

Publicado por Sergi (2 intervenciones) el 09/02/2012 14:21:29
Hola, alguien me podría ayudar???
He creado un checkbox con diferentes nombres y apellidos, que los tengo en una lista simple de nombres y otra de apellidos...
entonces quiero borrar aquellos nombre que sean seleccionados de la lista de nombres, y aquellos apellidos de la lista de apellidos
he creado una lista auxiliar booleana para ello, entonces va comprobando si es "true" su valor, y si lo es borra el elemento indicado.
funciona si solo se selecciona el borrar un elemento, pero si se slecciona mas de un elemento en la checkbox da error y no se por que!!

//El parametro tipo es para saber si es de la lista nombre o apellidos.
PROCEDURE borrarElementos(VAR lista_nombres, lista_apellidos: TLista; tipo:integer; lista_bool_nom, lista_bool_apell:TLista);
var
act, ant, aux_bool_p:TLista;
begin
act:=lista_nombres;
ant:=NIL;
aux_bool_p:=lista_bool_nom;
while (aux_bool_p<>NIL) do
begin
if (aux_bool_p^.info='true') then
begin
if (ant<>NIL) then
ant^.sgte:=act^.sgte
else
lista_nombres:=act^.sgte;
dispose(act);
aux_bool_p:=aux_bool_p^.sgte;
end
else
begin
aux_bool_p:=aux_bool_p^.sgte;
ant:=act;
act:=act^.sgte;
end;
end;
//Aquí vendría lo mismo para la lista de apellidos, pero sólo estoy comprobando con nombres
end;


Gracias!!
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

Problema borrado de lista!!!

Publicado por ramon (2072 intervenciones) el 09/02/2012 19:27:00
{Mi mejor ayuda es este ejemplo espero te sirva}

program nombres;
uses
crt;
type
puntpersonas = ^personas;
personas = record
nomb : string[20];
sig : puntpersonas;
end;

var
persbor, persno, persno1, persno2 : puntpersonas;


function datos : string;
var
tecla : char;
dnom : string[20];
cont : integer;
num : word;
begin
cont := 1;
fillchar(dnom,21,' ');
dnom[0] := chr(20);
datos := ' ';
gotoxy(5,5);write('Entre el Nombre : ');
gotoxy(23,5);
repeat
tecla := readkey;
if tecla in[#65..#90,#97..#122,#164,#165,#32] then
begin
dnom[cont] := tecla;
dnom[0] := chr(cont);
gotoxy(22 + cont,5);write(dnom[cont]);
cont := cont + 1;
if cont > 20 then
cont := 20;
end;
if tecla = #8 then
begin
cont := cont - 1;
if cont < 1 then
cont := 1;
dnom[cont] := ' ';
dnom[0] := chr(cont);
gotoxy(22 + cont,5);write(dnom[cont]);
end;
until tecla = #13;
if cont > 1 then
begin
datos := copy(dnom,1,length(dnom));
end;
end;

procedure entrada;
begin
if persno1 = nil then
begin
new(persno);
persno^.nomb := datos;
persno1 := persno;
persno^.sig := nil;
end
else
begin
persno2 := persno;
new(persno);
persno^.nomb := datos;
persno2^.sig := persno;
persno^.sig := nil;
end;
end;

procedure entradanombres;
var
mas, nomas : boolean;
numtec : char;
begin
clrscr;
if persno1 = nil then
begin
gotoxy(20,2);write('***** ENTRADA NOMBRE *****');
mas := true;
repeat
if mas = true then
begin
entrada;
gotoxy(5,5);clreol;
gotoxy(5,5);write('Desea Agregar mas Nombres [S/N]');
mas := false;
end;
repeat
numtec := readkey;
if numtec in['n','N'] then
nomas := true;
if numtec in['s','S'] then
mas := true;
until numtec in['s','S','n','N'];
gotoxy(5,5);clreol;
until nomas = true;
end
else
begin
entrada;
end;
end;

procedure eliminarnombre;
var
nomborra : string[20];
union, alu : puntpersonas;
si : boolean;
pos : longint;
begin
clrscr;
if persno1 = nil then
begin
end
else
begin
gotoxy(10,2);write('**** Eliminar un Nombre ****');
nomborra := datos;
alu := persno1;
si := false;
pos := 1;
repeat
if alu^.nomb = nomborra then
begin
if pos = 1 then
begin
si := true;
end
else
begin
si := true;
union^.sig := alu^.sig;
dispose(alu);
end;
end
else
begin
union := alu;
alu := alu^.sig;
pos := pos + 1;
end;
until (alu = nil) or (si = true);
end;
end;

procedure verlistanombres;
var
alum : puntpersonas;
xn, yn : integer;
begin
xn := 15;
yn := 3;
if persno1 = nil then
begin
end
else
begin
alum := persno1;
gotoxy(xn, yn - 2);write('*** NOMBRES ***');
repeat
gotoxy(xn, yn);write('Nombre : ',alum^.nomb);
yn := yn + 1;
if yn > 24 then
begin
writeln;
yn := yn - 1;
end;
alum := alum^.sig;
until alum = nil;
readln;
end;
end;


procedure menu;
var
tne : char;
salir : boolean;
begin
salir := false;
repeat
clrscr;
gotoxy(10,2);write('<<<<< MENU GENERAL >>>>>>');
gotoxy(10,4);write('1 = ENTRADA NOMBRES');
gotoxy(10,5);write('2 = ELIMINAR NOMBRE');
gotoxy(10,6);write('3 = VER LISTA NOMBRES');
gotoxy(10,7);write('4 = SALIR');
tne := readkey;
if tne in[#49..#52] then
begin
clrscr;
case tne of
#49 : entradanombres;
#50 : eliminarnombre;
#51 : verlistanombres;
#52 : salir := true;
end;
end;
until salir = true;
end;



begin
persno1 := nil;
menu;
if persno1 = nil then
begin
end
else
begin
dispose(persno);
persno1 := nil;
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

Problema borrado de lista!!!

Publicado por Sergi (2 intervenciones) el 10/02/2012 14:54:38
Muchas gracias por el esfuerzo realizado!!
pero por no cambiar mi código... (estoy con formularios y no por consola) trasteando por ahí me encontré que podía ser tan sencillo el error como el no actualizar "act" después de realizar el "dispose(act)"

era una chorrada, pero parece que ahora funciona de esta forma...
if (ant<>NIL) then
begin
ant^.sgte:=act^.sgte;
dispose(act);
act:=ant^.sgte;
else
begin
lista_nombres:=act^.sgte;
dispose(act);
act:=lista_nombres;
end;

una chorrada y mira la lata que ha dado

perdona por las molestias y gracias por el esfuerzo!!
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