Como se hace un programa de listas en turbo pascal? Por favor
Publicado por Mar (5 intervenciones) el 06/06/2013 06:09:04
Necesito saber como es un programa de listas por favor
Valora esta pregunta
0
Iniciar sesiónCrear cuenta
Crear cuentaCrear cuenta
{Mira esto es un programa de listas simplemente enlazadas espero te ayude}
program listasme;
uses
crt;
type
lista = ^listas;
listas = record numimpares : longint; numaleatorios : longint; multiplosde10 : longint; sig : lista;end;
var
prime, anter, actu : lista;
procedure inicioa_nil;
begin
prime := nil;
end;
procedure entramosdatos(cual : char);
begin
cual := upcase(cual);
if prime = nil thenbegin
new(actu);
case cual of
'I' : begin
write('Introduzca Numeros Impares : ');
readln(actu^.numimpares);
end;
'A' : begin
write('Introduzca Numeros Aleatorios : ');
readln(actu^.numaleatorios);
end;
'M' : begin
write('Introduzca Numeros Multiplis De 10 : ');
readln(actu^.multiplosde10);
end;
end;
prime := actu;
actu^.sig := nil;
end
else
begin
anter := actu;
new(actu);
case cual of
'I' : begin
write('Introduzca Numeros Impares : ');
readln(actu^.numimpares);
end;
'A' : begin
write('Introduzca Numeros Aleatorios : ');
readln(actu^.numaleatorios);
end;
'M' : begin
write('Introduzca Numeros Multiplis De 10 : ');
readln(actu^.multiplosde10);
end;
end;
anter^.sig := actu;
actu^.sig := nil;
end;
end;
procedure modificarelemento(cual : char; numero : longint);
var
ver : lista;begin
cual := upcase(cual);
ver := prime;
while ver <> nil do
begin
with ver^ dobegin
case cual of
'I' : if numimpares = numero then
begin
write('Modificar Numeros Impares : ');
readln(ver^.numimpares);
break;
end;
'A' : if numaleatorios = numero then
begin
write('Modificar Numeros Aleatorios : ');
readln(ver^.numaleatorios);
break;
end;
'M' : if multiplosde10 = numero then
begin
write('Modificar Numeros Multiplis De 10 : ');
readln(ver^.multiplosde10);
break;
end;
end;
end;
ver := ver^.sig;
end;
end;
procedure ordenamenormayor(cual : char);
var
temp : listas;sige, ard : lista;
begin
cual := upcase(cual);
ard := prime;
sige := prime^.sig;
while ard <> nil do
begin
while sige <> nil do
begin
case cual of
'I' : begin
if ard^.numimpares > sige^.numimpares then
begin
temp.numimpares := ard^.numimpares;
ard^.numimpares := sige^.numimpares;
sige^.numimpares := temp.numimpares;
end
else
begin
sige := sige^.sig;
end;
end;
'A' : begin
if ard^.numaleatorios > sige^.numaleatorios then
begin
temp.numaleatorios := ard^.numaleatorios;
ard^.numaleatorios := sige^.numaleatorios;
sige^.numaleatorios := temp.numaleatorios;
end
else
begin
sige := sige^.sig;
end;
end;
'M' : begin
if ard^.multiplosde10 > sige^.multiplosde10 then
begin
temp.multiplosde10 := ard^.multiplosde10;
ard^.multiplosde10 := sige^.multiplosde10;
sige^.multiplosde10 := temp.multiplosde10;
end
else
begin
sige := sige^.sig;
end;
end;
end;
ard := ard^.sig;
sige := ard^.sig;
end;
end;
end;
procedure insertafinal(cual : char; nu : longint);
var
pt : lista;begin
new(pt);
case cual of
'I' : pt^.numimpares := nu;
'A' : pt^.numaleatorios := nu;
'M' : pt^.multiplosde10 := nu;
end;
actu^.sig := pt;
pt^.sig := nil;
actu := pt;
end;
procedure borraprimerodelista(cual : char);
var
borra : lista;begin
cual := upcase(cual);
borra := prime;
case cual of
'I' : borra := borra^.sig;
'A' : borra := borra^.sig;
'M' : borra := borra^.sig;
end;
end;
procedure buscarelemento(cual : char; nu : longint);
var
existen : integer; busca : lista;begin
existen := 0;
cual := upcase(cual);
busca := prime;
while busca <> nil do
begin
case cual of
'I' : if busca^.numimpares = nu then
begin
writeln(' ',busca^.numimpares);
existen := existen + 1;
end;
'A' : if busca^.numaleatorios = nu then
begin
writeln(' ',busca^.numaleatorios);
existen := existen + 1;
end;
'M' : if busca^.multiplosde10 = nu then
begin
writeln(' ',busca^.multiplosde10);
existen := existen + 1;
end;
end;
busca := busca^.sig;
end;
writeln;
writeln(' Se Repiten : ',existen);
writeln;
writeln(' ***** Pulse Una [Tecla] *****');
readkey;
end;
procedure menu;
var
sal : boolean;tecc, tecla : char;
nu : longint;begin
sal := false;
repeat
clrscr;
writeln(' **** Menu General ****');
writeln;
writeln(' 1 = Crear listas');
writeln(' 2 = Modificar elemento de una lista');
writeln(' 3 = Ordenar de menor a mayor una lista');
writeln(' 4 = Buscar un elemento en la lista');
writeln(' 5 = Incluir un elemento al final de la lista');
writeln(' 6 = Borrar un elemento en la lista');
writeln(' 7 = Vaciar una lista');
writeln(' 8 = Salir');
writeln;
writeln(' <<<< Elija Opcion >>>>');
repeat
tecla := readkey;
until tecla in['1','2','3','4','5','6','7','8'];
clrscr;
case tecla of
'1' : begin
writeln(' Crear Lista De Numeros [I]=Impares ',
' [A]=Aleatorios [M]=Multiplos');
repeat
tecc := upcase(readkey);
until tecc in['I','A','M'];
entramosdatos(tecc);
end;
'2' : begin
writeln(' Modificar Lista De Numeros [I]=Impares ',
' [A]=Aleatorios [M]=Multiplos');
repeat
tecc := upcase(readkey);
until tecc in['I','A','M'];
writeln;
writeln(' Entre Numero A Modificar : ');
readln(nu);
modificarelemento(tecc,nu);
end;
'3' : begin
writeln(' Ordena Lista De Numeros [I]=Impares ',
' [A]=Aleatorios [M]=Multiplos');
repeat
tecc := upcase(readkey);
until tecc in['I','A','M'];
ordenamenormayor(tecc);
end;
'4' : begin
writeln(' Buscar Elemento en Lista De Numeros [I]=Impares ',
' [A]=Aleatorios [M]=Multiplos');
repeat
tecc := upcase(readkey);
until tecc in['I','A','M'];
writeln;
writeln(' Entre Numero A Buscar : ');
readln(nu);
buscarelemento(tecc,nu);
end;
'5' : begin
writeln(' Inserta En Lista De Numeros [I]=Impares ',
' [A]=Aleatorios [M]=Multiplos');
repeat
tecc := upcase(readkey);
until tecc in['I','A','M'];
writeln;
writeln(' Entre Numero A Insertar : ');
readln(nu);
insertafinal(tecc,nu);
end;
'6' : begin
writeln(' Borrado Elemento En Lista De Numeros [I]=Impares ',
' [A]=Aleatorios [M]=Multiplos');
repeat
tecc := upcase(readkey);
until tecc in['I','A','M'];
borraprimerodelista(tecc);
end;
'7' :;
'8' : sal := true;
end;
until sal = true;end;
begin
inicioa_nil;
menu;
end.