sábado, 30 de novembro de 2013

Funcao Troca somente os Caracteres que estao definidos com acentos


////////////////////////////////////////////////////////////////
// Esta funcao Troca somente os Caracteres que estao definidos com acentos
// Ela nao tira '()-.:;,/' e espacos em branco como faz a RemoveAcentos.
//////////////////////////////////////////////////////////////

Function RemoveSoAcentos(texto: String): String ;
Var
   sAux, sAux2, sAcentos, sTrocas, sLetra: String ;
   iLoop: Integer ;
Begin
   sAcentos := 'áàäâãåÁÀÄÂÃÅéèëêÉÈËÊíìïîÍÌÏÎóòöôõÓÒÖÔÕúùüûÚÙÜÛýÿÝYçÇñѺª' ;
   sTrocas := 'aaaaaaAAAAAAeeeeEEEEiiiiIIIIoooooOOOOOuuuuUUUUyyYYcCnNoa' ;
   sAux := '' ;
   For iLoop := 1 To Length(texto) Do Begin
      sAux2 := (Copy(texto, iLoop, 1)) ;
      If (Pos(sAux2, sAcentos) > 0) Then Begin
         sLetra := Copy(sTrocas, (Pos(sAux2, sAcentos)), 1) ;
         If sLetra <> ' ' Then sAux := sAux + sLetra ;
      End
      Else Begin
         sAux := sAux + sAux2 ;
      End ;
   End ;
   Result := sAux ;
End ;

Nenhum comentário:

Postar um comentário