Retirando Acentos!

[arag...@gmail.com]

Para os colegas que tem que retirar acentos em progress , segue
programa :


DEFINE INPUT-OUTPUT PARAMETER c-string AS CHARACTER NO-UNDO.

FUNCTION fi-tira-acento RETURNS CHARACTER (INPUT c-de AS CHARACTER).
DEFINE VARIABLE c-result AS CHARACTER NO-UNDO CASE-SENSITIVE.

assign c-result = c-de.
assign c-result = REPLACE(c-result,'ç':U,'c':U)
c-result = REPLACE(c-result,'Ç':U,'C':U)
c-result = REPLACE(c-result,'ã':U,'a':U)
c-result = REPLACE(c-result,'Ã':U,'A':U)
c-result = REPLACE(c-result,'á':U,'a':U)
c-result = REPLACE(c-result,'Á':U,'A':U)
c-result = REPLACE(c-result,'à':U,'a':U)
c-result = REPLACE(c-result,'À':U,'A':U)
c-result = REPLACE(c-result,'â':U,'a':U)
c-result = REPLACE(c-result,'Â':U,'A':U)
c-result = REPLACE(c-result,'é':U,'e':U)
c-result = REPLACE(c-result,'É':U,'E':U)
c-result = REPLACE(c-result,'è':U,'e':U)
c-result = REPLACE(c-result,'È':U,'E':U)
c-result = REPLACE(c-result,'ê':U,'e':U)
c-result = REPLACE(c-result,'Ê':U,'E':U)
c-result = REPLACE(c-result,'í':U,'i':U)
c-result = REPLACE(c-result,'Í':U,'I':U)
c-result = REPLACE(c-result,'ì':U,'i':U)
c-result = REPLACE(c-result,'Ì':U,'I':U)
c-result = REPLACE(c-result,'î':U,'i':U)
c-result = REPLACE(c-result,'Î':U,'I':U)
c-result = REPLACE(c-result,'õ':U,'o':U)
c-result = REPLACE(c-result,'Õ':U,'O':U)
c-result = REPLACE(c-result,'ó':U,'o':U)
c-result = REPLACE(c-result,'Ó':U,'O':U)
c-result = REPLACE(c-result,'ò':U,'o':U)
c-result = REPLACE(c-result,'Ò':U,'O':U)
c-result = REPLACE(c-result,'ô':U,'o':U)
c-result = REPLACE(c-result,'Ô':U,'O':U)
c-result = REPLACE(c-result,'ú':U,'u':U)
c-result = REPLACE(c-result,'Ú':U,'U':U)
c-result = REPLACE(c-result,'ù':U,'u':U)
c-result = REPLACE(c-result,'Ù':U,'U':U)
c-result = REPLACE(c-result,'û':U,'u':U)
c-result = REPLACE(c-result,'Û':U,'U':U).

RETURN c-result.
END FUNCTION.

ASSIGN c-string = fi-tira-acento(INPUT c-string).

[Robert]

Eu tenho uma função aqui, um pouco diferente.
O único detalhe é que não tenho certeza se todos os caracteres
acentuados estão considerados nos códigos ascii (variável c-asc). Caso
faltou algum, basta incluir o código ascii na variável (c-asc) e o
caracter a substituir na variável c-subst.


FUNCTION limpa-texto RETURNS CHAR (INPUT c-texto AS CHAR).
DEFINE VARIABLE i-aux AS INTEGER NO-UNDO.
DEFINE VARIABLE c-retorno AS CHARACTER INIT "" NO-UNDO.
DEFINE VARIABLE c-asc AS CHARACTER NO-UNDO.
DEFINE VARIABLE c-subst AS CHARACTER NO-UNDO.
DEFINE VARIABLE c-codasc AS INTEGER NO-UNDO.
DEFINE VARIABLE c-caracter AS CHARACTER NO-UNDO.

ASSIGN c-asc =
"225,233,237,243,250,193,201,205,211,218,224,232,236,242,249,192,200,204,210,217,226,234,238,244,251,194,202,206,212,219,228,235,239,246,252,196,203,207,214,220,227,245,195,213,231,199,186,170,254,167,183"
c-subst =
"a,e,i,o,u,A,E,I,O,U,a,e,i,o,u,A,E,I,O,U,a,e,i,o,u,A,E,I,O,U,a,e,i,o,u,A,E,I,O,U,a,o,A,O,c,C,o,a,c,o,u".


DO i-aux = 1 TO LENGTH(c-texto):
ASSIGN c-codasc = asc(SUBSTRING(c-texto,i-aux,1))
c-caracter = SUBSTRING(c-texto,i-aux,1).

IF c-codasc > 126 THEN DO:
ASSIGN c-retorno = c-retorno + IF LOOKUP(STRING(c-
codasc),c-asc) > 0 THEN ENTRY(LOOKUP(STRING(c-codasc),c-asc),c-subst)
ELSE string(c-codasc).
END.
ELSE
ASSIGN c-retorno = c-retorno + c-caracter.

END.
RETURN c-retorno.

END FUNCTION.