Traitement de chaîne de caractères

Commenter

Contenu du snippet

Je suis en train de developper un logiciel pour ma société, j'ai besoin d'outils, et etant confronté a pas mal de problème, je suis arrivé a passer plus de temps a concevoir des petites fonctions plutot interressante. En voici une qui, j'espère vous servira peut être.

Sa fonction, vous rentrez une chaine, plusieurs infos sont contenue dedans, séparée par un caractère défini par vous meme, ensuite, un exemple et plus concret je crois, car l'expliquer et trop dur ....

Exemple :

Votre chaine = 'RADEON 7200/9600/9600 Pro/Un Deux Trois 25/36'

le résultat = RADEON 7200
RADEON 9600
RADEON 9600 Pro
Un Deux Trois 25
Un Deux Trois 36

Voila ...

Source / Exemple : 


function FormatStr(Str : string; Sep : Char; MaxLen : integer): string;
var
   J     : integer;
   IxC   : char;
   CRLF  : AnsiString;
   R,T,F : string;

function FindPos(Sep : Char; Txt : string; Max : integer) : integer;
var
   P,I,B : integer;
   Tmp   : string;

begin
     Tmp:= '';
     Tmp:= Txt;
     I:= Pos(Sep,Tmp);
     if (Length(Tmp) > MaxLen) then
     begin
         Result:= 0;
         exit;
     end;
     if (I = 0) or (I > Max) then
     begin
          Result:= 0;
          exit;
     end;
     P:= 0;
     B:= 0;
     repeat
           I:= Pos(Sep,Tmp);
           if (I > 0) and (I < Max) then
           begin
                P:= P + I;
                delete(Tmp,1,I);
           end;
           Inc(B);
     until (I = 0) or (I > Max) or (B > Length(Txt));
     Result:= P;
end;

procedure ScanStr(Txt : string);
const
     Base : array[1..30] of char = (#32,#33,#34,#35,#36,#37,#38,#40,#41,#42,
                                    #44,#45,#46,#47,#58,#59,#60,#61,#62,#64,
                                    #91,#92,#93,#94,#95,#96,#123,#124,#125,
                                    #126);
var
   X,Y : byte;

begin
     Ixc:= #0;
     Y:= 0;
     repeat
           for X:= 1 to 30 do
           begin
                if Base[X] <> Sep then
                begin
                     Y:= Pos(Base[X],Txt);
                     if Y > 0 then
                     begin
                          IxC:= Txt[Y];
                          exit;
                     end;
                end;
           end;
     until Y = 0;
end;

procedure ScanIx(Tp,Max : byte);
var
   ISS : byte;
   TSI : string;

begin
     TSI:= Copy(T,1,Max);
     ScanStr(TSI);
     ISS:= FindPos(IxC,TSI,Max);
     if (ISS > 0) and (ISS < Max) then
     begin
          F:= Copy(TSI,1,ISS);
          if Tp = 2 then
          begin
               Delete(T,1,ISS);
               Dec(J,ISS);
          end;
     end;
     case Tp of
          1 : R:= Copy(T,1,J - 1) + CRLF;
          2 : R:= R + F + Copy(T,1,J - 1) + CRLF;
     end;
     Delete(T,1,J);
end;

begin
     CRLF:= #13#10;
     R:= '';
     F:= '';
     T:= Str;
     J:= Pos(Sep,T);
     if Length(T) > MaxLen then exit;
     if J = 0 then
     begin
          Result:= T;
          exit;
     end;
     T:= T + Sep;
     ScanIx(1,J);
     repeat
           J:= Pos(Sep,T);
           if J > 0 then ScanIx(2,J);
     until J = 0;
     R:= R + T;
     Result:= R;
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.