Abreviando nomes em Delphi

[Ademir Pereira]

Em busca de auxiliar o pessoal com a questão de abreviação de nomes e, também, porque precisei em um sistema que desenvolvi e nada encontrei, decidi compartilhar essa Function em Delphi para abreviar nomes. Testado e funcionando em meu sistema.

Espero ser de serventia.

Function AbreviaNome (fNome : String) : String;  // BY ADEMIR PEREIRA --- Abrevia Nomes
var i, cont, x : Integer;
    vAbreviado : String;
    vPalavra : array[1..10] of String;
begin
  cont := 0;  //zerando variaveis
  x := 0;
  fNome := trim(fNome); //retiro possíveos espaços de inicio e fim
  for i := 1 to length(fNome) do //tamanho total do nome completo
    begin
      x := x + 1;
      if fNome[x] <> ' ' then  //verifico espaços entre os nomes
        begin
          vAbreviado := vAbreviado + copy(fNome,x,1);
        end
      else      //separo o nome e sobrenomes através do espaçamento entre eles e
        begin   // gravo separadamente em cada posição do vetor
          cont := cont + 1;
          vPalavra[cont] := vAbreviado;
          vAbreviado := trim(copy(fNome,x,100));
          fNome := vAbreviado;
          vAbreviado := '';
          x := 0;
        end;
    end;
    cont := cont + 1;                //Aloca ultimo sobrenome (não abrevia)
    vPalavra[cont] := vAbreviado;
    vAbreviado := '';
    vAbreviado := vPalavra[1]+' ';   //Mantém nome principal
    for i := 2 to cont do            //Montar Abreviatura
      begin
        if (cont <> i) then
          begin                      //verifica partículas para repeti-las e não abrevia-las
            if (trim(vPalavra) = 'DA') or (trim(vPalavra) = 'DE') or (trim(vPalavra) = 'DAS')
            or (trim(vPalavra) = 'DO') or (trim(vPalavra) = 'DOS') or (trim(vPalavra) = 'E') then
              vAbreviado := vAbreviado + vPalavra+' '
            else  //abrevio nomes a partir da posião dois do vetor até penúltimo sobrenome
              vAbreviado := vAbreviado + copy(vPalavra,1,1)+'. '
          end
        else
          vAbreviado := vAbreviado + vPalavra;
      end;
  Result := vAbreviado;

end;