Discussion :

[Roland Chastain]

Bonjour !

J'aurais besoin d'une fonction qui remplacerait le premier caractère d'une chaîne par une majuscule, y compris les caractères accentués.

Quelle serait la version correcte du code suivant ?

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
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
function Majuscule(s: string): string;
begin
  result := s;
  if result[1] = 'î' then
    result[1] := 'Î'; // Error: Incompatible types: got "Constant String" expected "Char"
end;
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'île';
  Edit2.Text := Majuscule(Edit1.Text);
end;
 
end.

[Jipété]

Quelle serait la version correcte du code suivant ?

Peut-être

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
uses LazUTF8;
 
function Utf8LeftStr(const AText: String; const ACount: Integer): String;
begin
  Result := Utf8Copy(AText, 1, ACount);
end;
 
function Majuscule(s: AnsiString): AnsiString;
begin
  result := s;
  if Utf8LeftStr(result, 1) = 'î' then
    result := Utf8UpperCase(Utf8LeftStr(result, 1)) + Utf8Copy(result, 2, Length(result));
end;

que j'avais dans un coin.

Testé avec ton "île", fonctionne.

[alanglet]

Bonjour,

A mon avis, le problème est dû au fait que Lazarus travaille en interne en UTF8. "Î" en UTF8 est codé sur au moins 2 octets.
s:=UpperCase(Copy(s,1,1))+Copy(s,2,MaxInt); devrait marcher si "UTF8 dans la RTL" est défini pour le projet, sans cela il faudrait sans doute utiliser les versions UTF8UpperCase et UTF8Copy des fonctions de l'unité LazUtf8. Les joies de l'UTF8

André

Edit: trop tard

PS: UTF8Leftstr est déjà défini dans LazUtf8

[tourlourou]

Bonjour Roland,

Il serait peut-être plus simple d'utiliser 2 chaînes constantes pour les minuscules à remplacer et les majuscules correspondantes et faire un Pos() :

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
const
  sMinus = 'àéè';
  sMajus = 'ÀÉÈ';
 
function Majuscule(s: string): string;
var
  i: integer;
begin
  result := s;
  if result > EmptyStr then
  begin
    i := Pos(result[1], sMinus);
    if i > 0 then
      result[1] := sMajus[i];
  end;
end;

[ThWilliam]

Bonjour à tous.

J'ai trouvé cette fonction sur un forum lazarus-freepascal (conversion en widestring):

Code :

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

1
2
3
4
5
6
7
8
function UTF8UpperFirstLetter(Value: string): string;
var
  temp: WideString;
begin
  temp:= UTF8Decode(Value);
  if length(temp) > 0 then temp[1]:= WideUpperCase(temp[1])[1];
  Result:= UTF8Encode(temp);
end;

lien: http://forum.lazarus.freepascal.org/...p?topic=6219.0

Ok sous windows. Pas testé sous Linux.

Cordialement
Thierry

[Roland Chastain]

Merci pour vos réponses fort instructives.

Je confirme que chez moi (Lazarus 1.4.2, Windows) les solutions Jipété-alanglet et ThWilliam fonctionnent parfaitement. En revanche, la solution proposée par tourlourou ne paraît pas fonctionner (même si l'idée des deux chaînes est intéressante). C'est peut-être lié à la version du compilateur ?

si "UTF8 dans la RTL" est défini pour le projet

Comment fait-on pour activer cette option ?

[alanglet]

Bonsoir,

Comment fait-on pour activer cette option ?

Lazarus 1.5 et fpc 3.1.1 mis à jour depuis trunk SVN. Options du compilateur pour le projet.
(Retraité, sans rien à vendre, on peut prendre des risques).

André

[Roland Chastain]

Lazarus 1.5 et fpc 3.1.1 mis à jour depuis trunk SVN. Options du compilateur pour le projet.

Ah, d'accord. Donc si je comprends bien il sera possible, avec Free Pascal 3, de continuer à utiliser l'ancienne version de la RTL.

Quoique je n'aie rien à vendre non plus, je n'ai pas encore essayé le nouveau compilateur : je laisse les autres essuyer les plâtres.

[Jipété]

En revanche, la solution proposée par tourlourou ne paraît pas fonctionner (même si l'idée des deux chaînes est intéressante). C'est peut-être lié à la version du compilateur ?

Nan, c'est lié à la longueur des [EDIT]chaînes caractères[/EDIT], codés sur deux octets pour tout ce qui n'est pas ASCII pur et dur (et parfois sur trois octets -- mais je ne me souviens plus dans quels cas)...

La souris sur les mots qui vont bien en mode pas-à-pas :

[Roland Chastain]

Merci, Jipété, pour cette explication. Honnêtement (je ne sais pas si c'est l'heure tardive) je ne vois pas très bien à quoi correspondent ces nombres entre accolades. Mais bon le coup des deux octets j'ai compris.

Pour le plaisir de prolonger la discussion (quoique mon problème soit résolu), voici ce que je voulais faire en réalité. C'est une fonction qui ajoute des majuscules, de façon "intelligente", à des noms de pays donnés tout en minuscules. Le code est sûrement optimisable (et il y a peut-être aussi des cas que j'ai oublié de prendre en compte), mais la fonction fait le travail.

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
function Majuscules(s: string): string;
var
  i: integer;
begin
  for i := 1 to UTF8Length(s) do
    if
    (
      (i = 1) or
      (UTF8Copy(s, i - 1, 1) = ' ') or
      (UTF8Copy(s, i - 1, 1) = '''') or
      (UTF8Copy(s, i - 1, 1) = '-')
    )
    and not
    (
      (UTF8Copy(s, i, 2) = 'd''') or
      (UTF8Copy(s, i, 2) = 'du') or
      (UTF8Copy(s, i, 2) = 'et') or
      (UTF8Copy(s, i, 3) = 'les')
    )
    then
      s := UTF8Copy(s, 1, i - 1) + UTF8UpperCase(UTF8Copy(s, i, 1)) + UTF8Copy(s, i + 1, MAXINT);
  result := s;
end;

[alanglet]

Donc si je comprends bien il sera possible, avec Free Pascal 3, de continuer à utiliser l'ancienne version de la RTL.

La liste des fonctions qui seront prises en compte figure http://wiki.freepascal.org/FPC_Unico...rt#RTL_changes. Mais d'après ce que j'ai compris, seules celles concernant les échanges avec le SE comme l'adressage des fichiers tiennent actuellement compte de la différence de codage des caractères. Copy ne semble pas l'être encore. Il faut donc encore utiliser s:=UTF8UpperCase(UTF8Copy(s,1,1))+UTF8Copy(s,2,MaxInt); de LazUtf8 pour le moment.
Dans la dernière version de LazUtf8 on trouve une directive inline pour
function UTF8ToSys(const s: string): string; overload; {$IFDEF EnableUTF8RTL}inline;{$ENDIF}mais pas pour
function UTF8Copy(const s: string; StartCharIndex, CharCount: PtrInt): string;Pour l'UTF8 un coup d'œil https://fr.wikipedia.org/wiki/UTF-8 nous apprend qu'un caractère peut être codé sur 1 à 4 octets.

Bonne nuit.
André

[ThWilliam]

Bonjour.

Complément d'info UTF8 : http://www.utf8-chartable.de/

Pour les caractères latins, les lettres accentuées ont toutes le premier octet = $C3
$C3 étant dans la fourchette $C2 à $DF, on n'a qu'1 octet suivant à lire.
Exemple : 'é' = $A9 --> le codage du 'é' = $C3 $A9.

Cordialement
Thierry

[alanglet]

Hors sujet mais bon...
Comme d'habitude (il sont déjà absents de nos claviers AZERTY standards), les œ et Œ a été plus ou moins oubliés puisque relégués en C5 93 et C5 92.
On les trouve pourtant dans au moins 122 noms de communes en France et je ne sais combien de noms communs.
Tout semble fait pour qu'on les oublie

André

[Roland Chastain]

Hors sujet mais bon...

Non, au contraire : j'espérais bien que cette discussion serait l'occasion de clarifier ces choses qui pour beaucoup d'entre nous restent je crois encore assez mystérieuses.

Je viens de faire un petit programme pour illustrer les explications précédentes :

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
uses
  SysUtils, LazUTF8;
 
procedure WriteBytes(s: string);
var
  p: pchar;
  n: integer;
  b: array[0..2] of byte;
begin
  p := pchar(s);
 
  repeat
    n := UTF8CharacterLength(p);
 
    if n >= 1 then
    begin
      b[0] := Ord(p[0]);
      Write(Format('$%x', [b[0]]));
    end;
    if n >= 2 then
    begin
      b[1] := Ord(p[1]);
      Write(Format(', $%x', [b[1]]));
    end;
    if n >= 3 then
    begin
      b[2] := Ord(p[2]);
      Write(Format(', $%x', [b[2]]));
    end;
    WriteLn;
 
    Inc(p, n);
  until (n = 0) or (p^ = #0);
end;
 
begin
  WriteBytes('œil');
end.

$C5, $93
$69
$6C

[Jipété]

Non, au contraire : j'espérais bien que cette discussion serait l'occasion de clarifier ces choses qui pour beaucoup d'entre nous restent je crois encore assez mystérieuses.

Tu l'as dit ! Et encore on n'a pas parlé de la saisie en Unicode...

Parce que pour avoir œ il me faut appuyer sur CTRL SHIFT u (qui va s'afficher u) puis pianoter 0153ESPACE (ou 0152ESPACE pour l'avoir en majuscule)...

[tourlourou]

Bonsoir, pas testé extensivement :

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
function Majuscule(s: string): string;
var
  i: integer;
begin
  Result := s;
  if Length(Result) > 1 then
  begin
 
    i := Ord(Result[2]);
 
    case Ord(Result[1]) of
     197 : if i = 147 then Dec(i,  1); // oe avec ligature
     195 : if i in [160..187] then Dec(i, 32); // minuscules accentuées
    end;
 
    Result[2] := Chr(i);
 
  end;
end;

[alanglet]

Bonjour,

Tu l'as dit ! Et encore on n'a pas parlé de la saisie en Unicode...

Parce que pour avoir œ il me faut appuyer sur CTRL SHIFT u (qui va s'afficher u) puis pianoter 0153ESPACE (ou 0152ESPACE pour l'avoir en majuscule)...

Est-ce comme ça sous Linux?
Pour Windows (je l'utilise de XP 32b à 7 64b), après avoir consulté tout ce que j'ai pu trouvé sur internet, j'ai fait avec MSKLC disponible gratuitement chez Microsoft un pilote de clavier français que j'ai voulu facilement mémorisable pour donner un accès direct aux caractères qui en sont absents. J'ai aussi voulu donner un accès direct à la place de l'accès par 2 touches aux lettres avec l'accent circonflexe qui est inutilisable lors de la sélection dans un combo par exemple.
Si ça intéresse quelqu'un, il est téléchargeable ici.

André

[Roland Chastain]

Bonsoir, pas testé extensivement :

Excellent !

Maintenant j'ai bien compris.

[Jipété]

Bonjour,

Est-ce comme ça sous Linux?

En ce qui me concerne, je réponds "oui" ; il y a peut-être d'autres solutions, mais je ne les connais pas (ou je les ai mal cherchées).

[Roland Chastain]

La fonction de tourlourou, étendue à toutes les lettres (toutes les lettres utilisées en français) :

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
function Majuscule(s: string): string;
var
  i: integer;
begin
  result := s;
 
  if Length(s) > 0 then
  begin
    i := Ord(result[1]);
 
    if i in [$61..$7A] then // minuscules non accentuées
    begin
      Dec(i, $20);
      result[1] := Chr(i);
    end else
      if Length(result) > 1 then
      begin
        i := Ord(result[2]);
 
        case Ord(result[1]) of
          $C5: if i = $93 then i := $92; // oe avec ligature
          $C3: if i in [$A0..$BB] then Dec(i, $20); // minuscules accentuées
        end;
 
        result[2] := Chr(i);
      end;
  end;
end;