All pastes #592925 Raw Edit

Procedures Insere e listagens

public text v1 · immutable
#592925 ·published 2007-06-28 00:32 UTC
rendered paste body
{----- inicio da procedure insere -----}
procedure insere (var arvorebinariaordenada: ponteiroarvorebinaria; var listafuncionarios: ponteiroarvorebinaria; nomedigitado: string; numeroidentificacaodigitado: integer; departamentodigitado: string; salariodigitado: real);
var novo, ponteiro, anterior, auxiliar: ponteiroarvorebinaria; achou: boolean;
begin
   new(novo);
   novo^.nome := nomedigitado;
   novo^.numerodeidentificacao := numeroidentificacaodigitado;
   if (departamentodigitado = 'adm') then
      novo^.departamento := 'administrativo';
   if (departamentodigitado = 'ped') then
      novo^.departamento := 'pesquisa-e-desenvolvimento';
   if (departamentodigitado = 'prod') then
      novo^.departamento := 'producao';
   novo^.salario := salariodigitado;
   novo^.arvoreesquerda := nil;
   novo^.arvoredireita := nil;
   novo^.anteriordupla := nil;
   novo^.proximadupla := nil;
   ponteiro := arvorebinariaordenada;
   while (ponteiro <> nil) do
   begin
      anterior := ponteiro;
      if (numeroidentificacaodigitado > ponteiro^.numerodeidentificacao) then
         ponteiro := ponteiro^.arvoredireita
      else
         ponteiro := ponteiro^.arvoreesquerda;
   end;
   if (ponteiro = arvorebinariaordenada) then
   begin
      novo^.pai := nil;
      arvorebinariaordenada := novo;
   end
   else
   begin
      novo^.pai := anterior;
      if (numeroidentificacaodigitado > anterior^.numerodeidentificacao) then
         anterior^.arvoredireita := novo
      else
         anterior^.arvoreesquerda := novo;
   end;
   auxiliar := listafuncionarios;
   if (listafuncionarios = nil) then {a lista esta vazia}
   begin
      listafuncionarios := novo;
      novo^.proximadupla := nil;
      novo^.anteriordupla := nil;
   end
   else
   begin
      if (upcase(novo^.nome) < upcase(auxiliar^.nome)) then {1º elemento}
      begin
         novo^.proximadupla := auxiliar;
         novo^.anteriordupla := nil;
         auxiliar^.anteriordupla := novo;
         listafuncionarios := novo;
      end
      else  {muitos elementos}
      begin
         ponteiro := auxiliar;
         auxiliar := auxiliar^.proximadupla;
         while ((auxiliar <> nil) and (not achou)) do
         begin
            if (upcase(novo^.nome) < upcase(auxiliar^.nome)) then
            begin
               novo^.proximadupla := auxiliar;
               novo^.anteriordupla := auxiliar^.anteriordupla;
               auxiliar^.anteriordupla^.proximadupla := novo;
               auxiliar^.anteriordupla := novo;
               achou := true;
            end
            else
            begin
               ponteiro := auxiliar;
               auxiliar := auxiliar^.proximadupla;
            end;
         end;
         if (not achou) then
         begin
            if (upcase(novo^.nome) < upcase(ponteiro^.nome)) then {testar sem}
            begin
               novo^.proximadupla := ponteiro;
               novo^.anteriordupla := ponteiro^.anteriordupla;
               ponteiro^.anteriordupla^.proximadupla := novo;
               ponteiro^.anteriordupla := novo;
            end
            else
            begin
               novo^.proximadupla := nil;
               novo^.anteriordupla := ponteiro;
               ponteiro^.proximadupla := novo;
            end;
         end;
      end;
   end;
end;
{----- fim da procedure insere -----}

{----- inicio da procedure de listar na ordem crescente -----}
procedure listacrescente (listafuncionarios: ponteiroarvorebinaria ;l1,l2:char);
var listador: ponteiroarvorebinaria; achou: boolean;
begin
   listador := listafuncionarios;
   while ((listador <> nil) and (not achou)) do 
   begin 
      if ((upcase(listador^.nome) >= upcase(l1)) and (upcase(listador^.nome) <= upcase(l2))) then 
         writeln(listador^.nome);    
      if (upcase(listador^.nome) > upcase(l2)) then 
         achou := true; 
      listador := listador^.proximadupla; 
   end; 
end;
{----- fim da procedure de listar na ordem crescente -----}
{----- inicio da procedure de listar na ordem decrescente -----}
procedure listadecrescente (listafuncionarios: ponteiroarvorebinaria ;l1,l2:char);
var listador: ponteiroarvorebinaria; achou: boolean;
begin
   listador := listafuncionarios;
   while (listador^.proximadupla <> nil) do 
   begin
      listador := listador^.proximadupla;
   end;
   achou:=false;
   while ((listador <> nil) and (not achou)) do 
   begin 
      if ((upcase(listador^.nome) >= upcase(l1)) and (upcase(listador^.nome) <= upcase(l2))) then 
         writeln(listador^.nome); 
      if (upcase(listador^.nome) < upcase(l1)) then 
         achou := true; 
      listador := listador^.anteriordupla; 
   end; 
end;
{----- fim da procedure de listar na ordem decrescente -----}