408 lines
8.6 KiB
ObjectPascal
408 lines
8.6 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v4.0 }
|
|
{ FR Variables }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 }
|
|
{ by Alexander Tzyganenko, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit FMX.frxVariables;
|
|
|
|
interface
|
|
|
|
{$I fmx.inc}
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, FMX.frxXML, System.Variants;
|
|
|
|
|
|
type
|
|
TfrxVariable = class(TCollectionItem)
|
|
private
|
|
FName: String;
|
|
FValue: Variant;
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property Name: String read FName write FName;
|
|
property Value: Variant read FValue write FValue;
|
|
end;
|
|
|
|
TfrxVariables = class(TCollection)
|
|
private
|
|
function GetItems(Index: Integer): TfrxVariable;
|
|
function GetVariable(Index: String): Variant;
|
|
procedure SetVariable(Index: String; const Value: Variant);
|
|
public
|
|
constructor Create;
|
|
function Add: TfrxVariable;
|
|
function Insert(Index: Integer): TfrxVariable;
|
|
function IndexOf(const Name: String): Integer;
|
|
procedure AddVariable(const ACategory, AName: String; const AValue: Variant);
|
|
procedure DeleteCategory(const Name: String);
|
|
procedure DeleteVariable(const Name: String);
|
|
procedure GetCategoriesList(List: TStrings; ClearList: Boolean = True);
|
|
procedure GetVariablesList(const Category: String; List: TStrings);
|
|
procedure LoadFromFile(const FileName: String);
|
|
procedure LoadFromStream(Stream: TStream);
|
|
procedure LoadFromXMLItem(Item: TfrxXMLItem; OldXMLFormat: Boolean = True);
|
|
procedure SaveToFile(const FileName: String);
|
|
procedure SaveToStream(Stream: TStream);
|
|
procedure SaveToXMLItem(Item: TfrxXMLItem);
|
|
property Items[Index: Integer]: TfrxVariable read GetItems;
|
|
property Variables[Index: String]: Variant read GetVariable
|
|
write SetVariable; default;
|
|
end;
|
|
|
|
TfrxArray = class(TCollection)
|
|
private
|
|
function GetItems(Index: Integer): TfrxVariable;
|
|
function GetVariable(Index: Variant): Variant;
|
|
procedure SetVariable(Index: Variant; const Value: Variant);
|
|
public
|
|
constructor Create;
|
|
function IndexOf(const Name: Variant): Integer;
|
|
property Items[Index: Integer]: TfrxVariable read GetItems;
|
|
property Variables[Index: Variant]: Variant read GetVariable
|
|
write SetVariable; default;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
FMX.frxXMLSerializer, FMX.frxFMX;
|
|
|
|
|
|
{ TfrxVariable }
|
|
|
|
constructor TfrxVariable.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
FValue := Null;
|
|
end;
|
|
|
|
procedure TfrxVariable.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TfrxVariable then
|
|
begin
|
|
FName := TfrxVariable(Source).Name;
|
|
FValue := TfrxVariable(Source).Value;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TfrxVariables }
|
|
|
|
constructor TfrxVariables.Create;
|
|
begin
|
|
inherited Create(TfrxVariable);
|
|
end;
|
|
|
|
function TfrxVariables.Add: TfrxVariable;
|
|
begin
|
|
Result := TfrxVariable(inherited Add);
|
|
end;
|
|
|
|
function TfrxVariables.Insert(Index: Integer): TfrxVariable;
|
|
begin
|
|
Result := TfrxVariable(inherited Insert(Index));
|
|
end;
|
|
|
|
function TfrxVariables.GetItems(Index: Integer): TfrxVariable;
|
|
begin
|
|
Result := TfrxVariable(inherited Items[Index]);
|
|
end;
|
|
|
|
function TfrxVariables.IndexOf(const Name: String): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := -1;
|
|
for i := 0 to Count - 1 do
|
|
if frxCompareText(Name, Items[i].Name) = 0 then
|
|
begin
|
|
Result := i;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
function TfrxVariables.GetVariable(Index: String): Variant;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := IndexOf(Index);
|
|
if i <> -1 then
|
|
Result := Items[i].Value else
|
|
Result := Null;
|
|
end;
|
|
|
|
procedure TfrxVariables.SetVariable(Index: String; const Value: Variant);
|
|
var
|
|
i: Integer;
|
|
v: TfrxVariable;
|
|
begin
|
|
i := IndexOf(Index);
|
|
if i <> -1 then
|
|
Items[i].Value := Value
|
|
else
|
|
begin
|
|
v := Add;
|
|
v.Name := Index;
|
|
v.Value := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.GetCategoriesList(List: TStrings; ClearList: Boolean = True);
|
|
var
|
|
i: Integer;
|
|
s: String;
|
|
begin
|
|
if ClearList then
|
|
List.Clear;
|
|
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
s := Items[i].Name;
|
|
if (s <> '') and (s[1] = ' ') then
|
|
List.Add(Copy(s, 2, 255));
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.GetVariablesList(const Category: String; List: TStrings);
|
|
var
|
|
i, j: Integer;
|
|
s: String;
|
|
begin
|
|
List.Clear;
|
|
for i := 0 to Count - 1 do
|
|
if (Category = '') or (frxCompareText(Items[i].Name, ' ' + Category) = 0) then
|
|
begin
|
|
if Category <> '' then
|
|
j := i + 1 else
|
|
j := i;
|
|
while j < Count do
|
|
begin
|
|
s := Items[j].Name;
|
|
Inc(j);
|
|
if (s <> '') and (s[1] <> ' ') then
|
|
List.Add(s) else
|
|
break
|
|
end;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.DeleteCategory(const Name: String);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := 0;
|
|
while i < Count do
|
|
begin
|
|
if frxCompareText(Items[i].Name, ' ' + Name) = 0 then
|
|
begin
|
|
Items[i].Free;
|
|
while (i < Count) and (Items[i].Name[1] <> ' ') do
|
|
Items[i].Free;
|
|
break;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.DeleteVariable(const Name: String);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := IndexOf(Name);
|
|
if i <> -1 then
|
|
Items[i].Free;
|
|
end;
|
|
|
|
procedure TfrxVariables.AddVariable(const ACategory, AName: String;
|
|
const AValue: Variant);
|
|
var
|
|
i, idx: Integer;
|
|
begin
|
|
i := 0;
|
|
while i < Count do
|
|
begin
|
|
if frxCompareText(Items[i].Name, ' ' + ACategory) = 0 then
|
|
begin
|
|
Inc(i);
|
|
while (i < Count) and (Items[i].Name[1] <> ' ') do
|
|
Inc(i);
|
|
idx := IndexOf(AName);
|
|
if idx <> - 1 then
|
|
Items[idx].Value := AValue
|
|
else
|
|
if i = Count then
|
|
with Add do
|
|
begin
|
|
Name := AName;
|
|
Value := AValue;
|
|
end
|
|
else
|
|
with Insert(i) do
|
|
begin
|
|
Name := AName;
|
|
Value := AValue;
|
|
end;
|
|
break;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.LoadFromFile(const FileName: String);
|
|
var
|
|
f: TFileStream;
|
|
begin
|
|
f := TFileStream.Create(FileName, fmOpenRead);
|
|
try
|
|
LoadFromStream(f);
|
|
finally
|
|
f.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.LoadFromStream(Stream: TStream);
|
|
var
|
|
x: TfrxXMLDocument;
|
|
begin
|
|
Clear;
|
|
x := TfrxXMLDocument.Create;
|
|
try
|
|
x.LoadFromStream(Stream);
|
|
if CompareText(x.Root.Name, 'variables') = 0 then
|
|
LoadFromXMLItem(x.Root, x.OldVersion);
|
|
finally
|
|
x.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.LoadFromXMLItem(Item: TfrxXMLItem; OldXMLFormat: Boolean);
|
|
var
|
|
xs: TfrxXMLSerializer;
|
|
i: Integer;
|
|
begin
|
|
Clear;
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
xs.OldFormat := OldXMLFormat;
|
|
try
|
|
for i := 0 to Item.Count - 1 do
|
|
if CompareText(Item[i].Name, 'item') = 0 then
|
|
xs.XMLToObj(Item[i].Text, Add);
|
|
finally
|
|
xs.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.SaveToFile(const FileName: String);
|
|
var
|
|
f: TFileStream;
|
|
begin
|
|
f := TFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(f);
|
|
finally
|
|
f.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.SaveToStream(Stream: TStream);
|
|
var
|
|
x: TfrxXMLDocument;
|
|
begin
|
|
x := TfrxXMLDocument.Create;
|
|
x.AutoIndent := True;
|
|
try
|
|
x.Root.Name := 'variables';
|
|
SaveToXMLItem(x.Root);
|
|
x.SaveToStream(Stream);
|
|
finally
|
|
x.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxVariables.SaveToXMLItem(Item: TfrxXMLItem);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
xs: TfrxXMLSerializer;
|
|
i: Integer;
|
|
begin
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
try
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
xi := Item.Add;
|
|
xi.Name := 'item';
|
|
xi.Text := xs.ObjToXML(Items[i]);
|
|
end;
|
|
finally
|
|
xs.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TfrxArray }
|
|
|
|
constructor TfrxArray.Create;
|
|
begin
|
|
inherited Create(TfrxVariable);
|
|
end;
|
|
|
|
function TfrxArray.GetItems(Index: Integer): TfrxVariable;
|
|
begin
|
|
Result := TfrxVariable(inherited Items[Index]);
|
|
end;
|
|
|
|
function TfrxArray.IndexOf(const Name: Variant): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := -1;
|
|
for i := 0 to Count - 1 do
|
|
if frxCompareText(VarToStr(Name), Items[i].Name) = 0 then
|
|
begin
|
|
Result := i;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
function TfrxArray.GetVariable(Index: Variant): Variant;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := IndexOf(Index);
|
|
if i <> -1 then
|
|
Result := Items[i].Value else
|
|
Result := Null;
|
|
end;
|
|
|
|
procedure TfrxArray.SetVariable(Index: Variant; const Value: Variant);
|
|
var
|
|
i: Integer;
|
|
v: TfrxVariable;
|
|
begin
|
|
i := IndexOf(Index);
|
|
if i <> -1 then
|
|
Items[i].Value := Value
|
|
else
|
|
begin
|
|
v := TfrxVariable(inherited Add);
|
|
v.Name := Index;
|
|
v.Value := Value;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|