Função para ajustar nomes próprios
Função que deixa as iniciais das palavras de uma String em maiúsculas.
Sendo uma grande ferramenta para o ajuste de nomes Próprios.
Quantas vezes já nos deparamos com importação de dados, onde o cadastro original não estava preenchido corretamente os nomes de pessoas, por exemplo.
Isso no que diz respeito a falta de padrão.
Alguns podem estar com todas as letras em maiúsculo outros
em minúsculos, outros ainda misturado e etc.
Esta função facilita a nossa vida.
É necessário estar declarado SysUtils na seção uses.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
| function GetNomeProprio(Texto: string): string;
var
tam, i: integer;
aux, s: string;
begin
texto := AnsiLowerCase(texto);
aux := '';
for i := 1 to length(texto) do
begin
if i = 1 then
begin
aux := Copy(AnsiUpperCase(texto[i]), i, 1);
aux := aux + texto[i + 1];
end
else if texto[i] = ' ' then
aux := aux + Copy(AnsiUpperCase(texto[i + 1]), 1, 1)
else
aux := aux + texto[i + 1]
end;
i := 2;
tam := length(aux);
while i <= length(aux) do
begin
s := '';
s := Copy(aux, i, 3);
if (s = 'Do ') or (s = 'Da ') or (s = 'De ') then
begin
s := Copy(LowerCase(aux), i, 1);
aux := Copy(aux, 1, i - 1) + s + Copy(aux, i + 1, (tam - i));
end
else if (s = 'Dos') or (s = 'Das') then
begin
s := Copy(LowerCase(aux), i, 1);
aux := Copy(aux, 1, i - 1) + s + Copy(aux, i + 1, (tam - i));
end;
i := i + 1;
end;
Result := aux;
end; |
function GetNomeProprio(Texto: string): string;
var
tam, i: integer;
aux, s: string;
begin
texto := AnsiLowerCase(texto);
aux := '';
for i := 1 to length(texto) do
begin
if i = 1 then
begin
aux := Copy(AnsiUpperCase(texto[i]), i, 1);
aux := aux + texto[i + 1];
end
else if texto[i] = ' ' then
aux := aux + Copy(AnsiUpperCase(texto[i + 1]), 1, 1)
else
aux := aux + texto[i + 1]
end;
i := 2;
tam := length(aux);
while i <= length(aux) do
begin
s := '';
s := Copy(aux, i, 3);
if (s = 'Do ') or (s = 'Da ') or (s = 'De ') then
begin
s := Copy(LowerCase(aux), i, 1);
aux := Copy(aux, 1, i - 1) + s + Copy(aux, i + 1, (tam - i));
end
else if (s = 'Dos') or (s = 'Das') then
begin
s := Copy(LowerCase(aux), i, 1);
aux := Copy(aux, 1, i - 1) + s + Copy(aux, i + 1, (tam - i));
end;
i := i + 1;
end;
Result := aux;
end;
Exemplo de uso
1
2
3
4
5
6
| procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetNomeProprio('show delphi'));
ShowMessage(GetNomeProprio('giovani da cruz'));
end; |
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetNomeProprio('show delphi'));
ShowMessage(GetNomeProprio('giovani da cruz'));
end;
Baseado no post: http://forum.imasters.com.br/topic/232810-funcao-que-deixa-as-iniciais-de-uma-string-em-maiusculas/
-
Giovani Da Cruz
-
3.132 views
- 0 comentários
- 12 de março de 2016
Está gostando do conteúdo? Considere pagar um cafezinho para nossa equipe!
Posts Relacionados - Continue Aprendendo