Discussion :

[bremer]

bonjour,

Je récupère des chaînes d'environ 600 caractères avec à l'intérieur des nombres de 1 à 4 ou 5 chiffres séparés par une virgule.

Hors je dois enregistrer dans une base que 150 caractères maximum. La découpe ne doit se faire que par une virgule.

Exemple :

Chaîne complète à coiper :
1,23,45,2587,45,6,55,87,45,9874

Chaîne à enregistrer :

1,23,45
2587,45,6
55,87,45
9874

Merci d'avance pour votre aide car je crains de partire dans une usine à gaz.

Laurent

[Issam]

dans la rxlib que tu trouvera sur ce site il y'a une unité rxstrutils
avec une fonction nommée ExtractWord

qui te permet de faire ça

[bremer]

Merci je suis en cours d'analyse de la fonction mais j'aurais préférer ne pas passer par un composant externe.

[ShaiLeTroll]

Tu peux faire un algo simple
Alors tu as deux paramètres :
- Longueur limite
- Séparateur

Il te suffit de cherche le séparateur le plus proche de la fin (tu fais une boucle en partant de la fin ... ou tu joue avec Copy et LastDelimiter mais ça sera plus lent ...), tu mémorise cette position, et tu ajoute dans une TStringList (par exemple ou un array of string), la chaine entre la position de départ (1 au début, puis Pos Separateur + 1 ensuite), et cela ainsi de suite ...

[bremer]

Ok je vais voir cela.

[Qwazerty]

SAlut
Tu as cette solution

Code :

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

1
2
3
4
5
6
7
8
9
10
procedure TForm2.Button3Click(Sender: TObject);
Var ListStr : TStringList;
    MaChaine : String;
begin
     MaChaine := '51,25,65,98,4444,74,1,15';
     ListStr := TStringList.Create;
     ListStr.Text := StringReplace(MaChaine,',',chr(13)+chr(10), [rfReplaceAll]);
     Listbox1.Items.Assign(ListStr);
     ListStr.Free;
end;

Mais peut etre veux tu des chaines les plus longues possible mais qui ne depassent pas 150 caracteres ?

[Griller] Bon ben je vais manger alors ^^ [/Griller]

A++
Qwaz

[bremer]

Effectivement le but c'est de couper tous les 150 caractères mais toujours avant une virgule

[ero-sennin]

Salut,

J'ai fait une petite fonction qui retourne un StringList contenant moins de n caractères que l'on peut définir dans la fonction. Les mots trop grands sont ignorés!

Voici la fonction :

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
function RetournerListeDecoupe(MaChaine:String;Longueur:integer):TStringList;
var
index:integer;
ListeTemp,ListeDecoupe:TStringList;
NewChaine:string;
begin
  ListeTemp:=TStringList.Create;
  ListeDecoupe:=TStringList.Create;
  ListeTemp.Text := StringReplace(MaChaine,',',#13#10, [rfReplaceAll]);
  NewChaine:='';
 
  for index:=0 to ListeTemp.Count-1 do
  begin
    if (index = ListeTemp.Count-1) then
    begin
      if (length(NewChaine)+length(ListeTemp.Strings[index])<=Longueur) then
      begin
        if NewChaine='' then
          NewChaine:=NewChaine+ListeTemp.Strings[index]
        else
          NewChaine:=NewChaine+','+ListeTemp.Strings[index];
        ListeDecoupe.Add(NewChaine);
      end
      else
      begin
        ListeDecoupe.Add(NewChaine);
          if Length(ListeTemp.Strings[index])<=Longueur then
            ListeDecoupe.Add(ListeTemp.Strings[index]);
      end;
    end
    else
    begin
      if (length(ListeTemp.Strings[index])<= longueur) then
      begin
        if (length(NewChaine)+length(ListeTemp.Strings[index])<=Longueur) then
        begin
          if NewChaine='' then
            NewChaine:=NewChaine+ListeTemp.Strings[index]
          else
            NewChaine:=NewChaine+','+ListeTemp.Strings[index];
        end
        else
        begin
          ListeDecoupe.Add(NewChaine);
          if (Length(ListeTemp.Strings[index])<=longueur) then
            NewChaine:=ListeTemp.Strings[index]
          else
            NewChaine:='';
        end;
      end;
    end;
  end;
  Result:=ListeDecoupe;
  ListeTemp.Free;
end;

Un exemple d'appel :

Code :

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

1
2
3
4
procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Lines:=RetournerListeDecoupe(MonTexte.Text,10);
end;

Si mon texte contient ceci :
abcdefgh,aaaaaaaaaaa,z,eee
On aura en retour celà :
abcdefgh,z
eee

Une remarque également, la virgule ne compte pas dans le calcul de longueur

J'espère que ça te conviendra!
A+

[mengwei]

bien que le code précédent aie le mérite de fonctionner, une trop grande complexité (imbrications successives) plus quelques erreurs de fuites de mémoire en font malheureusement un bout de code à ne pas mettre entre les mains de débutants.
Je me permets donc de mettre un petit bout de code un peu plus clair et commenté...

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
 
procedure ReturnList( aString : String; aLongueurMax : Integer; var aList : TStringList);
var i : Integer;
begin
  while not( Length( aString) < aLongueurMax) do
  begin
    i := aLongueurMax;
    // On cherche la première occurence de ',' à rebours en partant du max
    while ( i > 0) and( not( aString[ i] = ',')) do i := i - 1;
    if i = 0 then break;
    // On ajoute ce qu'on a trouvé
    aList.Add( Copy( aString, 1, i - 1));
    // et on réduit la chaîne d'autant
    aString := Copy( aString, i + 1, Length( aString));
  end;
  if Length( aString) > aLongueurMax then raise Exception.Create( 'Impossible de découper la chaîne');
  if Length( aString) > 0 then aList.add( aString);
end;

avec un exemple d'utilisation

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
procedure TFrEtudeFraisSante.btOptClick(Sender: TObject);
var L : TStringList;
begin
  L := TStringList.Create;
  try
    ReturnList( Memo1.text, 150, L);
    Memo2.Lines.Assign( L);
  finally
    L.Free;
  end;
end;

commentaires, critiques, questions ou marqueur résolu bienvenus...

[ShaiLeTroll]

Code :

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

1
2
3
4
procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Lines:=RetournerListeDecoupe(MonTexte.Text,10);
end;

Attention !
Cette ligne de code laisse une belle fuite mémoire, elle est similaire à

Code :

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

1
2
3
4
procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Lines.Assign(RetournerListeDecoupe(MonTexte.Text,10));
end;

il manque donc la libération du résultat de RetournerListeDecoupe

Code :

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

1
2
3
4
5
6
7
8
procedure TForm1.Button2Click(Sender: TObject);
var
  ReturnStrings: TStrings;
begin
  ReturnStrings := RetournerListeDecoupe(MonTexte.Text,10);
  Memo1.Lines := ReturnStrings;
  ReturnStrings.Free();
end;

Grillé par mengwei ...
Sinon

Code :

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

procedure ReturnList( aString : String; Separator: Char; aLongueurMax : Integer; var aList : TStringList);

le var est inutile, on ne souhaite pas modifier la référence de aList, mais son contenu, attention un objet est un pointeur et passé comme tel dans une fonction ...

[mengwei]

Grillé par Shai... c'est tout à fait vrai, voilà ce qui arrive quand on fait du code dans la précipitation

Pour compléter Shai et répondre à ceux qui s'interrogeraient sur ce que devient le .lines du Memo quand on fait Memo.Lines := xxx , je préciserai juste que le 'set' du TStringList fait un appel à assign, et donc copie le contenu de la liste (=> Pas de fuite mémoire).

[bremer]

Merci à tous ,

Avec vos dernières lignes de code + ce que j'ai fais de mon côté, ma procédure est finie.

Laurent

[ero-sennin]

Je me doutais bien que je faisais très très compliqué! J'étais têtu! Je voulais à tout pris passer par un TStringList secondaire ... Enfin, bref, je me suis bien emmêlé les pinceaux!

Pour ce qui est de la fuite mémoire, c'est vrai, je n'y pense jamais à cette chose! Pourtant, va bien falloir que ça rentre un jour

Sinon, merci à toi mengwei pour ton code! C'est vrai qu'il est plus joli à regarder et surement plus performant.

@+
Cordialement

[ShaiLeTroll]

Question performance,
via TStringList, le parsing est très rapide (d'ailleurs on peut utiliser DelimitedText au lieu d'un StringReplace ... c'est plus rapide), mais les concaténations sont plus lente
via la boucle sur un raccourcissement de chaine, il est évident que le parsing ne peu être qu'affreusement lent, puisque l'on copie la chaine d'origine en la raccourcissant ...

en fin, passé la chaine en const, fait encore gagné de la performance, car on ne passe que le pointeur sur la chaine (comme en var) sans en faire une copie ...

Voici ma contribution, ...

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
function SplitString(const S: string; out A: Types.TStringDynArray; Separator: Char; Limit: Cardinal): Boolean;
var
  I, J: Integer;
  IndexS: Integer;
  LenS, LenA: Integer;
  Splitted: Boolean;
begin
  Result := False;
  if Limit = 0 then
  begin
    SetLength(A, 0);
    Exit;
  end;
 
  LenS := Length(S);
  LenA := Ceil(LenS / Limit);
  SetLength(A, LenA); // Autant alloué tout de suite, on sait que l'on aura au minimum S / Limit chaine en résultat !
 
  IndexS := 1;
  I := -1;
  while IndexS < LenS do
  begin
    Splitted := False;
    for J := IndexS + Limit downto IndexS do
    begin
      if (S[J] = Separator) or (LenS < J) then
      begin
        Inc(I);
        if I > High(A) then
          SetLength(A, Length(A) + 1);
        A[I] := Copy(S, IndexS, J - IndexS);
 
        IndexS := J + 1;
        Splitted := True;
        Break;
      end;
    end;
 
    if not Splitted then
    begin
      SetLength(A, 0);
      Exit;
    end;
  end;
 
  Result := True;
end;

Et sur la chaine
0;;1;2!2;333;44!44;55555;666!666;7777777;8888!8888;999999999;00000!00000;"AAA";"BBB";"CCC"

avec ; comme séparateur, et 12 en limite, les temps sont les suivants (P4, Ghz, 10000 fois) :

SplitString : 72 ms
RetournerListeDecoupe : 868 ms
ReturnList : 988 ms

finalement, la TStringList fonctionne pas mal !

[mengwei]

Je pense qu'on approche de la perfection... par contre, a vue de nez et sans tester, il me semble qu'il pourrait y avoir un petit soucis avec cette ligne

Code :

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

 for J := IndexS + Limit downto IndexS do

que je remplacerais bien par quelque chose du goût de

Code :

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

for J := Max( IndexS + Limit, LenS) downto IndexS do

juste au cas où le

Code :

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

S[J] = Separator

réserverait de mauvaises surprises...
Je ne suis pas super formel par contre, je n'ai pas vraiment regardé dans le détail...

[ShaiLeTroll]

En fait, c'est surtout

Code :

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

if (S[J] = Separator) or (LenS < J) then

qu'il faut écrire

Code :

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

if (LenS < J) or (S[J] = Separator)  then

Avec l'optimisation des booléens, S[J] ne sera pas executé si J > LenS

Sur mon Delphi, n'ayant pas activé, les vérifications de borne, cela lit la mémoire, tant que cela le peut ... et pour une bonne cohérence de l'algo, mengwei, tu as tout à fait raison d'être précis !

le Test (LenS < J) sert à la fois de protection contre les erreurs mais aussi permet de récupérer la dernière partie de la chaine après le dernier délimiteur ...

[ero-sennin]

Question performance,
via TStringList, le parsing est très rapide (d'ailleurs on peut utiliser DelimitedText au lieu d'un StringReplace ... c'est plus rapide), mais les concaténations sont plus lente
via la boucle sur un raccourcissement de chaine, il est évident que le parsing ne peu être qu'affreusement lent, puisque l'on copie la chaine d'origine en la raccourcissant ...

en fin, passé la chaine en const, fait encore gagné de la performance, car on ne passe que le pointeur sur la chaine (comme en var) sans en faire une copie ...

Voici ma contribution, ...

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
function SplitString(const S: string; out A: Types.TStringDynArray; Separator: Char; Limit: Cardinal): Boolean;
var
  I, J: Integer;
  IndexS: Integer;
  LenS, LenA: Integer;
  Splitted: Boolean;
begin
  Result := False;
  if Limit = 0 then
  begin
    SetLength(A, 0);
    Exit;
  end;
 
  LenS := Length(S);
  LenA := Ceil(LenS / Limit);
  SetLength(A, LenA); // Autant alloué tout de suite, on sait que l'on aura au minimum S / Limit chaine en résultat !
 
  IndexS := 1;
  I := -1;
  while IndexS < LenS do
  begin
    Splitted := False;
    for J := IndexS + Limit downto IndexS do
    begin
      if (S[J] = Separator) or (LenS < J) then
      begin
        Inc(I);
        if I > High(A) then
          SetLength(A, Length(A) + 1);
        A[I] := Copy(S, IndexS, J - IndexS);
 
        IndexS := J + 1;
        Splitted := True;
        Break;
      end;
    end;
 
    if not Splitted then
    begin
      SetLength(A, 0);
      Exit;
    end;
  end;
 
  Result := True;
end;

Et sur la chaine
0;;1;2!2;333;44!44;55555;666!666;7777777;8888!8888;999999999;00000!00000;"AAA";"BBB";"CCC"

avec ; comme séparateur, et 12 en limite, les temps sont les suivants (P4, Ghz, 10000 fois) :

SplitString : 72 ms
RetournerListeDecoupe : 868 ms
ReturnList : 988 ms

finalement, la TStringList fonctionne pas mal !

Oué! Ba ya pas photo, SplitString est bien plus performant!
Héhé, je ne suis pas le dernier coté performance

[ShaiLeTroll]

Désolé Ero-Senin, j'ai une mauvaise nouvelle, je avais compris dans le temps de ReturnList, l'ajout dans une TListBox (pour afficher les valeurs)

SplitString : 72 ms
RetournerListeDecoupe : 871 ms
ReturnList : 175 ms

Personnellement, je préfère ce résultat, car j'avais pensé ReturnList plus rapide, le nombre de concaténation / copy étant tout de même plus faible que dans RetournerListeDecoupe, ...

[ero-sennin]

Bon! Ba tant pis! Il est vrai que ça m'avait surpris sur le coup, mais bon, je m'y connais vraiment pas beaucoup coté optimisation! C'est un domaine que je trouve intéressant pourtant!

De toute façon, vu le nombre de tests que je faisais, j'étais sur qu'avec une façon ou une autre, on réduirait le temps et que le code serait plus propre que ce que j'ai pu mettre!

En tout cas, j'ai pu voir vos méthodes et j'avoue que si je n'avais pas buté sur le TStringList comme le l'ai fait, je serai surement passé par copy...

Ceci étant dit, bravo Messieurs