Discussion :

[andreditdd]

Bonjour,
Je cherche (mais ne trouve pas) à mettre en majuscule chaque premiere lettre des mots se trouvant dans un texte.
ex: je cherche sans trouver. deviendrait
Je Cherche Sans Trouver.

André

[philnext]

Je crois que tu vas être obligé de le faire 'à la main'. Style, pour chaque string :

Code :

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

1
2
 
sTemp := upCase(sTemp[1])+copy(stemp,2,length(sTemp)-1);

[Fabrice ROUXEL 1]

Utilises la fonction pos(' ',ligne) pour detecter les espaces contenu dans le texte.

En gros à chaque espace rencontré, tu coupes ta chaine. tu ajoutes une Majuscule à chaque fragment.

Tu codes une fonction style:

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
type TStringsArray = array of string;
function Explode(txt: string; delimit: char): TStringsArray;
var
  i: integer;
  deb: integer;
  idx: integer;
begin
  i := 1;
  deb := 1;
  idx := 0;
  txt := Trim(txt);
  SetLength(Result,0);
  while (i <= length(txt)) do
  begin
    if (txt[i] = delimit) then
    begin
      SetLength(Result, idx +1);
      Result[idx] := copy(txt, deb, i - deb);
      deb := i+1;
      inc(idx);
    end;
    inc(i);
  end;
  if i <> deb then
  begin
    SetLength(Result, idx +1);
    Result[idx] := copy(txt, deb, length(txt));
  end;
end;

[andreditdd]

Merci pour vos réponses...
J'avais déja testé la fonction pos(' ',ligne) mais sans résultat convainquant.

Pouvez vous me développer un peu vos idées car je n'ai pas le niveau me permetant de rebondir sur vos début.

Merci,
André

[philnext]

Bon si on considère que tout ton texte est dans une string sText :

Code :

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

1
2
3
4
5
6
7
 
sText[1]:=Uppercase(sText[1]);
for iBcl := 2 to length(sText) do
begin
  if sText[iBcl-1]=' ' then 
     if sText[iBcl] in ['a'..'z'] then sText[iBcl]:=UpperCase[iBcl];
end;

...bon ni testé ni optimisé...

[Rayek]

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 ConvertFirstChar(sText : String) : String;
var
  i : integer;
  sTmp : String;
begin
  Result := '';
  With TStringList.Create do
  try
    Text :=  sText;
    Text := StringReplace(Text,' ',#13#10,[rfReplaceAll]);
 
    for i := 0 to count -1 do
    begin
      sTmp := Strings[i];
      if Trim(sTmp) <> '' then
      begin
         sTmp[1] := UpCase(sTmp[1]);
        Strings[i] := sTmp;
      end;
    end;
 
    Text := StringReplace(Text,#13#10,' ',[rfReplaceAll]);
    Result := Trim(Text);
  finally
    free;
  end;
end;

[philnext]

=> Malatar :Beau code, par contre si il y a des #13#10 dans son texte ça va les détruire.

[andreditdd]

Super !!!
ça fonctionne impec.
Il me reste à étudier le code pour bien le comprendre.

Un grand merci à tous
André

[philnext]

T'as utilisé quel code du coup ??

[andreditdd]

J'étais occupé à tester ton code, mais il me renvoyait un msg d'erreur car je mélangeais des char et des string quand j'ai vu le code de Malatar.
J'ai testé le code de Malatar et ça a fonctionné du premier coup sans meme le retoucher.
Le texte à traiter se trouve dans un Edit et donc sur une ligne.

Encore merci à vous tous,
André

[Rayek]

=> Malatar :Beau code, par contre si il y a des #13#10 dans son texte ça va les détruire.

Oui, j'ai considéré qu'il n'y avait qu'une phrase simple et pas un texte formatté.
Après il est possible de modifier en conséquence


En utilisant une deuxieme TStringList, on a plus de soucis avec le formattage

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
 
function ConvertFirstChar(sText : String) : String;
var
  i,j : integer;
  sTmp : String;
  lstText : TStringList;
begin
  Result := '';
  lstText := TStringList.Create;
  With TStringList.Create do
  try
    lstText.text := sText;
    for j := 0 to lstText.count -1 do
    begin
      Text := lstText.Strings[j];
      Text := StringReplace(Text,' ',#13#10,[rfReplaceAll]);
 
      for i := 0 to count -1 do
      begin
        sTmp := Strings[i];
        if Trim(sTmp) <> '' then
        begin
          sTmp[1] := UpCase(sTmp[1]);
          Strings[i] := sTmp;
        end;
      end;
 
      Text := StringReplace(Text,#13#10,' ',[rfReplaceAll]);
      lstText.Strings[j] := Trim(Text);
    end;
    Result := lstTExt.Text;
  finally
    free;
    lstText.free;
  end;
end;

[philnext]

Damned !!

Code :

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

1
2
3
4
5
6
7
8
 
  sTemp[1]:=Upcase(sTemp[1]);
  for iBcl := 2 to length(sTemp) do
  begin
    if sTemp[iBcl-1]=' ' then
       if sTemp[iBcl] in ['a'..'z'] then
         sTemp[iBcl]:=UpCase(sTemp[iBcl]);
  end;

[ShaiLeTroll]

J'ai fait presque cette fonction pour remplacer la même fonction horriblement lente qui existait dans la lib de mon employeur (30-35 plus lente), pourtant basé sur la lib hyperStr, comme c'était pour traiter du fichier en gros volume, la perf était requise ...

la fonction Met en Majuscule chaque 1ère Lettre, mets les autres en minuscules et supprime les doubles Espaces, et est 80 à 110 fois plus rapide que ConvertFirstChar ...

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
function ShaiProperName(const Value: string): string;
const
   DEC_MIN_MAJ = Ord('A') - Ord('a');
   SPACE_CHAR = ' ';
 
   function UpCharCase(c: Char): Char;
   {$IFDEF PUREPASCAL}
   begin
      if ('a' <= c) and (c <= 'z') then
         Result := Char(Byte(c) + DEC_MIN_MAJ)
      else
         Result := c; // En Théorie, ne sera jamais compilé car c'est faire MOV AL, AL
   {$ELSE}
   asm
           CMP     AL,'a'
           JB      @@exit
           CMP     AL,'z'
           JA      @@exit
           ADD     AL,'A' - 'a'
   @@exit:
   {$ENDIF}
   end;
 
   function LowCharCase(c: Char): Char;
   {$IFDEF PUREPASCAL}
   begin
      if ('A' <= c) and (c <= 'Z') then
         Result := Char(Byte(c) - DEC_MIN_MAJ)
      else
         Result := c; // En Théorie, ne sera jamais compilé car c'est faire MOV AL, AL
   {$ELSE}
   asm
           CMP     AL,'A'
           JB      @@exit
           CMP     AL,'Z'
           JA      @@exit
           SUB     AL,'A' - 'a'
   @@exit:
   {$ENDIF}
   end;
 
var
   Index, Offset: Integer;
   LastIsSpace, PriorIsSpace: Boolean;
begin
   SetLength(Result, Length(Value));
   ZeroMemory(@Result[1], Length(Result));
 
   LastIsSpace := True;
   Offset := 0;
 
   for Index := 1 to Length(Value) do
   begin
      if Value[Index] = SPACE_CHAR then
      begin
         PriorIsSpace := LastIsSpace;
         LastIsSpace := True;
         if PriorIsSpace then
         begin
            Inc(Offset);
         end
         else
         begin
            Result[Index - Offset] := SPACE_CHAR;
         end;
      end
      else
      begin
         if LastIsSpace then
         begin
            Result[Index - Offset] := UpCharCase(Value[Index]);
         end
         else
         begin
            Result[Index - Offset] := LowCharCase(Value[Index]);
         end;
         LastIsSpace := False;
      end;
   end;
 
   ReduceStr(Result, Length(Result) - Offset);
end;

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
{* -----------------------------------------------------------------------------
la fonction ReduceStr correspond à un SetLength plus performant mais peut-être plus risqué !
@param S est une variable chaîne
@param NewLength indique le nouveau nombre de caractères dans S.
------------------------------------------------------------------------------ }
procedure ReduceStr(var S: string; NewLength: Integer);
{$IFNDEF PUREPASCAL}
type
  PStrRec = ^StrRec;
  StrRec = packed record
    refCnt: Longint;
    length: Longint;
  end;
 
const
  skew = sizeof(StrRec);
  rOff = sizeof(StrRec); { refCnt offset }
  overHead = sizeof(StrRec) + 1;
 
{$IFDEF SHAI_REALLOC_STRING}
var
  P: PStrRec;
{$ENDIF}
{$ENDIF}
begin
  if NewLength < 0 then
    NewLength := 0;
  if NewLength < Length(S) then
  begin
      {$IFDEF PUREPASCAL}
      SetLength(S, NewLength);
      {$ELSE}
      {$IFDEF SHAI_REALLOC_STRING}
      P := Pointer(Integer(S) - SizeOf(StrRec));
      ReallocMem(P, NewLength + skew); // Revient à faire le SetLength en terme de temps
      {$ELSE}
      S[Succ(NewLength)] := #0;
      {$ENDIF}
      {$IFDEF SHAI_SET_LENGTH}
      Integer(Pointer(Integer(@S[1])-4)^) := NewLength; // FreeMem libère le pointeur, peut importe la taille
      {$ELSE}
      PStrRec(Integer(S) - SizeOf(StrRec)).length := NewLength;
      {$ENDIF}
      {$ENDIF}
   end;
end;