Discussion :

[Papy214]

J'ai codé ça rapidement en FMX sous Delphi Berlin et ça fonctionne.
Alors, pourquoi ne pas en faire profiter la communauté ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
function NoAccent(const Source: string): string;
var
 K: TArray<Byte>;
begin
  K := TEncoding.Convert(TEncoding.Unicode, TEncoding.ASCII, TEncoding.Unicode.GetBytes(Source));
  Result := StringOf(K);
end;
 
procedure TForm24.Button1Click(Sender: TObject);
begin
  ShowMessage(NoAccent('Éùéèàçùâêûî'));
end;

Résultat

---------------------------
Project5
---------------------------
Eueeacuaeui
---------------------------
OK
---------------------------

[Cirec]

Bonjour,

simple et fonctionnel Bravo !

Avant l'arrivée le l'UNICODE et de la classe TEncoding j'avais également "pondu" une fonction de ce type
le plus sympas dans l'histoire c'est qu'elle est compatible de D7 à Tokyo 10.2
pour ceux que ça intéresse de voir une approche différente voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
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
  pbResult        : PByte;
begin
  Result := S;
  pbResult := PByte(Result);
  while pbResult^ <> $0 do begin
    if pbResult^ > $7A then
      case pbResult^ of
        $8A: pbResult^ := $53;
        $8E: pbResult^ := $5A;
        $9E: pbResult^ := $7A;
        $9F: pbResult^ := $59;
        $C0..$DF: pbResult^ := ATC[pbResult^];
        $E0..$FF: pbResult^ := ATC[pbResult^ xor $20] xor $20;
      end;
    Inc(pbResult, SizeOf(Char));
  end;
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
const
  accent         : string = 'Essai de ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç';
begin
  ShowMessage(RemoveAccent(accent));
end;

Resultat:
[Window Title]
Project1
[Content]
Essai de AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc
[OK]
Cordialement,
@+

[Jipété]

je ne vois pas trop l'intérêt, merci de m'expliquer.

[Cirec]

je ne vois pas trop l'intérêt, merci de m'expliquer.

Que répondre à cela ?
Ben l'intérêt de ce code, comme de tout code d'ailleurs, est de faire ce pourquoi il a été conçu !!
ici il doit supprimer les accents.

Si on te demande de supprimer les accents des noms de fichiers ou d'un titre quelconque (par Ex.) ou toutes autres raisons.
Ben ... tu le fais.
Bien sûr il n'est pas question "d'écrire" un texte avec mais il peut quand même avoir son utilité
Cordialement,
@+

[Andnotor]

Ça marche impec

Juste un soucis au niveau des ligatures qui ne sont pas préservées (œ, æ, ß, etc.)

Voici une version purement Windows qui explose la chaîne en symboles distincts (caractères et accents) avant de supprimer les accents, tout en conservant les ligatures :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
function NoAccent(const Source: string): string;
var
  i: Integer;
begin
  SetLength(Result, FoldString(MAP_COMPOSITE, PChar(Source), Length(Source), nil, 0));
  FoldString(MAP_COMPOSITE, PChar(Source), Length(Source), PChar(Result), Length(Result));
 
  for i := Length(Result) downto 1 do
    if Result[i].GetUnicodeCategory = TUnicodeCategory.ucNonSpacingMark then
      Delete(Result, i, 1);
end;

Et pour faire exploser les ligatures :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
function NoLigature(const Source: string): string;
begin
  SetLength(Result, FoldString(MAP_EXPAND_LIGATURES, PChar(Source), Length(Source), nil, 0));
  FoldString(MAP_EXPAND_LIGATURES, PChar(Source), Length(Source), PChar(Result), Length(Result));
end;

je ne vois pas trop l'intérêt, merci de m'expliquer.

Un système qui permet de faire facilement une aide à la saisie, de proposer une liste de mots indépendamment des accents (ou ligatures)

[guillemouze]

Intéressant, mais je ne comprend pas pourquoi il a cette réaction ... certes ils sont dans la partie étendue (>128), mais les accents sont bien présents en ASCII.
Dans ce cas, comment fais tu pour convertir une chaine simple avec un accent en ansi, tout en le conservant ?

[Andnotor]

Intéressant, mais je ne comprend pas pourquoi il a cette réaction ... certes ils sont dans la partie étendue (>128), mais les accents sont bien présents en ASCII.
Dans ce cas, comment fais tu pour convertir une chaine simple avec un accent en ansi, tout en le conservant ?

Ne pas confondre ASCII (les 127 premiers caractères) et ANSI (255)

Sinon, la conversion Unicode - ANSI est implicite en Delphi, ANSIStr := UnicodeStr suffit.

[Papy214]

En remplaçant ASCII par ANSI

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
function NoAccent(const Source: string): string;
var
 K: TArray<Byte>;
begin
  K := TEncoding.Convert(TEncoding.Unicode, TEncoding.ANSI, TEncoding.Unicode.GetBytes(Source));
  Result := StringOf(K);
end;

---------------------------
Project5
---------------------------
Éùéèàçùâêûî
---------------------------
OK
---------------------------

[foetus]

Dans ce cas, comment fais tu pour convertir une chaine simple avec un accent en ansi, tout en le conservant ?

Ce sont les APIs Microsoft qui fait le fallback

[ShaiLeTroll]

je ne vois pas trop l'intérêt, merci de m'expliquer.

C'est utile pour des systèmes type Moteur de Recherche, en tout cas c'est ainsi que je l'ai appliqué sur un dictionnaire médicale de 800000 mots et comme Andnotor,
très attaché ligatures pour les mots comme œdème ou cœur (qu'il faut pouvoir trouvé en version ligaturée ou déliée)

Merci de ce partage

Dire que l'on faisait tout ça il y a dix ans, en été 2007 : https://www.developpez.net/forums/d3...lever-accents/
ou encore https://www.developpez.net/forums/d4...g/#post2765158

[Cirec]

... et comme Andnotor,
très attaché ligatures pour les mots comme œdème ou cœur (qu'il faut pouvoir trouvé en version ligaturée ou déliée) ...

pour une simple comparaison/recherche j'utilise ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
var
  dwCmpFlags        : Cardinal;
  Str1, Str2        : string;
begin
  Str1 := 'Coeur Biß œdème';
  Str2 := 'cœur biss oedeme';
  dwCmpFlags := NORM_IGNORECASE or NORM_IGNORENONSPACE or NORM_IGNORESYMBOLS;
  if CompareString(LOCALE_USER_DEFAULT, dwCmpFlags, PChar(Str1), -1,
    PChar(Str2), -1) = CSTR_EQUAL then ShowMessage('Egale');

qui fonctionne très bien sans changer un seul caractère

Cordialement,
@+

[Andnotor]

Le but (pour moi) de simplifier la chaîne est de calculer un hash unique quelque soit les variations de saisie. Après, on peut bien sûr utiliser CompareString sur les collisions.

[Invité]

Merci pour le code qui est effectivement utile pour enregistrer des fichiers ou autre.

@Cirec pour comparer tu peux utiliser le Soundex

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

function Soundex(const AText: string; ALength: TSoundexLength): string;