Fórum Funcao pegar primeiro e ultimo nome #266514

unit UNomeAbreviado;

interface

uses
  SysUtils,Classes;

function NomeAbreviado(Nome: String; TamanhoMaximo: Integer):String;
function ObterMaiorNome(Nomes: TStringlist): integer;
function ReduzNome(Nomes: tstringlist; TamanhoMaximo: Integer): String;
function SeparaNomes(Nome: String; n: TStringlist): TStringlist;
function VerTamanhoNome(Nomes: TStringlist): integer;

implementation

//
// Rotina para Abreviar Nomes
// Recebe Nome e o Tamanho Máximo do nome e
// retorna o Nome Abreviado (ou truncado caso não seja possível)
//
function NomeAbreviado(Nome: String; TamanhoMaximo: Integer):String;
var s: String;
    Nomes: TStringlist;
begin
  s := Trim(Nome);
  if Length(s) > TamanhoMaximo then
  begin
    Nomes := TStringlist.Create;
    try
      Nomes := SeparaNomes(s,Nomes);
      s := ReduzNome(Nomes,TamanhoMaximo);
    finally
      Nomes.Free;
    end;
  end;
  if Length(s) > TamanhoMaximo then // Trunca caso ainda ultrapasse o Tamanho Máximo
    s := Copy(s,1,TamanhoMaximo);
  Result := s;
end;

function ObterMaiorNome(Nomes: TStringlist): integer;
var i,IndMax,TamMax: Integer;
begin
  // Ver qual dos Nomes do meio é o maior
  IndMax := 0;
  TamMax := -1;
  if Nomes.Count > 1 then
    for i := 2 to (Nomes.Count-2) do // Poupa o Primeiro o Segundo e o Ultimo
    begin
      if not ((UpperCase(Nomes.Strings[i]) = ´DA´)  or {}
              (UpperCase(Nomes.Strings[i]) = ´DAS´) or
              (UpperCase(Nomes.Strings[i]) = ´DE´)  or
              (UpperCase(Nomes.Strings[i]) = ´DO´)  or
              (UpperCase(Nomes.Strings[i]) = ´DOS´) or
              (UpperCase(Nomes.Strings[i]) = ´E´)) then
        if Length(Nomes.Strings[i]) > TamMax then
        begin
          IndMax := i;
          TamMax := Length(Nomes.Strings[i]);
        end;
    end;
  Result := IndMax;
end;

function ReduzNome(Nomes: tstringlist; TamanhoMaximo: Integer): String;
var s: String;
    i,vezes : Integer;
    cont: boolean;
begin
  // Tenta primeiro abreviar os nomes do meio
  cont := true;
  vezes := 0;
  while (VerTamanhoNome(Nomes) > TamanhoMaximo) and (cont) do
  begin
    i := ObterMaiorNome(Nomes);
    if length (Nomes.Strings[i]) = 2 then
      Nomes.Strings[i] := ´´
    else
      Nomes.Strings[i] := Copy(Nomes.Strings[i],1,1) + ´.´;
    inc(vezes);
    // Sai da rotina caso já tenha passado por todos os nomes do meio
    cont := (vezes<=(Nomes.Count-2));
  end;
  cont := true;
  // Retira caso necassario os nomes do meio
  while (VerTamanhoNome(Nomes) > TamanhoMaximo) and (cont) do
  begin
    i := ObterMaiorNome(Nomes);
    Nomes.Strings[i] := ´´;
    inc(vezes);
    // Sai da rotina caso já tenha passado por todos os nomes do meio
    cont := (vezes <= Nomes.Count);
  end;
  // Monta o nome abreviado
  for i := 0 to (Nomes.Count-1) do
  begin
    if Length(Nomes.Strings[i]) > 0 then
      s := s + Nomes.Strings[i] + ´ ´;
  end;
  result := Trim(s);
end;

function SeparaNomes(Nome: String; n: TStringlist): TStringlist;
var s: String;
    i: Integer;
begin
  // Quebra o nome em varias strings
  s := Nome;
  while Length(Trim(s)) > 0 do
  begin
    i := Pos(´ ´,Trim(s));
    if i = 0 then
      i := Length(s);
    n.Add (Trim(Copy(s,1,i)));
    s := Trim(Copy(s,i+1,Length(s)));
  end;
  Result := n;
end;

function VerTamanhoNome(Nomes: TStringlist): integer;
var i,total,espacos: Integer;
begin
  // Ver o tamanho total do nome (soma das strings)
  total :=0;
  espacos :=0; // Vai somar os espaços em branco (numero de nomes - 1)
  for i := 0 to (Nomes.Count-1) do
  begin
    total := total + Length(Trim(Nomes.Strings[i]));
    if Length(Trim(Nomes.Strings[i])) > 0 then // Só nomes com algum conteudo
      inc(espacos);
  end;
  espacos := espacos - 1; // Qts de nomes com cont. - 1
  Result := (total + espacos);
end;

end.

     { Pegar a posição do último espaço }
     for i := Length(s) downto 1 do
     begin
          if s[i] = ´ ´ then Break;
     end;

     Result := Copy(s, 1, Pos(´ ´,s)-1) + Copy(s, i, Length(s) - i + 1);