Librairie de fonctions de gestion de sous-chaines.

Commenter

Contenu du snippet

Quelques fois, on aimerai avoir une sorte de "structure" de plusieurs éléments variable en taille et en nature.
Difficile donc à part si on passe par une Array of Variant. Ça devient vite saoulant lorsqu' il faut la garder dans un fichier Ini par exemple, il faut une fonction load et une autre Save ... mouai ...

Les problèmes continuent à survenir lorsque l' on veut:
- ajouter un élément
- Supprimer un élement
- Modifier un élément
- Rechercher un élement
etc etc etc ...

Les fonctions de sous-chaines nous permettent très facilement de faire tout ça juste en utilisant une String! Vous avez dit formidable?

Historique :

Source de Kenavo :
http://www.delphifr.com/codes/SOUS-CHAINES_23762.aspx

Qui a donné naissance à ma source :
http://www.delphifr.com/codes/FONCTIONS-GESTION-SOUS-CHAINES_24099.aspx
(J'ai modifié le lien qui pointait sur une page d'ajout de code et non sur le code "Cirec")

J' ai décidé de ne pas modifier ma source précédente car le principe de gestion des sous-chaines n' est pas à 100% le même (comme par exemple le fait que cette nouvelle version admet qu' il existe toujours au moins une sous-chaine, que j' appelle "élément" maintenant).

Voilà :)

Source / Exemple : 


{ SUBSTRING DEFINITION FOR DEVELOPPERS:
  Admettons une chaine de caractères de plusieurs éléments (subStrings) séparés par n' importe quel caractère comme par exemple ';

  !!! TRÈS IMPORTANT !!!
  On ne peut distinguer une chaine à 1 élément vide d' une chaine sans élément.
  Donc, si Chaine = '', on admet toujours qu' il existe 1 élément dans la chaine.
  Pour initialiser une chaine avec son 1er élément, on fait Chaine := 'mon 1er élément';

  Le 1er élément est sur l' Index 1.
  Pour récupérer le 3ème élément on fait:
  MonElement := SUBSTRING_GET('aaa;bb;ccccc;ddd;e;;g', ';', 3);
  !!! FIM TRÈS IMPORTANT !!!

  Exemple: Str = ''                 1 élément vide
  Exemple: Str = 'xxx'              1 élément rempli ...
  Exemple: Str = ';'                2 éléments (vides) ...
  Exemple: Str = 'xxx;'             2 éléments (dont 1 vide) ...
  Exemple: Str = ';xxx'             2 éléments (dont 1 vide) ...
  Exemple: Str = 'xxx;yyy'          2 éléments ...
}

     function SUBSTRING_START(Str: String; Separateur: Char; SubStringIndex: Word): Integer;
     function SUBSTRING_GET(Str: String; Separateur: Char; SubStringIndex: Word): ShortString;
     procedure SUBSTRING_EDIT(Var Str: String; Separateur: Char; SubStringIndex: Word; Novovaleur: String);
     function SUBSTRING_COUNT(Str: String; Separateur: Char): Integer;
     procedure SUBSTRING_ADD(var Str: String; Separateur: Char; valeur: String);
     function SUBSTRING_LENGTH(Str: String; Separateur: Char; SubStringIndex: Word): Integer;
     procedure SUBSTRING_INSERT(var Str: String; Separateur: Char; SubStringIndex: Word; valeur: String);
     function SUBSTRING_DELETE(var Str: string; Separateur: Char; SubStringIndex: Word): Boolean;
     function SUBSTRING_LOCATE(Str: string; Separateur: Char; SubString: String; Options: TLocateOptions): Integer;
     function SUBSTRING_RIBBON(Str: string; Separateur: Char; Current: Word; MoveBy: Integer): Integer; overload;
     function SUBSTRING_RIBBON(Str: string; Separateur: Char; Current: String; MoveBy: Integer): String; overload;

// Nombre d' éléments :
function SUBSTRING_COUNT(Str: String; Separateur: Char): Integer;
var i, nbCars: Integer;
begin
  RESULT := 1;
  nbCars := length(Str);

  for i := 1 to nbCars do
    if Str[i] = Separateur
    then RESULT := RESULT + 1;
end;

// Position dans Str du 1er caractère d' un élément : 
function SUBSTRING_START(Str: String; Separateur: Char; SubStringIndex: Word): Integer;
var nbCars, curSubStringIndex, i: Integer;
begin
  RESULT := 0;
  if SubStringIndex = 0 then raise ERangeError.Create('SubStringIndex = 0!');
  
  nbCars := length(Str);
  curSubStringIndex := 1;
  i := 0;

  while (curSubStringIndex <> SubStringIndex) and (i < nbCars) do
  begin
    i := i + 1;

    if Str[i] = Separateur
    then curSubStringIndex := curSubStringIndex + 1;   // On va passer à l' élément suivant : 
  end;

  if curSubStringIndex = SubStringIndex
  then RESULT := i + 1;    // 'Sauter' le separateur ou i = 0...
end;

// Ajouter un élément à la fin (Très con, je sais): 
procedure SUBSTRING_ADD(var Str: String; Separateur: Char; valeur: String);
begin                  
  // On considère donc que Str possède déjà un élément même si Str = '',
  // Pour insérer le 1er élément faites dans votre programme Str := 'c est mon 1er élément';
  Str := Str + Separateur + valeur;
end;

// Récupérer un élément : 
function SUBSTRING_GET(Str: String; Separateur: Char; SubStringIndex: Word): ShortString;
var nbCars, i: Integer;
begin
  RESULT := '';
  i := SUBSTRING_START(Str, Separateur, SubStringIndex);
  nbCars := length(Str);

  while i <= nbCars do
  begin
    if Str[i] <> Separateur
    then RESULT := RESULT + Str[i]
    else i := nbCars;

    i := i + 1;
  end;
end;

// Nombre de caractères d' un élément :
function SUBSTRING_LENGTH(Str: String; Separateur: Char; SubStringIndex: Word): Integer;
var i, nbCars: Integer;
begin
  RESULT := Length(SUBSTRING_GET(Str, Separateur, SubStringIndex));
end;

// Insérer un élément : 
procedure SUBSTRING_INSERT(var Str: String; Separateur: Char; SubStringIndex: Word; valeur: String);
var i, SubStrCount: Integer;
begin
  SubStrCount := SUBSTRING_COUNT(Str, Separateur);

  if (SubStringIndex > 0) and (SubStringIndex <= SubStrCount)
  then begin
    i := SUBSTRING_START(Str, Separateur, SubStringIndex);
    Insert(valeur + Separateur, Str, i);  
  end
  else
    raise ERangeError.CreateFmt('%d is not within the valid range of %d..%d', [SubStringIndex, 1, SubStrCount]);
end;

// Modifier un élément même dans une position qui n' existe pas : 
procedure SUBSTRING_EDIT(var Str: string; Separateur: Char; SubStringIndex: Word; Novovaleur: string);
var i, SubStrCount, nbCars: Integer;
begin
  i := SUBSTRING_START(Str, Separateur, SubStringIndex);

  if i = 0          // L' élément n' existe pas ...
  then begin
    SubStrCount := SUBSTRING_COUNT(Str, Separateur);

    while SubStrCount < SubStringIndex do
    begin
      Str := Str + Separateur;          // Ajouter um élément vide ...
      SubStrCount := SubStrCount + 1;
    end;

    Str := Str + Novovaleur;
  end
  else begin        // L' élément existe à la position i ...
    nbCars := length(Str);
    // Retirer valeur actuelle :
    while i <= nbCars do
      if Str[i] <> Separateur
      then begin
        Delete(Str, i, 1);
        nbCars := nbCars - 1;
      end
      else
        nbCars := 0;   // fim do elemento ...

    // Insérer la nouvelle valeur de l' élément :
    Insert(Novovaleur, Str, i);
  end;
end;

// Récupérer l' indice d' un élément :
function SUBSTRING_LOCATE(Str: string; Separateur: Char; SubString: String; Options: TLocateOptions): Integer;
var
  SubStrCount, CurSubStrIndex: Integer;
  FindPartialKey, FindCaseInsensitive: Boolean;
begin
  RESULT := 0;
  CurSubStrIndex := 1;
  SubStrCount := SUBSTRING_COUNT(Str, Separateur);
  FindPartialKey := loPartialKey in Options;
  FindCaseInsensitive := loCaseInsensitive in Options;

  if FindCaseInsensitive
  then begin
    Str := STRING_MAIUSCULAS(Str, []);
    SubString := STRING_MAIUSCULAS(SubString, []);
  end;

  while (RESULT = 0) and (CurSubStrIndex <= SubStrCount) do
  begin
    if FindPartialKey
    then begin
      if Pos(SubString, SUBSTRING_GET(Str, Separateur, CurSubStrIndex)) = 1  
      then RESULT := CurSubStrIndex;
    end
    else
      if SubString = SUBSTRING_GET(Str, Separateur, CurSubStrIndex)
      then RESULT := CurSubStrIndex;

    inc(CurSubStrIndex, 1);
  end;
end;

// Permet, à la manière d' un DataSet, sauter de "MoveBy" éléments, avec la particularité de revenir au début lorsqu' on atteind le 

dernier élément (de même si on atteind le début quand MoveBy négatif, on revient au dernier) : 
function SUBSTRING_RIBBON(Str: string; Separateur: Char; Current: Word; MoveBy: Integer): Integer;
var Count: Integer;
begin
  Count := SUBSTRING_COUNT(Str, Separateur);

  RESULT := Current + MoveBy;

  if RESULT > 0
  then begin
    while RESULT > Count do
      RESULT := RESULT - Count;
  end
  else begin
    while RESULT <= 0 do
      RESULT := RESULT + Count;
  end;
end;

// La même mais sans l' indice (par la valeur de l' élément) : 
function SUBSTRING_RIBBON(Str: string; Separateur: Char; Current: String; MoveBy: Integer): String;
var SubStringIndex: Integer;
begin
  SubStringIndex := SUBSTRING_LOCATE(Str, Separateur, Current, []);

  if SubStringIndex = 0
  then SubStringIndex := 1
  else SubStringIndex := SUBSTRING_RIBBON(Str, Separateur, SubStringIndex, MoveBy);

  RESULT := SUBSTRING_GET(Str, Separateur, SubStringIndex);
end;

// Retirer un élément : 
function SUBSTRING_DELETE(var Str: string; Separateur: Char; SubStringIndex: Word): Boolean;
var nbCars: Integer;
begin
  RESULT := false;
  i := SUBSTRING_START(Str, Separateur, SubStringIndex);

  if i <> 0
  then begin
    RESULT := True;
    nbCars := length(Str);
    // Remover valeur actual :
    while i <= nbCars do
    begin
      if Str[i] = Separateur
      then nbCars := 0             // fim do elemento ...
      else nbCars := nbCars - 1;

      Delete(Str, i, 1);
    end;
  end;
end;

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_MAURICIO)