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é.
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.