criando funçao para substituir acentos ...

Delphi

15/02/2004

alguem sabe c tem algum jeito de ´detectar´ palavras que tenham acento e substituir pela letra sem acento em uma string?

ex ... exércãtô .. e ele poe pra exercato ... ?????

valeuz


Salsa

Salsa

Curtidas 0

Respostas

Chico Gois

Chico Gois

15/02/2004

Beleza!

Experimente

Procedure RemoveAcentos(Var str:String);
Var i,p : Integer;
    s1,s2 : STring;
Begin
  s1 := ´ÁÂÃÉÊÍÓÕÔÚÇáâãéêíóõôúç´;
  s2 := ´AAAEEIOOOUCaaaeeiooouc´;
  For i := 1 to Length(Str) do Begin
     p := Pos(str[i],s1);
     if p<>0 Then str[i] := s2[p];
  End;
End



T+


GOSTEI 0
Salsa

Salsa

15/02/2004

no caso tem como eu fazer ele substituir ex ....

é por eh ?
á por ah queria substiuir do jeito q eu quero ..

pq tipo pelo oq eu vi ali ele pega a position e talz ... e substiutui de acordo com a outra .. ae pra mim nao da mto certo ...


sabe c tem como?


GOSTEI 0
Salsa

Salsa

15/02/2004

poxa pessoal sera q ninguem sabe como me ajudaR? valeuz!


GOSTEI 0
Fabio.hc

Fabio.hc

15/02/2004

Tente assim:
Pegando a rotina que o FGOIS passou e adaptando para devolver 2 caracteres para cada caracter com acento:

function RemoveAcentos(Var str:String):string;
Var i,p,q : Integer;
    s1,s2 : STring;
Begin
   s1 := ´ÁÂÃÉÊÍÓÕÔÚÇáâãéêíóõôúç´;
   s2 := ´AHAHAHEHEHIHOHOHOHUHC ahahahehehihohohohuhc ´;
   For i := 1 to Length(Str) do
      Begin
      p := Pos(str[i],s1);
      if p<>0 Then
         begin
         p:=p*2;
         result:=result+s2[p-1];
         if not(str[i] in [´Ç´,´ç´]) then
            result:=result+s2[p];
         end
      else
         result:=result+Str[i];
   End;
End;



GOSTEI 0
Salsa

Salsa

15/02/2004

po valeu ... soh q infelizmente eu descobri que tenho q pra cada tipo de letra subistituir por algo especifico ..


ex ...

á por ah
ã por a
â por an

coisa do tipo ....

tem como usar um case ou sei la nessa funçao pra mim especificar como eu substituo e talz?

valeuz!!! :wink:


GOSTEI 0
Lucas Silva

Lucas Silva

15/02/2004

Salsa, não testei esse código não mais dá uma tentada ai..
function TForm1.RetiraAcento(palavra: String): String;
var i: integer;
begin
   for i:= 0 to  Length(palavra) - 1 do
     begin
       case palavra[i] of
            ´á´,´Á´ : palavra[i] := ´A´;
            ´é´,´É´ : palavra[i] := ´E´;
            ´í´,´Í´ : palavra[i] := ´I´;
            ´ó´,´Ó´ : palavra[i] := ´O´;
            ´ú´,´Ú´ : palavra[i] := ´U´;
            ´à´,´À´ : palavra[i] := ´A´;
            ´è´,´È´ : palavra[i] := ´E´;
            ´ì´,´Ì´ : palavra[i] := ´I´;
            ´ò´,´Ò´ : palavra[i] := ´O´;
            ´ù´,´Ù´ : palavra[i] := ´U´;
            ´â´,´Â´ : palavra[i] := ´A´;
            ´ê´,´Ê´ : palavra[i] := ´E´;
            ´î´,´Î´ : palavra[i] := ´I´;
            ´ô´,´Ô´ : palavra[i] := ´O´;
            ´û´,´Û´ : palavra[i] := ´U´;
            ´ä´,´Ä´ : palavra[i] := ´A´;
            ´ë´,´Ë´ : palavra[i] := ´E´;
            ´ï´,´Ï´ : palavra[i] := ´I´;
            ´ö´,´Ö´ : palavra[i] := ´O´;
            ´ü´,´Ü´ : palavra[i] := ´U´;
            ´ç´,´Ç´ : palavra[i] := ´C´;
            ´ñ´,´Ñ´ : palavra[i] := ´N´;
            else palavra[i] := ´ ´;
     end;
end;



GOSTEI 0
Salsa

Salsa

15/02/2004

[b:725b7cc63e]salsa[/b:725b7cc63e], me diga como ficaria a palavra [b:725b7cc63e][color=darkblue:725b7cc63e]parâmetro[/color:725b7cc63e][/b:725b7cc63e] aplicando a sua regra de substituição.


ele ficaria ... ´paranmetro´ como se fala tendeu?


GOSTEI 0
Salsa

Salsa

15/02/2004

lucas infelizmente nao quer sobstituir por um CHAR .. quero substituir por uma palavra ... entao teu codigo nao funciona ... :(


GOSTEI 0
Lucas Silva

Lucas Silva

15/02/2004

lucas infelizmente nao quer sobstituir por um CHAR .. quero substituir por uma palavra ... entao teu codigo nao funciona ... :(


Tenta fazer uma rotina com aquela lógica que te passei....
Alterando poucas coisas acho que da pra fazer com CHAR


GOSTEI 0
Fabio.hc

Fabio.hc

15/02/2004

Tente assim:
Mudei a função que passei acima.
Ex: Cada letra com acentro é trocado por dois caracteres, a variável s1 contém todos os carateres com acento, a variáel s2 contém os caracteres que vc quer substituir, para visualização a variável s1 que está com comentário mostra as posições de s1 com s2, basta vc trocar em s2 os caracteres.

function RemoveAcentos(Var str:String):string;
Var i,p,q : Integer;
    s1,s2 : STring;
Begin
   s1 := ´ÁÂÃÉÊÍÓÕÔÚÇáâãéêíóõôúç´;
// s1 := ´Á Â Ã É Ê Í Ó Õ Ô Ú Ç á â ã é ê í ó õ ô ú ç ´;
   s2 := ´AHA ANEHEHIHOHOHOHUHC aha anehehihohohohuhc ´;
   For i := 1 to Length(Str) do
      Begin
      p := Pos(str[i],s1);
      if p<>0 Then
         begin
         p:=p*2;
         result:=result+s2[p-1];
         if (s2[p] <> ´ ´) then
            result:=result+s2[p];
         end
      else
         result:=result+Str[i];
   End;
End;



GOSTEI 0
Chico Gois

Chico Gois

15/02/2004

Sera isto?

function BuscaTroca(Text,Busca,Troca : string) : string;
var n : integer;
begin
for n := 1 to length(Text) do
begin
if Copy(Text,n,1) = Busca then
begin
Delete(Text,n,1);
Insert(Troca,Text,n);
end;
end;
Result := Text;
end;




T+


GOSTEI 0
Salsa

Salsa

15/02/2004

teste com essa rotina: function RemoveAcentos(str:String):string; const Acentos = ´ÁÂÃÉÊÍÓÕÔÚÇáâãéêíóõôúç´;           SubstituirPor: array[1..22] of string = (´AH´,´AN´, ´A´, ´EH´, ´E´, ´I´, ´OH´, ´O´, ´ON´, ´UH´, ´C´,                                                                       ´ah´,´an´, ´a´, ´eh´, ´e´, ´i´, ´oh´, ´o´, ´on´, ´uh´, ´c´ ); var i: integer; begin     Result := str;     for i := 1 to Length(Acentos) do         if pos( Acentos[i],Str ) <> 0 then                 Result := StringReplace( Result,Acentos[i],SubstituirPor[i],[rfReplaceAll] ); end; mas eu fiz o teste com a palavra ´chapéu´ e não ficou muito legal...


cara eu pra mim funcionou legal ... soh que eu queria q antes dele substituir os acentos ....

se ele encontrasse ÃO la na string ... ele substituisse por AUM ..
eh q to tentando trabalhar com fonetica e talz ....

vc tem ideia de como fazer?


GOSTEI 0
POSTAR