Paramsutils (tparams)

Description

TParamss est une classe qui transforme une chaine en paramètres.
MultiParams permet de gerer plusieurs Objets de type TParams en un seul Objet

Nota: le resultat renvoyé peut être avoir la Casse UpperCase, LowerCase ou Normal, mais on peut aussi choisir l'offset de départ ainsi que la longueur de la chaine a renvoyé, on peut aussi donné un chiffre négative a Len ce qui aura pour conséquence de retourné la chaine moins le len
il vaut mieux voir la démo ;)

Source / Exemple :


unit ParamsUtils;

interface
uses
Windows,Classes,SysUtils;

{
  ParamsUtils By (c)Shining-Freeman for ShiningComponents

  Author: Shining Freeman
  Date: 20/08/03
  Version: 1.0

  Ce Composant est un Composant non Visuel, à sa version Final il fera partie intégrale du Package ShiningComponents

}

    Type
    TModeText=(mtUCase,mtLCase,mtNormal);
    TGetOffset=Function(Offset: Integer=1;   Len: Integer=0; ModeText: TModeText=mtNormal): String of Object;
    TGetFullText=Function(Offset: Integer=1; Len: Integer=0; ModeText: TModeText=mtNormal):String of Object;

    TParamsData=record
    S:String;
    Offset: TGetOffset;
    FullText: TGetFullText;
    User1,User2:String;//reserver à l'utilisateur comme chaine temporaire
    end;

    TParams=Class
    private
      FParams:    Array of TParamsData;
      FSelIndex:  Integer;
      FCount :    Integer;
      FSeparator: String;
      procedure   ProcessModeText(Var S: String; ModeText: TModeText);
      procedure   ProcessOffsetLR(Var S: String; Offset,Len: Integer);
      Function    GetOffSetText_(Offset: Integer=1; Len: Integer=0; ModeText: TModeText=mtNormal): String;
      function    GetFullText_  (Offset: Integer=1; Len: Integer=0; ModeText: TModeText=mtNormal):String;
      function    GetItemsParams(Index: Integer): TParamsData;
      procedure   SetItemsParams(Index: Integer; Const Value: TParamsData);
      function    GetUCase(Index: Integer): String;
      function    GetLCase(Index: Integer): String;
      function    GetSingleS(Index: Integer): String;
      function    GetText(Index: Integer; Offset:Integer=1; Len: Integer=0; ModeText: TModeText=mtNormal): String;
    public
      Constructor Create;
      Destructor  Destroy;override;
      procedure   Clear;
      function    GetOffSetText(Data: String; Offset: Integer=1; Len: Integer=0; ModeText: TModeText=mtNormal): String;
      function    FullText(Index: Integer; Offset: Integer=1; Len:Integer=0; ModeText: TModeText=mtNormal):String;
      procedure   GetParams(Data : String ; Separator: String=' ');
      property    U[Index : Integer]: String read GetUCase;//renvoie l'Uppercase de S
      property    L[Index : Integer]: String read GetLCase;//renvoie le lowerCase de S
      property    S[Index : Integer]: String read GetSingleS;//renvoie S avec la Casse d'Origine
      property    Text[Index: Integer ; Offset: Integer=1; Len: Integer=0; ModeText: TModeText=mtNormal]: String read GetText;
      property    Items[Index: Integer] : TParamsData read GetItemsParams write SetItemsParams;Default;
      property    Count: Integer read FCount;
    end;

    TMultiParams=Class
    private
    FParams:      Array of TParams; //Paramètres Dynamique
    FCount:       Integer;
    function      GetParams(Index: Integer): TParams;
    procedure     SetParams(Index: Integer; const Value: TParams);
    public
      Constructor Create(NumOfParams: Integer=5);virtual;
      procedure   Clear;
      procedure   NewParams(NumOfParams: Integer=5);
      Destructor  Destroy;override;
      property    Items[Index: Integer]: TParams read GetParams write SetParams;Default;
      property    Count : Integer read FCount;
    end;

procedure Register;
implementation

procedure Register;
begin
// TODO..
end;

{ TParams }

procedure TParams.Clear;
begin
    ZeroMemory(@FParams,SizeOf(FParams));
    FCount:=0;
end;

constructor TParams.Create;
begin
    inherited Create;
    FCount:=0;
end;

destructor TParams.Destroy;
begin
    Clear;
    inherited Destroy;
end;

function TParams.GetOffSetText(Data: String; Offset: Integer=1; Len: Integer=0;
  ModeText: TModeText=mtNormal): String;
var
S:String;
begin
     S:=Data;
     ProcessOffsetLR(S,Offset,Len);
     ProcessModeText(S,ModeText);
     result:=S;
end;

function TParams.GetItemsParams(Index: Integer): TParamsData;
begin
    if Index>=Count Then Exit;
    FSelIndex:=Index;
    FParams[Index].Offset:=GetOffsetText_;
    FParams[Index].FullText:=GetFullText_;
    result:=FParams[Index];
end;

function TParams.GetLCase(Index: Integer): String;
begin
    if Index>= Count Then Exit;
    result:=LowerCase(FParams[Index].S);
end;

procedure TParams.GetParams(Data: String;  Separator: String=' ');
var
List:TStrings;
I:Integer;
begin
    List:=TStringList.Create;
    FSeparator:=Separator;
    if Separator <> #13#10 then
    List.Text:=StringReplace(Data,Separator,#13#10,[rfReplaceAll])
    Else
    List.Text:=Data;
    FCount:=List.Count;
    SetLength(FParams,Count);
    For i:=0 to Count -1 do
    FParams[i].S:=List[i];
    List.Free;
end;

function TParams.GetSingleS(Index: Integer): String;
begin
    if Index>=Count Then Exit;
    result:=FParams[Index].S;
end;

function TParams.GetText(Index: Integer; Offset: Integer=1;
  Len: Integer=0; ModeText: TModeText=mtNormal): String;
begin
     result:=GetOffsetText(FParams[Index].S,Offset,Len, ModeText);
end;

function TParams.GetUCase(Index: Integer): String;
begin
    if Index>=Count Then Exit;
    result:=UpperCase(FParams[Index].S);
end;

procedure TParams.SetItemsParams(Index: Integer; Const Value: TParamsData);
begin
    if Index>=Count Then Exit;
    FParams[Index]:=Value;
end;

Function TParams.GetOffSetText_(Offset: Integer=1; Len: Integer=0; ModeText: TModeText=mtNormal): String;
begin
    result:=GetOffSetText(FParams[FSelIndex].S,Offset,Len,ModeText);
end;

function TParams.GetFullText_(Offset: Integer=1; Len: Integer=0; 
  ModeText: TModeText=mtNormal): String;
begin
     result:=FullText(FSelIndex,Offset,Len,ModeText);
end;

function TParams.FullText(Index :Integer; Offset: Integer=1; Len: Integer=0;
  ModeText: TModeText=mtNormal): String;
var
i:Integer;
S:String;
begin
    S:=Copy(FParams[Index].S,Offset,Length(FParams[Index].S));
    For i:=Index +1 to Count -1 do
    S:=S + FSeparator + FParams[i].S;
    ProcessOffsetLR(S,1,Len);
    ProcessModeText(S, ModeText);
    result:=S;
end;

procedure TParams.ProcessModeText(var S: String; ModeText: TModeText);
begin
     Case ModeText of
     mtUCase: S:=UpperCase(S);
     mtLCase: S:=LowerCase(S);
     end;
end;

procedure TParams.ProcessOffsetLR(var S: String; Offset, Len: Integer);
begin
      if Len=0 then Len:=Length(S);
      if Len < 0 then Len:=Length(S)+Len;
      S:=Copy(S,Offset,Len);
end;

{ TMultiParams }

procedure TMultiParams.Clear;
begin
    ZeroMemory(@FParams,SizeOf(FParams));
    FCount:=0;
end;

constructor TMultiParams.Create(NumOfParams: Integer=5);
begin
    inherited Create;
    NewParams(NumOfParams);
end;

destructor TMultiParams.Destroy;
begin
    Clear;
    inherited Destroy;
end;

function TMultiParams.GetParams(Index: Integer): TParams;
begin
    result:=Nil; 
    if Index>=Count then Exit;
    result:=FParams[Index];
end;

procedure TMultiParams.NewParams(NumOfParams: Integer=5);
var
i:Integer;
begin
    Clear;
    FCount:=NumOfParams;
    SetLength(FParams,Count);
    For i:=0 to Count -1 do
    FParams[i]:=TParams.Create;
end;

procedure TMultiParams.SetParams(Index: Integer; const Value: TParams);
begin
    if Index>=Count then Exit;
    FParams[Index]:=Value;
end;

end.

Conclusion :


inutile d'installer ce composant car sa structure ne le permet pas encore , étant donné qu'il risque d'y avoir quelques changement......
erreur de la fonction "Offset" rectifié.

Codes Sources

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.