Supprimer les accents d'une chaîne

Invité · 22/01/2017, 13h20

Bonjour,

je cherche un moyen de supprimer tous les accents d'une chaîne de caractères.
J'ai trouvé des fonctions pour Delphi, mais je n'ai rien trouvé jusqu'alors qui fonctionne sous Lazarus.

Quelqu'un a-t-il une solution ?

Merci d'avance.
Ben

**Flagad'aware** · 22/01/2017, 19h53

Salut,

j'ai regardé pour t'aider mais il y a un soucis avec les chaines de caractères sous Lazarus...

si je fait:

Code :

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

Showmessage(chaine[i]);

avec chaine et i bien initialisés et bien ça donne une boite de dialogue vide...

Edit: ah non, c'est les accents qui posent problème sinon chaine[i] fonctionne...

Invité · 22/01/2017, 20h13

je n'ai pas constaté de problème de ce genre.

je viens de tester ceci

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.Button1Click(Sender: TObject);
var
  long,
    i: Integer;
begin
     long := Length(Edit1.Text);
     Caption := '';
     for i := 1 to long do
     begin
       Caption := Caption + Edit1.Text[i];
     end;
end;

tous les caractères sont bien repris.

**Flagad'aware** · 22/01/2017, 20h33

effectivement avec un TEdit ça fonctionne...

essaye ça alors:

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
procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(enleveaccents('éàèù'));
end;
 
function TForm1.EnleveAccents(AText : String) : string;
const
  Char_Accents      = 'ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÇçÌÍÎÏìíîïÙÚÛÜùúûüÿÑñ';
  Char_Sans_Accents = 'AAAAAAaaaaaaOOOOOOooooooEEEEeeeeCcIIIIiiiiUUUUuuuuyNn';
var
  I, J : Integer;
  sTemp : String;
begin
  sTemp :=AText;
  showmessage(stemp);
  showmessage(stemp[2]);
  For i := 1 to Length(sTemp) do
    //sTemp := FastReplace(sTemp, Char_Accents[i], Char_Sans_Accents[i]);
    sTemp := StringReplace(sTemp,Char_Accents[i],Char_Sans_Accents[i],[rfReplaceAll]);
  Result := sTemp;
end;

c'est pas de moi je l'ai trouvé sur ce forum

chez moi ça donne 'A?A?A'...

Edit: ça donne 'éàèù', rien (boite vide) puis 'A?A?A'

Invité · 23/01/2017, 10h52

bonjour,

il me semble que j'avais tester une méthode de ce type et que j'avais eu des résultats du même genre que quoi...
je vais refaire des tests ce soir.

ben

**Roland Chastain** · 23/01/2017, 11h17

Bonjour !

Le sujet avait été traité, par exemple, dans cette discussion :
http://www.developpez.net/forums/d14...ne-fonctionne/

Je viens de tester rapidement la solution que j'avais proposée à l'époque mais j'ai l'impression qu'elle ne fonctionne plus avec Lazarus 1.6.2.

Malheureusement je n'ai pas le temps de me pencher davantage sur le problème aujourd'hui. En espérant vous avoir mis quand même sur la piste d'une solution...

**ThWilliam** · 23/01/2017, 12h20

Bonjour,

Voici la fonction que j'utilise (posté dans sources/tri stringlist)

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
function RemoveAccent(S: string): string;
{remplacement des caractères accentués dans la table UTF8 LATIN BASIC}
{En UTF8, les caractères accentués sont codés sur 2 octets :
   le premier = $C3
   le deuxième : de $80 à $BF }
 
var
  i: integer;
  ch: char;
begin
   if Length(S) = 0 then
   begin
      Result:= S;
      Exit;
   end;
   i:= 1;
   repeat
      if byte(S[i]) = $C3 then
      begin
        ch:= #0;
        case byte(S[i+1]) of
          $80..$86 : ch:= 'A';
          $87      : ch:= 'C';
          $88..$8B : ch:= 'E';
          $8C..$8F : ch:= 'I';
          $92..$96 : ch:= 'O';
          $98      : ch:= 'O';
          $99..$9C : ch:= 'U';
          $9D      : ch:= 'Y';
          $A0..$A6 : ch:= 'a';
          $A7      : ch:= 'c';
          $A8..$AB : ch:= 'e';
          $AC..$AF : ch:= 'i';
          $B2..$B6 : ch:= 'o';
          $B8      : ch:= '0';
          $B9..$BC : ch:= 'u';
          $BD, $BF : ch:= 'y';
        end;
        if ch <> #0 then
        begin
          Delete(S,i,1); // effacement du premier octet
          S[i]:= ch;     // remplacement du 2° octet
        end;
      end;
      Inc(i);
   until i > length(s);
   Result:= S;
end;

Cordialement
Thierry

**DomDA91** · 23/01/2017, 12h20

Envoyé par Roland Chastain

Bonjour !

Le sujet avait été traité, par exemple, dans cette discussion :
http://www.developpez.net/forums/d14...ne-fonctionne/

Je viens de tester rapidement la solution que j'avais proposée à l'époque mais j'ai l'impression qu'elle ne fonctionne plus avec Lazarus 1.6.2.

A partir de Lazarus 1.6 et FPC 3.0 il ne faut plus utiliser AnsiToUTF8 ou UTF8ToAnsi pour convertir explicitement une chaîne entre Ansi et UTF8.

A la place il faut utiliser WinCPToUTF8 et UTF8ToWinCp de l'unité LazUtf8 :

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
Uses LazUTF8;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  avant, apres, temp: string;
  i: integer;
begin
  avant := UTF8ToWinCP('àéèê');
  apres := UTF8ToWinCP('aeee');
 
  temp := UTF8ToWinCP(Memo1.Lines.Text);
 
  for i := 1 to Length(avant) do
    temp := StringReplace(temp, avant[i], apres[i], [rfReplaceAll]);
 
  Memo1.Lines.Text := WinCPToUTF8(temp);
end;

Envoyé par ThWilliam

{En UTF8, les caractères accentués sont codés sur 2 octets :
le premier = $C3
le deuxième : de $80 à $BF }

Faux en ce qui concerne 'Ÿ' (majuscule) qui ne commence pas par $C3 mais est codé #$C5#$B8

**ThWilliam** · 23/01/2017, 14h03

Envoyé par DomDA91

Faux en ce qui concerne 'Ÿ' (majuscule) qui ne commence pas par $C3 mais est codé #$C5#$B8

Bonjour DomDA91,

Tu as raison, mais j'ai bien précisé que la fonction ne traitait que la table latin BASIC.
'Ÿ' fait partie de la table latin EXTENDED.

Je reconnais donc que mon code ne prend en charge que les caractères latins les plus usités.
Cordialement
Thierry

Invité · 23/01/2017, 14h13

je vous remercie de vos réponses.
je teste tout ça ce soir

**Andnotor** · 23/01/2017, 17h15

Il y a l'API FoldString qui permet de faire cela assez facilement. FoldString(MAP_COMPOSITE) va décomposer chaque caractère de la chaîne en son caractère de base et son accent. Une boucle permet ensuite de ne conserver que les caractères.

Un exemple ici.

**DomDA91** · 23/01/2017, 18h37

Envoyé par Andnotor

Il y a l'API FoldString qui permet de faire cela assez facilement. ...

FoldString, n'est-ce pas une fonction de l'API Windows ? Si c'est le cas ça risque de ne pas être multi-plateforme et benoit1024 est peut-être sous un autre OS.

Invité · 23/01/2017, 20h48

je n'avais pas précisé l'os, j'alterne entre windows et linux. je recherche donc effectivement une solution mulit plateforme.

je viens de tester ce code, cela ne fonctionne pas.
je récupère '*** l'aela" au lieu de ***' l''eleve A [des} (Y)eux a lui !!'

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
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := '*** l''élève Â [des} (Y)eux à lui !!';
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
     Edit2.Text := SupprimerAccents(Edit1.Text);
end;
 
function TForm1.SupprimerAccents(txt: String): String;
var
  avant, apres, temp: string;
  i: integer;
begin
  avant := UTF8ToWinCP('ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÇçÌÍÎÏìíîïÙÚÛÜùúûüÿÑñ');
  apres := UTF8ToWinCP('AAAAAAaaaaaaOOOOOOooooooEEEEeeeeCcIIIIiiiiUUUUuuuuyNn');
  temp := UTF8ToWinCP(txt);
 
  for i := 1 to Length(avant) do
    temp := StringReplace(temp, avant[i], apres[i], [rfReplaceAll]);
 
  Result := WinCPToUTF8(temp);
end;

par contre, le code suivant fonctionne correctement :

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := '*** l''élève Â [des} (Y)eux à lui !!';
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
     Edit2.Text := RemoveAccent(Edit1.Text);
end;
 
 
function TForm1.RemoveAccent(S: string): string;
{remplacement des caractères accentués dans la table UTF8 LATIN BASIC}
{En UTF8, les caractères accentués sont codés sur 2 octets :
   le premier = $C3
   le deuxième : de $80 à $BF }
 
var
  i: integer;
  ch: char;
begin
   if Length(S) = 0 then
   begin
      Result:= S;
      Exit;
   end;
   i:= 1;
   repeat
      if byte(S[i]) = $C3 then
      begin
        ch:= #0;
        case byte(S[i+1]) of
          $80..$86 : ch:= 'A';
          $87      : ch:= 'C';
          $88..$8B : ch:= 'E';
          $8C..$8F : ch:= 'I';
          $92..$96 : ch:= 'O';
          $98      : ch:= 'O';
          $99..$9C : ch:= 'U';
          $9D      : ch:= 'Y';
          $A0..$A6 : ch:= 'a';
          $A7      : ch:= 'c';
          $A8..$AB : ch:= 'e';
          $AC..$AF : ch:= 'i';
          $B2..$B6 : ch:= 'o';
          $B8      : ch:= '0';
          $B9..$BC : ch:= 'u';
          $BD, $BF : ch:= 'y';
        end;
        if ch <> #0 then
        begin
          Delete(S,i,1); // effacement du premier octet
          S[i]:= ch;     // remplacement du 2° octet
        end;
      end;
      Inc(i);
   until i > length(s);
   Result:= S;
end;

gros merci à tous de votre aide

**jurassic pork** · 24/01/2017, 06h23

Hello,
il y a aussi la fonction removediacritics qui se trouve dans la bibliothèque rutils de Silvioprog :

Some general purpose routines on string conversions, parsings, encodings and others.
Most of them are writen in low level programming which assures high performance and responsiveness.

1 - Télécharger le fichier zip qui se trouve ici
2 - N'extraire que le fichier rutils.pas et le mettre dans le répertoire de son projet.

Exemple d'utilisation :

Code :

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

1
2
3
4
5
6
7
8
9
implementation
uses rutils;
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
   Edit2.Text := RemoveDiacritics(Edit1.Text);
   Edit3.Text := RemoveDiacritics('ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÇçÌÍÎÏìíîïÙÚÛÜùúûüÿÑñ');
end;

et voici le résultat :

Nom : Lazarus_RemoveDiacritics.png
Affichages : 1040
Taille : 7,0 Ko

Nom : Lazarus-remodiacritics-ubuntu.png
Affichages : 1024
Taille : 15,2 Ko

Ami calmant, J.P

**Jipété** · 24/01/2017, 09h44

bonjour,

et chaque fois que je vois ce genre de question, je me pose la même question : mais pourquoi ?

À partir du moment où l'accent a pleine valeur orthographique, pourquoi vouloir le(s) supprimer ?
Une praline et un praliné, ce n'est pas la même chose, alors si quelqu'un pouvait m'expliquer...

Parce que sans accents ça risque d'être top, dans une BdD de stock, genre

Code :

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

1
2
3
Réf. Article Qté
126  Praline  27
512  Praline  18

**gvasseur58** · 24/01/2017, 09h55

Envoyé par Jipété

À partir du moment où l'accent a pleine valeur orthographique, pourquoi vouloir le(s) supprimer ?

Bonjour Jipété,

Tu as entièrement raison s'il s'agit de l'affichage des chaînes, mais leur traitement est parfois simplifié si les caractères accentués sont ramenés à des caractères présents dans le corps originel ASCII. Je pense notamment au tri alphabétique : essaye de trier directement des mots accentués avec Lazarus

.

PS : Je précise que Delphi trie correctement sans ce subterfuge.

**Jipété** · 24/01/2017, 10h37

Bonjour Gilles,

Envoyé par gvasseur58

Tu as entièrement raison s'il s'agit de l'affichage des chaînes, mais leur traitement est parfois simplifié si les caractères accentués sont ramenés à des caractères présents dans le corps originel ASCII.

Je te laisse imaginer les subterfuges à mettre en œuvre avec les mots modelé et modèle,

tu vas te retrouver avec deux fois modele et attention les doublons, nécessaires cette fois !
Bonjour la prise de tête, car ça va obliger à quand même stocker la string accentuée pour l'afficher (et l'imprimer [factures, devis...]) correctement, hé oui...

OK, je ne connais rien aux BdD, mais je sais quand même qu'il y a des index (numériques, je suppose), et que le traitement serait grandement simplifié en les utilisant plutôt que de jongler avec modele01, modele02, ou praline01 praline02...

Bon courage à ceux qui doivent s'y coller !

Invité · 24/01/2017, 13h32

jurassic pork, merci pour ta solution, je vais tester ça

Jipété il y a de nombres raison de vouloir supprimer ce type de caractères.
j'en ai besoin ici pour renommer des noms de fichiers. il y a encore de nombreux cas où les fichiers contenant des accents posent problème.

encore merci à tous pour vos réponses

Invité · 24/01/2017, 21h05

Envoyé par jurassic pork

Hello,
il y a aussi la fonction removediacritics qui se trouve dans la bibliothèque rutils de Silvioprog :

1 - Télécharger le fichier zip qui se trouve ici
2 - N'extraire que le fichier rutils.pas et le mettre dans le répertoire de son projet.

je confirme que cette méthode fonctionne parfaitement.
c'est celle qque je vais utiliser.

bon dèv à tous

**Roland Chastain** · 25/01/2017, 12h24

Envoyé par benoit1024

je confirme que cette méthode fonctionne parfaitement.

En fait toutes les méthodes proposées fonctionnent. Il est à noter toutefois que la méthode proposée par Andnotor convient pour un mot, mais pas pour un texte, car elle supprime tout caractère qui n'est pas alphanumérique.

Je me suis amusé à faire une petite application qui permet d'essayer les différentes méthodes.

Supprimer les accents d'une chaîne [Lazarus]

Lazarus Pascal

Discussions similaires

Partager

Partager