Function RemoveAccent(Const S : String): String;
Const
ATC : Array[$C0..$DF] Of Byte = ($41,$41,$41,$41,$41,$41,$41,$43,$45,$45,$45,
$45,$49,$49,$49,$49,$44,$4E,$4F,$4F,$4F,$4F,$4F,$4F,$4F,$55,$55,$55,$55,$59,$42,$59);
Var P, PR : PByte;
Size : Integer;
Begin
P := PByte(S);
Size := Length(S);
SetLength(Result, Size);
PR := PByte(Result);
While P^ <> $0 do Begin
If P^ > $7A Then
Case P^ Of
$8A : Pr^ := $53;
$8E : Pr^ := $5A;
$9E : Pr^ := $7A;
$9F : Pr^ := $59;
$C0..$DF : Pr^ := ATC[P^];
$E0..$FF : Pr^ := ATC[P^ Xor $20] Xor $20;
Else Pr^ := P^;
End Else Pr^ := P^;
Inc(P);
Inc(Pr);
End;
End;