Discussion :

[bremer]

Bonjour,

Comment faire une routine qui remplace une chaine 1,2,3,4 par 1-4

Mercide votre aide

Laurent

[Eric.H]

Comment faire une routine qui remplace une chaine 1,2,3,4 par 1-4

Essaye StringReplace

[ShaiLeTroll]

Si la suite c'est 1,2,3,4 cela devient 1-4
le cas suivant sont-ils bons :
1,2,3,4,5,6,7 devient 1-7
4,5,6,7 devient 4-7

Voici un code (non testé) directement tapé sur le forum !

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
function ComputeBoundsOfDigitSeries(const Series: string): string;
var
  LowB, PriorC, C: Char;
  I, L: Integer;
begin
  Result := '';
  LowB := #0;
  PriorC := #0; 
  C := #0; 
  L := Length(Series);
  if (L < 3) or not Odd(L) then
   Exit;
 
  for I := 1 to L do
  begin
    C:= Series[I];
    if Odd(I) then // Impair c'est la position d'un Chiffre, Pair celui d'une virgule
    begin
      if ('0' <= C) and (C <= '9') then
      begin
        if LowB = #0 then
          LowB := C;
        else
          if PriorC >= C then 
            Exit;           
 
        PriorC := C;
      end
      else
        Exit;
    end
    else
      if (C <> ',') then
        Exit;    
  end; 
 
  Result := LowB + '-' + C; 
end;

L'algo précédent est très basique, ultra rigide et ne supportera pas une suite comme 512,513,514

Pour cela utilise ExplodeLazy ou ExtractStrings sur la virgue, tu obtiens un tableau ou une liste qu'il sera facile à parcourir !

Reviens avec un début de code que l'on pourra t'aider à corriger si tu as un problème

[ALWEBER]

Code testé

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
 
procedure TForm1.Button1Click(Sender: TObject);
var
  stSource,stResult1, st1 : string ;
  iPrec,iEncours : integer ;
  cPrec,cEncours : string ;
 
begin
  stSource := '1,2,3,5,6,7,9,10,11,12,13' ;
  ListBox1.Items.add (stSource) ;
  stResult1 := '' ;
  iPrec := -1 ;
  while pos (',',stSource)>0 do
  begin
    iEncours := strToInt(copy(stSource,1,pos (',',stSource)-1)) ;
    delete (stSource,1,pos (',',stSource)) ;
    if stResult1 ='' then
      stResult1 := intToStr(iEncours)
    else
    begin
      cPrec := cEncours ;
      if iEncours = iPrec+1 then
      begin
        cEncours := '-' ;
        st1 := '-'+intToStr(iEncours) ;
      end
      else
        cEncours := ',' ;
      if (cEncours=',') then
        stResult1 := stResult1+st1+cEncours+intToStr(iEncours) ;
    end ;
    iPrec := iEncours ;
  end ;
  iEncours := strToInt(stSource) ;
  cPrec := cEncours ;
  if iEncours = iPrec+1 then
  begin
    cEncours := '-' ;
    st1 := '-'+intToStr(iEncours) ;
  end
  else
    cEncours := ',' ;
  if (cEncours=',') then
    stResult1 := stResult1+st1+cEncours+intToStr(iEncours)
  else
    stResult1 := stResult1+st1 ;
  ListBox1.Items.add (stResult1) ;
end;

[bremer]

Merci je test cela

[Paul TOTH]

ça ne fonctionnera que si les nombres sans triés, si ce n'est pas le cas il vaut mieux extraire tous les nombres, les trier puis rechercher les suites.

une façon simple mais pas forcément optimisée avec une chaîne qui ne doit contenir que des nombres entiers et des virgules

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
 
function CompareNumbers(List: TStringList; Index1, Index2: Integer): Integer;
var
  n1, n2: Integer;
begin
  n1 := StrToInt(List[Index1]);
  n2 := StrToInt(List[Index2]);
  Result := n1 - n2;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  L: TStringList;
  S: string;
  p: Integer;
  i: Integer;
  n: Integer;
  c: Char;
begin
  L := TStringList.Create;
  try
    L.Delimiter := ',';
    L.DelimitedText := Edit1.Text;
    L.CustomSort(CompareNumbers);
 
    S := L[0];
    p := StrToInt(S);
    c := ',';
    for i := 1 to L.Count - 1 do
    begin
      n := StrToInt(L[i]);
      if (n = p + 1) then
      begin
        c := '-';
      end else begin
        if c = '-' then
          S := S + c + IntToStr(p);
        S := S + ',' + IntToStr(n);
        c := ',';
      end;
      p := n;
    end;
    if c = '-' then
      S := S + c + IntToStr(p);
 
    ShowMessage(S);
  finally
    L.Free;
  end;
end;

EDIT: "c" pourrait tout aussi bien être un Boolean puisque sa valeur n'est pas utilisée autrement que dans un test

[bremer]

Merci cela fonctionne

Merci Paul