Um exemplo de lista utilizando apontadores.

• Download lista.pas
• Enviar nova versão

Esconder código-fonte

program ed;
uses crt;
type
apontador = ^celula;
celula = record
item:integer;
prox:apontador;
end;
tipolista = record
primeiro:apontador;
ultimo:apontador;
end;

procedure inicialista(var lista:tipolista);
var
   aux:apontador;
begin
  new (aux);
   lista.primeiro:=aux;
   lista.ultimo:=lista.primeiro;
   lista.ultimo^.prox :=nil;
end;


function vazia(lista:tipolista):boolean;
begin
   vazia:=lista.primeiro = lista.ultimo;
end;

procedure inserirf(x:integer;var lista:tipolista);
var aux:apontador;
begin
   new (aux);
   lista.ultimo^.prox:=aux;
   aux^.prox := nil;
   aux^.item :=x;
   lista.ultimo := aux;
end;

procedure imprimir(lista:tipolista);
var aux:apontador;
begin
   aux := lista.primeiro^.prox;
  while ( aux <> nil ) do begin
    writeln(aux^.item);
    aux:=aux^.prox;
  end;
end;

procedure inseriri(x:integer; var lista:tipolista);
var
aux:apontador;
begin
if(vazia(lista)) then
  inserirf(x,lista)
    else
begin
  new(aux);
  aux^.item := x;
  aux^.prox:=lista.primeiro^.prox;
  lista.primeiro^.prox := aux;
end;
end;



procedure retirai(var x:integer; var lista:tipolista);
var
  aux:apontador;
begin

 aux:=lista.primeiro^.prox;
 x:=aux^.item;
 lista.primeiro^.prox := aux^.prox;
 if (lista.primeiro^.prox = nil ) then lista.ultimo := lista.primeiro;
 dispose(aux);

end;




procedure retirarf(var x:integer; var lista:tipolista);
var
aux:apontador;
begin
  if ( lista.primeiro^.prox^.prox = nil ) then
      retirai(x,lista)
  else
      begin
      aux:=lista.primeiro^.prox;
      while ( aux^.prox <>  lista.ultimo) do
      aux := aux^.prox;
      lista.ultimo := aux;
      aux:=aux^.prox;
      x:=aux^.item;
      lista.ultimo^.prox:=nil;
      dispose(aux);
      end;
end;

procedure retiral( var x:integer; var lista:tipolista; n:integer);
var
  aux,aux1:apontador;
  i:integer;
  begin

  aux:=lista.primeiro;
  for i:=1 to n-1 do
  begin
   x:=aux^.prox^.item;

  end;
  aux1:= aux^.prox;
  aux^.prox := aux1^.prox;
  dispose(aux1);
end;

procedure media(l:tipolista; var media:real);

var
aux:apontador;
b:integer;
begin

aux:=l.primeiro;

media:=0;
b:=0;

while aux^.prox <> nil do begin

aux:=aux^.prox;
media:=media+aux^.item;
b:=b+1;
end;
media:=media/b;

end;

procedure somapar(l:tipolista; var sp:integer);
var
aux:apontador;
begin
aux:=l.primeiro;
sp:=0;
while (aux^.prox <> nil) do begin
aux:=aux^.prox;
if (aux^.item mod 2) = 0 then
 begin
 sp:=sp+aux^.item;
 end;

end;
end;
procedure retira2(var lista:tipolista; x:integer);
var auxR,aux:apontador;
cont,i:integer;

begin
     i:=0;
     aux:=lista.primeiro;
     while (aux^.item <> x) do begin
     aux:= aux^.prox;
     i:=i+1;
     end;
auxR := lista.primeiro;

for cont:=1 to i-3 do auxR:=auxR^.prox;
aux:=auxR^.prox;
auxR^.prox := aux^.prox;
dispose(aux);

end;


procedure exer3daprova(l:tipolista);
var
mediam:real;
aux:apontador;
i,multi,somap:integer;
begin

i:=0;
multi:=1;
aux:=l.primeiro^.prox;
 while ( aux <> nil ) do begin
     i:=i+1;
  if (aux^.item mod 2 = 1 ) then
     multi := multi * aux^.item;
  if ( i mod 2 = 0 ) then
     somap:=somap + aux^.item;
 end;
    mediam := multi / i;
    writeln(mediam);
    writeln(somap);


end;


procedure inserirantes( var l:tipolista; x:integer; elem:integer);
var
aux,aux1:apontador;
begin
aux:=l.primeiro^.prox;
while ( aux^.prox^.item <> elem ) do begin
 aux^.prox;
end;
new (aux1);
aux1^.prox := aux^.prox;
aux^.prox := aux1;
aux1^.item := x;




end;


var
  l:tipolista;
  opc:char;
  elem:integer;
  n:integer;
  soma:integer;
  m:real;
  { Programa principal }

begin
inicialista(l);

repeat
writeln(' 1 - Insere in¡cio ');
writeln(' 2 - Insere Fim ');
writeln(' 3 - Retira in¡cio ');
writeln(' 4 - Retira fim ');
writeln(' 5 - Imprimir ');
writeln(' 6 - retirar elemtento em posi‡Æo X ');
writeln(' 7 - Media ');
writeln(' 8 - soma dos elementos pares ');
writeln(' a - Retirar 2§ elemento antes de X ');
writeln(' b - media arit dos elementos impares, e soma dos elem que estÆo nas posi‡äes pares');
writeln(' c - inserir um elemento antes de um determinado elemento');
writeln(' 9 - Sair');


writeln(' 0 - limpar a tela');
opc:=readkey;
    {   clrscr;     }

case opc of

'1':begin

   writeln('Entre com o elemento a ser inserido');
   readln(elem);
   inseriri(elem,l);

end;
'2' :begin
   writeln('Entre com o elemento a ser inserido no final');
   readln(elem);
   inserirf(elem,l);

   end;


'3' :begin

  if vazia(l) then writeln('A lista est  vazia, impossivel retirar elemento !')
  else begin
  retirai(elem,l);
  writeln('O elemento', elem , 'foi removido do inicio da lista');
  end;

end;




'4' :begin
  if vazia(l) then writeln('A lista est  vazia, impossivel retirar elemento !')
  else begin
  retirarf(elem,l);
  writeln('O elemento', elem , 'foi removido do inicio da lista');
  end;

end;


'5':begin
   writeln('Elementos do lista');
   imprimir(l);
   end;
'6' :begin

if not vazia(l) then

 writeln('Entre com a posi‡Æo do elemtento a ser removido');
 readln(n);
 retiral(elem,l,n);

 end;

'7' :begin
media(l,m);

writeln('A media ‚ ',m:3:2);
end;
'8' :begin

somapar(l,soma);
writeln('a soma dos elementos pares ‚',soma)
end;

'9':writeln('Saindo do programa');

'0':clrscr;



'a' :begin
writeln('Elemento');
readln(elem);
retira2(l,elem);
end;


'b' :exer3daprova(l);



end;

until(opc='9');
readkey;
end.

Script em Pascal/Kylix para controle de Locadoras sem salvar arquivos em disco

Jogo da velha "inteligente"

Executa comandos Linux

Metodo main ABP

Ordenando um vetor sem utilização de variáveis de contagem ou auxiliar

Nenhum comentário foi encontrado.