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.

Horas por extenso: convertendo as horas em um TDateTime para texto corrido.

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

Executa comandos Linux

Joguinho Tetris

Estrutura de dados - pilha

Nenhum comentário foi encontrado.