Fixed: VirtualTree columns revert to ParentColor properly in SortColumn
Changed: X2UtConfig implementation
This commit is contained in:
parent
909f804569
commit
f5535247fa
@ -9,11 +9,23 @@ type
|
||||
TSettingsTest = class(TTestCase)
|
||||
protected
|
||||
function CreateSource(): IX2ConfigSource; virtual; abstract;
|
||||
published
|
||||
procedure Read();
|
||||
procedure Write();
|
||||
procedure Delete();
|
||||
procedure Save(); virtual; abstract;
|
||||
end;
|
||||
|
||||
TSettingsINITest = class(TSettingsTest)
|
||||
protected
|
||||
function CreateSource(): IX2ConfigSource; override;
|
||||
published
|
||||
procedure Save(); override;
|
||||
|
||||
procedure StringRange();
|
||||
procedure IntegerRange();
|
||||
private
|
||||
procedure FloatRange();
|
||||
end;
|
||||
|
||||
TSettingsRegistryTest = class(TSettingsTest)
|
||||
@ -37,13 +49,112 @@ type
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
Classes,
|
||||
SysUtils,
|
||||
|
||||
madExcept,
|
||||
|
||||
X2UtConfigIni,
|
||||
X2UtConfigRanges;
|
||||
|
||||
{ TSettingsINITest }
|
||||
function TSettingsINITest.CreateSource(): IX2ConfigSource;
|
||||
var
|
||||
ssData: TStringStream;
|
||||
|
||||
begin
|
||||
ssData := TStringStream.Create('[ReadTest]'#13#10 +
|
||||
'SomeKey=SomeValue');
|
||||
try
|
||||
Result := TX2IniConfigSource.Create(ssData);
|
||||
finally
|
||||
FreeAndNil(ssData);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsINITest.Save;
|
||||
var
|
||||
ssData: TStringStream;
|
||||
|
||||
begin
|
||||
ssData := TStringStream.Create('');
|
||||
try
|
||||
with CreateSource() do
|
||||
begin
|
||||
with Configs('SaveTest') do
|
||||
begin
|
||||
Write('String', 'Test');
|
||||
Write('Integer', 5);
|
||||
Write('Float', 3.5);
|
||||
Write('Boolean', True);
|
||||
end;
|
||||
|
||||
Save(ssData);
|
||||
end;
|
||||
|
||||
ssData.Seek(0, soFromBeginning);
|
||||
with (TX2IniConfigSource.Create(ssData) as IX2ConfigSource) do
|
||||
begin
|
||||
CheckTrue(Exists('ReadTest'), 'ReadTest not found');
|
||||
CheckTrue(Exists('SaveTest'), 'SaveTest not found');
|
||||
|
||||
with Configs('ReadTest') do
|
||||
CheckTrue(Exists('SomeKey'), 'ReadTest.SomeKey not found');
|
||||
|
||||
with Configs('SaveTest') do
|
||||
begin
|
||||
CheckTrue(Exists('String'), 'SaveTest.String not found');
|
||||
CheckTrue(Exists('Integer'), 'SaveTest.Integer not found');
|
||||
CheckTrue(Exists('Float'), 'SaveTest.Float not found');
|
||||
CheckTrue(Exists('Boolean'), 'SaveTest.Boolean not found');
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(ssData);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsINITest.StringRange;
|
||||
begin
|
||||
with CreateSource() do
|
||||
begin
|
||||
Register('RangeTest', 'String').Attach(TX2ConfigStringLengthRange.Create(5, 5, '0', spLeft));
|
||||
|
||||
with Configs('RangeTest') do
|
||||
begin
|
||||
Write('String', '1');
|
||||
CheckEquals('00001', Read('String'));
|
||||
|
||||
Write('String', '1234567890');
|
||||
CheckEquals('12345', Read('String'));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsINITest.IntegerRange;
|
||||
begin
|
||||
with CreateSource() do
|
||||
begin
|
||||
Register('RangeTest', 'Integer').Attach(TX2ConfigIntegerRange.Create(5, 10, 8));
|
||||
|
||||
with Configs('RangeTest') do
|
||||
begin
|
||||
Write('String', '1');
|
||||
CheckEquals('00001', Read('String'));
|
||||
|
||||
Write('String', '1234567890');
|
||||
CheckEquals('12345', Read('String'));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsINITest.FloatRange;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
|
||||
{ TSettingsRegistryTest }
|
||||
function TSettingsRegistryTest.CreateSource(): IX2ConfigSource;
|
||||
begin
|
||||
@ -69,11 +180,55 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TSettingsTest }
|
||||
procedure TSettingsTest.Read;
|
||||
begin
|
||||
with CreateSource() do
|
||||
CheckEquals('SomeValue', Configs('ReadTest').Read('SomeKey'));
|
||||
end;
|
||||
|
||||
procedure TSettingsTest.Write;
|
||||
begin
|
||||
with CreateSource() do
|
||||
begin
|
||||
with Configs('WriteTest') do
|
||||
begin
|
||||
Write('NewKey', 255);
|
||||
CheckEquals(255, Read('NewKey'));
|
||||
end;
|
||||
|
||||
with Configs('ReadTest') do
|
||||
begin
|
||||
Write('SomeKey', 'NewValue');
|
||||
CheckEquals('NewValue', Read('SomeKey'));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsTest.Delete;
|
||||
begin
|
||||
with CreateSource() do
|
||||
begin
|
||||
with Configs('DeleteTest') do
|
||||
begin
|
||||
Write('SomeKey', 'SomeValue');
|
||||
Delete('SomeKey');
|
||||
CheckFalse(Exists('SomeKey'));
|
||||
end;
|
||||
|
||||
Delete('DeleteTest');
|
||||
CheckFalse(Exists('DeleteTest'));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterTest('Settings', TSettingsINITest.Suite);
|
||||
{
|
||||
RegisterTest('Settings', TSettingsRegistryTest.Suite);
|
||||
RegisterTest('Settings', TSettingsXMLTest.Suite);
|
||||
RegisterTest('Settings', TSettingsNiniXMLTest.Suite);
|
||||
RegisterTest('Settings', TSettingsCmdLineTest.Suite);
|
||||
}
|
||||
|
||||
end.
|
||||
|
||||
@ -25,6 +25,7 @@
|
||||
-$YD
|
||||
-$Z1
|
||||
-cg
|
||||
-vn
|
||||
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
-H+
|
||||
-W+
|
||||
|
||||
@ -83,7 +83,7 @@ UnsafeCast=0
|
||||
MapFile=0
|
||||
OutputObjs=0
|
||||
ConsoleApp=1
|
||||
DebugInfo=0
|
||||
DebugInfo=1
|
||||
RemoteSymbols=0
|
||||
MinStackSize=16384
|
||||
MaxStackSize=1048576
|
||||
|
||||
502
X2UtConfig.pas
502
X2UtConfig.pas
@ -9,6 +9,11 @@
|
||||
:: X2UtXMLConfigSource is capable of recognizing, reading and writing
|
||||
:: Nini-compatible XML files.
|
||||
::
|
||||
:: To accomodate for tree structures, configuration names may contain a
|
||||
:: dot (.) to separate the sections. While they are used as-is in flat
|
||||
:: sources (INI), they are used for subkeys in tree source (Registry, XML).
|
||||
:: The SectionSeparator variable is available for this purpose.
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
@ -19,187 +24,120 @@ interface
|
||||
uses
|
||||
Classes,
|
||||
|
||||
X2UtHashes,
|
||||
X2UtHashesVariants;
|
||||
X2UtHashes;
|
||||
|
||||
type
|
||||
// Forward declarations
|
||||
IX2Config = interface;
|
||||
IX2ConfigSource = interface;
|
||||
IX2ConfigSource = interface;
|
||||
IX2Config = interface;
|
||||
IX2ConfigDefinition = interface;
|
||||
IX2ConfigDefinitionObserver = interface;
|
||||
|
||||
{
|
||||
:$ Callback for Iterate method.
|
||||
:$ Callback method for config iteration
|
||||
}
|
||||
TX2ConfigIterateMethod = procedure(Sender: IX2ConfigSource;
|
||||
Config: IX2Config;
|
||||
var Abort: Boolean) of object;
|
||||
|
||||
TX2ConfigIterateConfigs = procedure(Sender: IX2ConfigSource;
|
||||
const Name: String;
|
||||
const Data: Pointer) of object;
|
||||
|
||||
{
|
||||
:$ Interface for configurations.
|
||||
|
||||
:: Implementations are highly recommended to descend from, or simply use,
|
||||
:: TX2BaseConfig.
|
||||
:$ Callback method for value iteration
|
||||
}
|
||||
IX2Config = interface
|
||||
['{25DF95C1-CE09-44A7-816B-A33B8D0D78DC}']
|
||||
function GetName(): String;
|
||||
TX2ConfigIterateValues = procedure(Sender: IX2Config;
|
||||
const Name: String;
|
||||
const Data: Pointer) of object;
|
||||
|
||||
function ReadBool(const AName: String; const ADefault: Boolean = False): Boolean;
|
||||
function ReadFloat(const AName: String; const ADefault: Double = 0): Double;
|
||||
function ReadInteger(const AName: String; const ADefault: Integer = 0): Integer;
|
||||
function ReadString(const AName: String; const ADefault: String = ''): String;
|
||||
{
|
||||
:$ Determines which values should be cleared.
|
||||
|
||||
procedure WriteBool(const AName: String; AValue: Boolean);
|
||||
procedure WriteFloat(const AName: String; AValue: Double);
|
||||
procedure WriteInteger(const AName: String; AValue: Integer);
|
||||
procedure WriteString(const AName, AValue: String);
|
||||
|
||||
procedure Clear();
|
||||
procedure Delete(const AName: String);
|
||||
function Exists(const AName: String): Boolean;
|
||||
|
||||
procedure Save();
|
||||
|
||||
property Name: String read GetName;
|
||||
end;
|
||||
:: caAll clears all values
|
||||
:: caDefined clears only values which have been defined using
|
||||
:: IX2ConfigSource.Register
|
||||
:: caUndefined clears only values which have not been defined using
|
||||
:: IX2ConfigSource.Register
|
||||
}
|
||||
TX2ConfigClearAction = (caAll, caDefined, caUndefined);
|
||||
|
||||
{
|
||||
:$ Interface for configuration sources.
|
||||
|
||||
:: For subsections, seperate each section name with a dot (.)
|
||||
::
|
||||
:: Implementations are highly recommended to descend from
|
||||
:: TX2BaseConfigSource.
|
||||
}
|
||||
IX2ConfigSource = interface
|
||||
['{1FF5282B-122F-47D7-95E8-3DB60A8CF765}']
|
||||
function GetAutoSave(): Boolean;
|
||||
procedure SetAutoSave(Value: Boolean);
|
||||
|
||||
procedure Reload();
|
||||
procedure Save(); overload;
|
||||
procedure Save(const AStream: TStream); overload;
|
||||
|
||||
function Configs(const AName: String): IX2Config;
|
||||
|
||||
function Add(const AName: String): IX2Config;
|
||||
function Exists(const AName: String): Boolean;
|
||||
|
||||
procedure Delete(const AName: String);
|
||||
procedure Clear();
|
||||
procedure Clear(const AAction: TX2ConfigClearAction);
|
||||
|
||||
procedure Save();
|
||||
procedure Iterate(const ACallback: TX2ConfigIterateConfigs;
|
||||
const AData: Pointer);
|
||||
|
||||
procedure List(const AName: String; const ADest: TStrings;
|
||||
const ARecurse: Boolean = False);
|
||||
procedure Iterate(const AName: String;
|
||||
const ACallback: TX2ConfigIterateMethod;
|
||||
const AData: Pointer;
|
||||
const ARecurse: Boolean = False); overload;
|
||||
function Register(const AConfig, AName: String): IX2ConfigDefinition; overload;
|
||||
function Register(const AConfig, AName: String;
|
||||
const ADefault: Variant): IX2ConfigDefinition; overload;
|
||||
function Definitions(const AConfig, AName: String): IX2ConfigDefinition;
|
||||
|
||||
property AutoSave: Boolean read GetAutoSave write SetAutoSave;
|
||||
end;
|
||||
|
||||
// Forward declarations
|
||||
TX2BaseConfig = class;
|
||||
TX2BaseConfigSource = class;
|
||||
|
||||
{
|
||||
:$ Hash for configuration objects.
|
||||
:$ Interface for configurations.
|
||||
}
|
||||
TX2ConfigHash = class(TX2SOHash)
|
||||
protected
|
||||
function GetCurrentValue(): TX2BaseConfig;
|
||||
function GetValue(Key: String): TX2BaseConfig;
|
||||
procedure SetValue(Key: String; const Value: TX2BaseConfig);
|
||||
public
|
||||
property CurrentValue: TX2BaseConfig read GetCurrentValue;
|
||||
property Values[Key: String]: TX2BaseConfig read GetValue write SetValue; default;
|
||||
IX2Config = interface
|
||||
['{25DF95C1-CE09-44A7-816B-A33B8D0D78DC}']
|
||||
function GetName(): String;
|
||||
function GetSource(): IX2ConfigSource;
|
||||
|
||||
function Exists(const AName: String): Boolean;
|
||||
function Read(const AName: String): Variant; overload;
|
||||
function Read(const AName: String; const ADefault: Variant): Variant; overload;
|
||||
procedure Write(const AName: String; const AValue: Variant);
|
||||
|
||||
procedure Delete(const AName: String);
|
||||
procedure Clear(const AAction: TX2ConfigClearAction);
|
||||
|
||||
procedure Iterate(const ACallback: TX2ConfigIterateValues;
|
||||
const AData: Pointer);
|
||||
|
||||
property Name: String read GetName;
|
||||
property Source: IX2ConfigSource read GetSource;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Default implementation for configurations.
|
||||
:$ Interface for configuration value definitions.
|
||||
}
|
||||
TX2BaseConfig = class(TInterfacedObject, IX2Config)
|
||||
private
|
||||
FConfigItems: TX2ConfigHash;
|
||||
FName: String;
|
||||
FSource: IX2ConfigSource;
|
||||
FValues: TX2SVHash;
|
||||
protected
|
||||
procedure WriteValue(const AName: String; const AValue: Variant);
|
||||
|
||||
property Source: IX2ConfigSource read FSource;
|
||||
property Values: TX2SVHash read FValues;
|
||||
property ConfigItems: TX2ConfigHash read FConfigItems;
|
||||
public
|
||||
constructor Create(const AConfig: String; const ASource: IX2ConfigSource);
|
||||
destructor Destroy(); override;
|
||||
|
||||
// IX2Config
|
||||
IX2ConfigDefinition = interface
|
||||
['{00C67656-24FB-4CBE-81DC-B064A5550820}']
|
||||
function GetDefault(): Variant;
|
||||
function GetConfig(): String;
|
||||
function GetName(): String;
|
||||
procedure SetDefault(Value: Variant);
|
||||
|
||||
function ReadBool(const AName: String; const ADefault: Boolean = False): Boolean;
|
||||
function ReadFloat(const AName: String; const ADefault: Double = 0): Double;
|
||||
function ReadInteger(const AName: String; const ADefault: Integer = 0): Integer;
|
||||
function ReadString(const AName: String; const ADefault: String = ''): String;
|
||||
procedure Attach(const AObserver: IX2ConfigDefinitionObserver);
|
||||
procedure Detach(const AObserver: IX2ConfigDefinitionObserver);
|
||||
|
||||
procedure WriteBool(const AName: String; AValue: Boolean);
|
||||
procedure WriteFloat(const AName: String; AValue: Double);
|
||||
procedure WriteInteger(const AName: String; AValue: Integer);
|
||||
procedure WriteString(const AName, AValue: String);
|
||||
|
||||
procedure Clear();
|
||||
procedure Delete(const AName: String);
|
||||
function Exists(const AName: String): Boolean;
|
||||
|
||||
procedure Save(); virtual;
|
||||
procedure Read(var AValue: Variant);
|
||||
procedure Write(var AValue: Variant);
|
||||
|
||||
property Default: Variant read GetDefault write SetDefault;
|
||||
property Config: String read GetConfig;
|
||||
property Name: String read GetName;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Default implementation for configuration sources.
|
||||
:$ Interface for configuration value definition observers.
|
||||
}
|
||||
TX2BaseConfigSource = class(TInterfacedObject, IX2ConfigSource)
|
||||
private
|
||||
FAutoSave: Boolean;
|
||||
FConfigItems: TX2ConfigHash;
|
||||
protected
|
||||
function GetConfig(const AName: String;
|
||||
const AAllowCreate: Boolean = True): TX2BaseConfig; virtual;
|
||||
function CreateConfig(const AName: String): TX2BaseConfig; virtual; abstract;
|
||||
function GetItems(const AName: String): TX2ConfigHash; virtual;
|
||||
|
||||
property ConfigItems: TX2ConfigHash read FConfigItems;
|
||||
public
|
||||
constructor Create();
|
||||
destructor Destroy(); override;
|
||||
|
||||
// IX2ConfigSource
|
||||
function GetAutoSave(): Boolean;
|
||||
procedure SetAutoSave(Value: Boolean);
|
||||
|
||||
function Configs(const AName: String): IX2Config; virtual;
|
||||
|
||||
function Add(const AName: String): IX2Config; virtual;
|
||||
function Exists(const AName: String): Boolean; virtual;
|
||||
procedure Delete(const AName: String); virtual;
|
||||
procedure Clear(); virtual;
|
||||
|
||||
procedure Save(); virtual;
|
||||
|
||||
procedure List(const AName: String; const ADest: TStrings;
|
||||
const ARecurse: Boolean = False); virtual;
|
||||
procedure Iterate(const AName: String;
|
||||
const ACallback: TX2ConfigIterateMethod;
|
||||
const AData: Pointer = nil;
|
||||
const ARecurse: Boolean = False); overload; virtual;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Default implementation for stream-based configuration sources.
|
||||
}
|
||||
TX2StreamConfigSource = class(TX2BaseConfigSource)
|
||||
public
|
||||
constructor Create(const AStream: TStream); overload; virtual; abstract;
|
||||
constructor Create(const AFileName: String); overload; virtual;
|
||||
IX2ConfigDefinitionObserver = interface
|
||||
['{EE20E59D-6642-42D7-A520-6A4F1C5FD3EA}']
|
||||
procedure Read(const AConfig, AName: String; var AValue: Variant);
|
||||
procedure Write(const AConfig, AName: String; var AValue: Variant);
|
||||
end;
|
||||
|
||||
|
||||
@ -208,294 +146,4 @@ var
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils,
|
||||
Variants,
|
||||
|
||||
X2UtStrings;
|
||||
|
||||
{========================================
|
||||
TX2ConfigHash
|
||||
========================================}
|
||||
function TX2ConfigHash.GetCurrentValue(): TX2BaseConfig;
|
||||
begin
|
||||
Result := TX2BaseConfig(inherited GetCurrentValue());
|
||||
end;
|
||||
|
||||
function TX2ConfigHash.GetValue(Key: String): TX2BaseConfig;
|
||||
begin
|
||||
Result := TX2BaseConfig(inherited GetValue(Key));
|
||||
end;
|
||||
|
||||
procedure TX2ConfigHash.SetValue(Key: String; const Value: TX2BaseConfig);
|
||||
begin
|
||||
inherited SetValue(Key, Value);
|
||||
end;
|
||||
|
||||
|
||||
{==================== TX2BaseConfigSource
|
||||
IX2ConfigSource
|
||||
========================================}
|
||||
constructor TX2BaseConfigSource.Create();
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FConfigItems := TX2ConfigHash.Create(True);
|
||||
end;
|
||||
|
||||
destructor TX2BaseConfigSource.Destroy();
|
||||
begin
|
||||
FreeAndNil(FConfigItems);
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfigSource.GetAutoSave(): Boolean;
|
||||
begin
|
||||
Result := FAutoSave;
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.SetAutoSave(Value: Boolean);
|
||||
begin
|
||||
FAutoSave := Value;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfigSource.GetConfig(const AName: String;
|
||||
const AAllowCreate: Boolean): TX2BaseConfig;
|
||||
var
|
||||
aSections: TSplitArray;
|
||||
iSection: Integer;
|
||||
pItems: TX2ConfigHash;
|
||||
sSection: String;
|
||||
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
// Separate subsections
|
||||
Split(AName, SectionSeparator, aSections);
|
||||
|
||||
for iSection := Low(aSections) to High(aSections) do
|
||||
begin
|
||||
sSection := Trim(aSections[iSection]);
|
||||
if Length(sSection) = 0 then
|
||||
continue;
|
||||
|
||||
if Assigned(Result) then
|
||||
pItems := Result.ConfigItems
|
||||
else
|
||||
pItems := FConfigItems;
|
||||
|
||||
Result := pItems[sSection];
|
||||
if not Assigned(Result) then
|
||||
if AAllowCreate then
|
||||
begin
|
||||
Result := CreateConfig(sSection);
|
||||
pItems[sSection] := Result;
|
||||
end else
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.GetItems(const AName: String): TX2ConfigHash;
|
||||
var
|
||||
pConfig: TX2BaseConfig;
|
||||
|
||||
begin
|
||||
Result := nil;
|
||||
if Length(Trim(AName)) > 0 then
|
||||
begin
|
||||
pConfig := GetConfig(AName, False);
|
||||
if Assigned(pConfig) then
|
||||
Result := pConfig.ConfigItems;
|
||||
end else
|
||||
Result := FConfigItems;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfigSource.Configs(const AName: String): IX2Config;
|
||||
begin
|
||||
Result := GetConfig(AName, True);
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.Add(const AName: String): IX2Config;
|
||||
begin
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.Exists(const AName: String): Boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Delete(const AName: String);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Clear();
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2BaseConfigSource.Save();
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.List(const AName: String; const ADest: TStrings;
|
||||
const ARecurse: Boolean);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Iterate(const AName: String;
|
||||
const ACallback: TX2ConfigIterateMethod;
|
||||
const AData: Pointer;
|
||||
const ARecurse: Boolean);
|
||||
var
|
||||
bAbort: Boolean;
|
||||
pItems: TX2ConfigHash;
|
||||
|
||||
begin
|
||||
pItems := GetItems(AName);
|
||||
if not Assigned(pItems) then
|
||||
exit;
|
||||
|
||||
bAbort := False;
|
||||
pItems.First();
|
||||
while pItems.Next() do
|
||||
begin
|
||||
ACallback(Self, pItems.CurrentValue, bAbort);
|
||||
if bAbort then
|
||||
break;
|
||||
|
||||
if ARecurse then
|
||||
Iterate(AName + SectionSeparator + pItems.CurrentValue.Name, ACallback,
|
||||
AData, ARecurse);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{================== TX2StreamConfigSource
|
||||
Initialization
|
||||
========================================}
|
||||
constructor TX2StreamConfigSource.Create(const AFileName: String);
|
||||
var
|
||||
fsData: TFileStream;
|
||||
|
||||
begin
|
||||
fsData := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
Create(fsData);
|
||||
finally
|
||||
FreeAndNil(fsData);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{========================== TX2BaseConfig
|
||||
IX2Config
|
||||
========================================}
|
||||
constructor TX2BaseConfig.Create(const AConfig: String;
|
||||
const ASource: IX2ConfigSource);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
FSource := ASource;
|
||||
FName := AConfig;
|
||||
FConfigItems := TX2ConfigHash.Create(True);
|
||||
end;
|
||||
|
||||
destructor TX2BaseConfig.Destroy();
|
||||
begin
|
||||
FreeAndNil(FConfigItems);
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfig.GetName(): String;
|
||||
begin
|
||||
Result := FName;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfig.ReadBool(const AName: String;
|
||||
const ADefault: Boolean): Boolean;
|
||||
begin
|
||||
Result := ADefault;
|
||||
if Values.Exists(AName) then
|
||||
Result := VarAsType(Values[AName], vtBoolean);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.ReadFloat(const AName: String;
|
||||
const ADefault: Double): Double;
|
||||
begin
|
||||
Result := ADefault;
|
||||
if Values.Exists(AName) then
|
||||
Result := VarAsType(Values[AName], vtExtended);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.ReadInteger(const AName: String;
|
||||
const ADefault: Integer): Integer;
|
||||
begin
|
||||
Result := ADefault;
|
||||
if Values.Exists(AName) then
|
||||
Result := VarAsType(Values[AName], vtInteger);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.ReadString(const AName, ADefault: String): String;
|
||||
begin
|
||||
Result := ADefault;
|
||||
if Values.Exists(AName) then
|
||||
Result := VarAsType(Values[AName], vtString);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2BaseConfig.WriteValue(const AName: String; const AValue: Variant);
|
||||
begin
|
||||
Values[AName] := AValue;
|
||||
if Source.AutoSave then
|
||||
Save();
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.WriteBool(const AName: String; AValue: Boolean);
|
||||
begin
|
||||
WriteValue(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.WriteFloat(const AName: String; AValue: Double);
|
||||
begin
|
||||
WriteValue(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.WriteInteger(const AName: String; AValue: Integer);
|
||||
begin
|
||||
WriteValue(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.WriteString(const AName, AValue: String);
|
||||
begin
|
||||
WriteValue(AName, AValue);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2BaseConfig.Clear();
|
||||
begin
|
||||
Values.Clear();
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.Delete(const AName: String);
|
||||
begin
|
||||
Values.Delete(AName);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.Exists(const AName: String): Boolean;
|
||||
begin
|
||||
Result := Values.Exists(AName);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2BaseConfig.Save();
|
||||
begin
|
||||
Source.Save();
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
763
X2UtConfigBase.pas
Normal file
763
X2UtConfigBase.pas
Normal file
@ -0,0 +1,763 @@
|
||||
{
|
||||
:: X2UtConfigBase provides the base implementation for various
|
||||
:: configuration sources.
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
}
|
||||
unit X2UtConfigBase;
|
||||
|
||||
interface
|
||||
uses
|
||||
Classes,
|
||||
|
||||
X2UtConfig,
|
||||
X2UtHashes;
|
||||
|
||||
type
|
||||
// Forward declarations
|
||||
TX2BaseConfigSource = class;
|
||||
TX2BaseConfig = class;
|
||||
TX2ConfigValueHash = class;
|
||||
TX2ConfigHash = class;
|
||||
TX2ConfigDefinitionHash = class;
|
||||
|
||||
TX2StreamConfigSource = class;
|
||||
|
||||
TX2ConfigState = (csClean, csCreate, csUpdate, csDelete);
|
||||
|
||||
{
|
||||
:$ Default implementation for configuration sources.
|
||||
}
|
||||
TX2BaseConfigSource = class(TInterfacedObject, IX2ConfigSource)
|
||||
private
|
||||
FAutoSave: Boolean;
|
||||
FConfigItems: TX2ConfigHash;
|
||||
FDefinitions: TX2ConfigDefinitionHash;
|
||||
protected
|
||||
function GetConfig(const AName: String;
|
||||
const AAllowCreate: Boolean = True): TX2BaseConfig; virtual;
|
||||
|
||||
procedure LoadConfigs(); virtual; abstract;
|
||||
function CreateConfig(const AName: String): TX2BaseConfig; virtual; abstract;
|
||||
|
||||
property ConfigItems: TX2ConfigHash read FConfigItems;
|
||||
public
|
||||
constructor Create();
|
||||
destructor Destroy(); override;
|
||||
|
||||
// IX2ConfigSource
|
||||
function GetAutoSave(): Boolean;
|
||||
procedure SetAutoSave(Value: Boolean);
|
||||
|
||||
procedure Reload(); virtual;
|
||||
procedure Save(); overload; virtual; abstract;
|
||||
procedure Save(const AStream: TStream); overload; virtual; abstract;
|
||||
|
||||
function Configs(const AName: String): IX2Config; virtual;
|
||||
function Exists(const AName: String): Boolean; virtual;
|
||||
|
||||
procedure Delete(const AName: String); virtual;
|
||||
procedure Clear(const AAction: TX2ConfigClearAction); virtual;
|
||||
|
||||
procedure Iterate(const ACallback: TX2ConfigIterateConfigs;
|
||||
const AData: Pointer);
|
||||
|
||||
function Register(const AConfig, AName: String): IX2ConfigDefinition; overload;
|
||||
function Register(const AConfig, AName: String;
|
||||
const ADefault: Variant): IX2ConfigDefinition; overload;
|
||||
function Definitions(const AConfig, AName: String): IX2ConfigDefinition;
|
||||
|
||||
property AutoSave: Boolean read GetAutoSave write SetAutoSave;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Default implementation for configurations.
|
||||
}
|
||||
TX2BaseConfig = class(TObject, IInterface, IX2Config)
|
||||
private
|
||||
FName: String;
|
||||
FSource: TX2BaseConfigSource;
|
||||
FState: TX2ConfigState;
|
||||
FValues: TX2ConfigValueHash;
|
||||
protected
|
||||
// IInterface
|
||||
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
|
||||
function _AddRef(): Integer; stdcall;
|
||||
function _Release(): Integer; stdcall;
|
||||
|
||||
function InternalRead(const AName: String; const ADefault: Variant;
|
||||
const AUseDefinition: Boolean): Variant; virtual;
|
||||
procedure InternalWrite(const AName: String; const AValue: Variant;
|
||||
const AUpdateState: Boolean = True); virtual;
|
||||
|
||||
property Values: TX2ConfigValueHash read FValues;
|
||||
public
|
||||
constructor Create(const AName: String; const ASource: TX2BaseConfigSource); virtual;
|
||||
destructor Destroy(); override;
|
||||
|
||||
// IX2Config
|
||||
function GetName(): String;
|
||||
function GetSource(): IX2ConfigSource;
|
||||
|
||||
function Exists(const AName: String): Boolean; virtual;
|
||||
function Read(const AName: String): Variant; overload;
|
||||
function Read(const AName: String; const ADefault: Variant): Variant; overload;
|
||||
procedure Write(const AName: String; const AValue: Variant); virtual;
|
||||
|
||||
procedure Delete(const AName: String); virtual;
|
||||
procedure Clear(const AAction: TX2ConfigClearAction); virtual;
|
||||
|
||||
procedure Iterate(const ACallback: TX2ConfigIterateValues;
|
||||
const AData: Pointer);
|
||||
|
||||
property Name: String read GetName;
|
||||
property Source: IX2ConfigSource read GetSource;
|
||||
property State: TX2ConfigState read FState write FState;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Default implementation for value definitions.
|
||||
}
|
||||
TX2ConfigDefinition = class(TObject, IInterface, IX2ConfigDefinition)
|
||||
private
|
||||
FConfig: String;
|
||||
FName: String;
|
||||
FDefault: Variant;
|
||||
FObservers: TInterfaceList;
|
||||
protected
|
||||
// IInterface
|
||||
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
|
||||
function _AddRef(): Integer; stdcall;
|
||||
function _Release(): Integer; stdcall;
|
||||
|
||||
// IX2ConfigDefinition
|
||||
function GetDefault(): Variant;
|
||||
function GetConfig(): String;
|
||||
function GetName(): String;
|
||||
procedure SetDefault(Value: Variant);
|
||||
|
||||
procedure Attach(const AObserver: IX2ConfigDefinitionObserver);
|
||||
procedure Detach(const AObserver: IX2ConfigDefinitionObserver);
|
||||
|
||||
procedure Read(var AValue: Variant);
|
||||
procedure Write(var AValue: Variant);
|
||||
|
||||
property Default: Variant read GetDefault write SetDefault;
|
||||
property Config: String read GetConfig;
|
||||
property Name: String read GetName;
|
||||
public
|
||||
constructor Create(const AConfig, AName: String; const ADefault: Variant);
|
||||
destructor Destroy(); override;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Internal representation of a value.
|
||||
}
|
||||
PX2ConfigValue = ^TX2ConfigValue;
|
||||
TX2ConfigValue = record
|
||||
Value: Variant;
|
||||
State: TX2ConfigState;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Hash for configuration values.
|
||||
}
|
||||
TX2ConfigValueHash = class(TX2SPHash)
|
||||
protected
|
||||
function GetCurrentValue(): PX2ConfigValue;
|
||||
function GetValue(Key: String): PX2ConfigValue;
|
||||
procedure SetValue(Key: String; const Value: PX2ConfigValue);
|
||||
public
|
||||
property CurrentValue: PX2ConfigValue read GetCurrentValue;
|
||||
property Values[Key: String]: PX2ConfigValue read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Hash for configuration objects.
|
||||
}
|
||||
TX2ConfigHash = class(TX2SOHash)
|
||||
protected
|
||||
function GetCurrentValue(): TX2BaseConfig;
|
||||
function GetValue(Key: String): TX2BaseConfig;
|
||||
procedure SetValue(Key: String; const Value: TX2BaseConfig);
|
||||
public
|
||||
property CurrentValue: TX2BaseConfig read GetCurrentValue;
|
||||
property Values[Key: String]: TX2BaseConfig read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Hash for value definitions.
|
||||
}
|
||||
TX2ConfigDefinitionHash = class(TX2SOHash)
|
||||
protected
|
||||
function GetCurrentValue(): TX2ConfigDefinition;
|
||||
function GetValue(Key: String): TX2ConfigDefinition;
|
||||
procedure SetValue(Key: String; const Value: TX2ConfigDefinition);
|
||||
public
|
||||
property CurrentValue: TX2ConfigDefinition read GetCurrentValue;
|
||||
property Values[Key: String]: TX2ConfigDefinition read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Default implementation for stream-based configuration sources.
|
||||
}
|
||||
TX2StreamConfigSource = class(TX2BaseConfigSource)
|
||||
private
|
||||
FFileName: String;
|
||||
protected
|
||||
procedure LoadConfigs(); override;
|
||||
|
||||
procedure LoadFromFile(const AFileName: String); virtual;
|
||||
procedure LoadFromStream(const AStream: TStream); virtual; abstract;
|
||||
|
||||
property FileName: String read FFileName;
|
||||
public
|
||||
constructor Create(const AStream: TStream); overload;
|
||||
constructor Create(const AFileName: String); overload;
|
||||
|
||||
procedure Save(); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils,
|
||||
Variants;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2BaseConfigSource
|
||||
========================================}
|
||||
constructor TX2BaseConfigSource.Create();
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FConfigItems := TX2ConfigHash.Create(True);
|
||||
FDefinitions := TX2ConfigDefinitionHash.Create(True);
|
||||
LoadConfigs();
|
||||
end;
|
||||
|
||||
destructor TX2BaseConfigSource.Destroy();
|
||||
begin
|
||||
FreeAndNil(FDefinitions);
|
||||
FreeAndNil(FConfigItems);
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfigSource.GetConfig(const AName: String;
|
||||
const AAllowCreate: Boolean): TX2BaseConfig;
|
||||
begin
|
||||
Result := ConfigItems[AName];
|
||||
if Assigned(Result) then
|
||||
begin
|
||||
if Result.State = csDelete then
|
||||
if AAllowCreate then
|
||||
Result.State := csClean
|
||||
else
|
||||
Result := nil;
|
||||
end else if AAllowCreate then
|
||||
begin
|
||||
Result := CreateConfig(AName);
|
||||
ConfigItems[AName] := Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfigSource.GetAutoSave(): Boolean;
|
||||
begin
|
||||
Result := FAutoSave;
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.SetAutoSave(Value: Boolean);
|
||||
begin
|
||||
FAutoSave := Value;
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Reload();
|
||||
begin
|
||||
ConfigItems.Clear();
|
||||
LoadConfigs();
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.Configs(const AName: String): IX2Config;
|
||||
begin
|
||||
Result := (GetConfig(AName) as IX2Config);
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.Exists(const AName: String): Boolean;
|
||||
var
|
||||
pConfig: TX2BaseConfig;
|
||||
|
||||
begin
|
||||
pConfig := ConfigItems[AName];
|
||||
Result := Assigned(pConfig) and (pConfig.State <> csDelete);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Delete(const AName: String);
|
||||
var
|
||||
pConfig: TX2BaseConfig;
|
||||
|
||||
begin
|
||||
pConfig := ConfigItems[AName];
|
||||
if Assigned(pConfig) then
|
||||
pConfig.State := csDelete;
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Clear(const AAction: TX2ConfigClearAction);
|
||||
begin
|
||||
//! Clear
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Iterate(const ACallback: TX2ConfigIterateConfigs;
|
||||
const AData: Pointer);
|
||||
begin
|
||||
ConfigItems.First();
|
||||
while ConfigItems.Next() do
|
||||
ACallback(Self, ConfigItems.CurrentKey, AData);
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.Register(const AConfig,
|
||||
AName: String): IX2ConfigDefinition;
|
||||
begin
|
||||
Result := Register(AConfig, AName, Unassigned);
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.Register(const AConfig, AName: String;
|
||||
const ADefault: Variant): IX2ConfigDefinition;
|
||||
var
|
||||
sKey: String;
|
||||
pDefinition: TX2ConfigDefinition;
|
||||
|
||||
begin
|
||||
sKey := AConfig + #255 + AName;
|
||||
Result := FDefinitions[sKey];
|
||||
if not Assigned(Result) then
|
||||
begin
|
||||
pDefinition := TX2ConfigDefinition.Create(AConfig, AName, ADefault);
|
||||
FDefinitions[sKey] := pDefinition;
|
||||
Result := (pDefinition as IX2ConfigDefinition);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.Definitions(const AConfig,
|
||||
AName: String): IX2ConfigDefinition;
|
||||
var
|
||||
sKey: String;
|
||||
|
||||
begin
|
||||
sKey := AConfig + #255 + AName;
|
||||
Result := FDefinitions[sKey];
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2BaseConfig
|
||||
========================================}
|
||||
constructor TX2BaseConfig.Create(const AName: String;
|
||||
const ASource: TX2BaseConfigSource);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
FName := AName;
|
||||
FSource := ASource;
|
||||
FValues := TX2ConfigValueHash.Create();
|
||||
FState := csClean;
|
||||
end;
|
||||
|
||||
destructor TX2BaseConfig.Destroy();
|
||||
var
|
||||
pValue: PX2ConfigValue;
|
||||
|
||||
begin
|
||||
Values.First();
|
||||
while Values.Next() do
|
||||
begin
|
||||
pValue := Values.CurrentValue;
|
||||
Finalize(pValue^);
|
||||
FreeMem(pValue, SizeOf(TX2ConfigValue));
|
||||
end;
|
||||
|
||||
FreeAndNil(FValues);
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfig.QueryInterface(const IID: TGUID; out Obj): HResult;
|
||||
begin
|
||||
if GetInterface(IID, Obj) then
|
||||
Result := 0
|
||||
else
|
||||
Result := E_NOINTERFACE;
|
||||
end;
|
||||
|
||||
function TX2BaseConfig._AddRef(): Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TX2BaseConfig._Release(): Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfig.InternalRead(const AName: String;
|
||||
const ADefault: Variant;
|
||||
const AUseDefinition: Boolean): Variant;
|
||||
var
|
||||
ifDefinition: IX2ConfigDefinition;
|
||||
pValue: PX2ConfigValue;
|
||||
|
||||
begin
|
||||
Result := Unassigned;
|
||||
ifDefinition := Source.Definitions(FName, AName);
|
||||
pValue := Values[AName];
|
||||
if Assigned(pValue) and (pValue^.State <> csDelete) then
|
||||
Result := pValue^.Value
|
||||
else
|
||||
if AUseDefinition and (Assigned(ifDefinition)) then
|
||||
Result := ifDefinition.Default
|
||||
else
|
||||
Result := ADefault;
|
||||
|
||||
// Observers
|
||||
if Assigned(ifDefinition) then
|
||||
ifDefinition.Read(Result);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.InternalWrite(const AName: String;
|
||||
const AValue: Variant;
|
||||
const AUpdateState: Boolean);
|
||||
var
|
||||
bSave: Boolean;
|
||||
ifDefinition: IX2ConfigDefinition;
|
||||
pValue: PX2ConfigValue;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
// Observers
|
||||
vValue := AValue;
|
||||
ifDefinition := Source.Definitions(FName, AName);
|
||||
if Assigned(ifDefinition) then
|
||||
ifDefinition.Write(vValue);
|
||||
|
||||
bSave := False;
|
||||
pValue := Values[AName];
|
||||
if not Assigned(pValue) then
|
||||
begin
|
||||
GetMem(pValue, SizeOf(TX2ConfigValue));
|
||||
Initialize(pValue^);
|
||||
pValue^.Value := vValue;
|
||||
|
||||
if AUpdateState then
|
||||
pValue^.State := csCreate
|
||||
else
|
||||
pValue^.State := csClean;
|
||||
|
||||
Values[AName] := pValue;
|
||||
bSave := True;
|
||||
end else if AValue <> pValue^.Value then
|
||||
begin
|
||||
pValue^.Value := vValue;
|
||||
bSave := True;
|
||||
end;
|
||||
|
||||
if bSave then
|
||||
begin
|
||||
if AUpdateState then
|
||||
begin
|
||||
if FState <> csCreate then
|
||||
FState := csUpdate;
|
||||
|
||||
if pValue^.State <> csCreate then
|
||||
pValue^.State := csUpdate;
|
||||
end;
|
||||
|
||||
if Source.AutoSave then
|
||||
Source.Save();
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfig.GetName(): String;
|
||||
begin
|
||||
Result := FName;
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.GetSource(): IX2ConfigSource;
|
||||
begin
|
||||
Result := (FSource as IX2ConfigSource);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.Exists(const AName: String): Boolean;
|
||||
var
|
||||
pValue: PX2ConfigValue;
|
||||
|
||||
begin
|
||||
pValue := Values[AName];
|
||||
Result := Assigned(pValue) and (pValue.State <> csDelete);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.Read(const AName: String): Variant;
|
||||
begin
|
||||
Result := InternalRead(AName, Unassigned, True);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.Read(const AName: String;
|
||||
const ADefault: Variant): Variant;
|
||||
begin
|
||||
Result := InternalRead(AName, ADefault, False);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.Write(const AName: String; const AValue: Variant);
|
||||
begin
|
||||
InternalWrite(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.Clear(const AAction: TX2ConfigClearAction);
|
||||
begin
|
||||
//! Clear
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.Iterate(const ACallback: TX2ConfigIterateValues;
|
||||
const AData: Pointer);
|
||||
begin
|
||||
Values.First();
|
||||
while Values.Next() do
|
||||
ACallback(Self, Values.CurrentKey, AData);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.Delete(const AName: String);
|
||||
var
|
||||
pValue: PX2ConfigValue;
|
||||
|
||||
begin
|
||||
pValue := Values[AName];
|
||||
if Assigned(pValue) then
|
||||
if pValue^.State = csCreate then
|
||||
begin
|
||||
Finalize(pValue^);
|
||||
FreeMem(pValue, SizeOf(TX2ConfigValue));
|
||||
Values.Delete(AName);
|
||||
end else
|
||||
pValue^.State := csDelete;
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2ConfigHash
|
||||
========================================}
|
||||
function TX2ConfigHash.GetCurrentValue(): TX2BaseConfig;
|
||||
begin
|
||||
Result := TX2BaseConfig(inherited GetCurrentValue());
|
||||
end;
|
||||
|
||||
function TX2ConfigHash.GetValue(Key: String): TX2BaseConfig;
|
||||
begin
|
||||
Result := TX2BaseConfig(inherited GetValue(Key));
|
||||
end;
|
||||
|
||||
procedure TX2ConfigHash.SetValue(Key: String; const Value: TX2BaseConfig);
|
||||
begin
|
||||
inherited SetValue(Key, Value);
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2ConfigValueHash
|
||||
========================================}
|
||||
function TX2ConfigValueHash.GetCurrentValue(): PX2ConfigValue;
|
||||
begin
|
||||
Result := PX2ConfigValue(inherited GetCurrentValue());
|
||||
end;
|
||||
|
||||
function TX2ConfigValueHash.GetValue(Key: String): PX2ConfigValue;
|
||||
begin
|
||||
Result := PX2ConfigValue(inherited GetValue(Key));
|
||||
end;
|
||||
|
||||
procedure TX2ConfigValueHash.SetValue(Key: String; const Value: PX2ConfigValue);
|
||||
begin
|
||||
inherited SetValue(Key, Value);
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2ConfigDefinitionHash
|
||||
========================================}
|
||||
function TX2ConfigDefinitionHash.GetCurrentValue(): TX2ConfigDefinition;
|
||||
begin
|
||||
Result := TX2ConfigDefinition(inherited GetCurrentValue());
|
||||
end;
|
||||
|
||||
function TX2ConfigDefinitionHash.GetValue(Key: String): TX2ConfigDefinition;
|
||||
begin
|
||||
Result := TX2ConfigDefinition(inherited GetValue(Key));
|
||||
end;
|
||||
|
||||
procedure TX2ConfigDefinitionHash.SetValue(Key: String;
|
||||
const Value: TX2ConfigDefinition);
|
||||
begin
|
||||
inherited SetValue(Key, Value);
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2StreamConfigSource
|
||||
========================================}
|
||||
constructor TX2StreamConfigSource.Create(const AFileName: String);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
FFileName := AFileName;
|
||||
LoadFromFile(AFileName);
|
||||
end;
|
||||
|
||||
constructor TX2StreamConfigSource.Create(const AStream: TStream);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
FFileName := '';
|
||||
LoadFromStream(AStream);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2StreamConfigSource.LoadConfigs();
|
||||
begin
|
||||
if Length(FFileName) > 0 then
|
||||
LoadFromFile(FFileName);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2StreamConfigSource.LoadFromFile(const AFileName: String);
|
||||
var
|
||||
fsData: TFileStream;
|
||||
|
||||
begin
|
||||
fsData := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
LoadFromStream(fsData);
|
||||
finally
|
||||
FreeAndNil(fsData);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TX2StreamConfigSource.Save();
|
||||
var
|
||||
fsData: TFileStream;
|
||||
|
||||
begin
|
||||
if Length(FFileName) > 0 then
|
||||
begin
|
||||
fsData := TFileStream.Create(FFileName, fmCreate or fmShareExclusive);
|
||||
try
|
||||
Save(fsData);
|
||||
finally
|
||||
FreeAndNil(fsData);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2ConfigDefinition
|
||||
========================================}
|
||||
constructor TX2ConfigDefinition.Create(const AConfig, AName: String;
|
||||
const ADefault: Variant);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
FConfig := AConfig;
|
||||
FName := AName;
|
||||
FDefault := ADefault;
|
||||
end;
|
||||
|
||||
destructor TX2ConfigDefinition.Destroy();
|
||||
begin
|
||||
FreeAndNil(FObservers);
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TX2ConfigDefinition.QueryInterface(const IID: TGUID;
|
||||
out Obj): HResult;
|
||||
begin
|
||||
if GetInterface(IID, Obj) then
|
||||
Result := 0
|
||||
else
|
||||
Result := E_NOINTERFACE;
|
||||
end;
|
||||
|
||||
function TX2ConfigDefinition._AddRef(): Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TX2ConfigDefinition._Release(): Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2ConfigDefinition.Attach(const AObserver: IX2ConfigDefinitionObserver);
|
||||
begin
|
||||
if not Assigned(FObservers) then
|
||||
FObservers := TInterfaceList.Create();
|
||||
|
||||
FObservers.Add(AObserver);
|
||||
end;
|
||||
|
||||
procedure TX2ConfigDefinition.Detach(const AObserver: IX2ConfigDefinitionObserver);
|
||||
begin
|
||||
if Assigned(FObservers) then
|
||||
FObservers.Remove(AObserver);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2ConfigDefinition.Read(var AValue: Variant);
|
||||
var
|
||||
iObserver: Integer;
|
||||
|
||||
begin
|
||||
if Assigned(FObservers) then
|
||||
for iObserver := 0 to Pred(FObservers.Count) do
|
||||
(FObservers[iObserver] as IX2ConfigDefinitionObserver).Read(FConfig, FName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2ConfigDefinition.Write(var AValue: Variant);
|
||||
var
|
||||
iObserver: Integer;
|
||||
|
||||
begin
|
||||
if Assigned(FObservers) then
|
||||
for iObserver := 0 to Pred(FObservers.Count) do
|
||||
(FObservers[iObserver] as IX2ConfigDefinitionObserver).Write(FConfig, FName, AValue);
|
||||
end;
|
||||
|
||||
|
||||
function TX2ConfigDefinition.GetDefault(): Variant;
|
||||
begin
|
||||
Result := FDefault;
|
||||
end;
|
||||
|
||||
function TX2ConfigDefinition.GetConfig(): String;
|
||||
begin
|
||||
Result := FConfig;
|
||||
end;
|
||||
|
||||
function TX2ConfigDefinition.GetName(): String;
|
||||
begin
|
||||
Result := FName;
|
||||
end;
|
||||
|
||||
procedure TX2ConfigDefinition.SetDefault(Value: Variant);
|
||||
begin
|
||||
FDefault := Value;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -9,39 +9,99 @@ unit X2UtConfigIni;
|
||||
|
||||
interface
|
||||
uses
|
||||
X2UtConfig;
|
||||
Classes,
|
||||
|
||||
X2UtConfig,
|
||||
X2UtConfigBase;
|
||||
|
||||
type
|
||||
TX2IniConfigSource = class(TX2StreamConfigSource)
|
||||
protected
|
||||
function CreateConfig(const AName: String): TX2BaseConfig; override;
|
||||
procedure LoadFromStream(const AStream: TStream); override;
|
||||
|
||||
procedure IniSection(Sender: TObject; Section: String);
|
||||
procedure IniValue(Sender: TObject; Name, Value: String);
|
||||
procedure SaveValue(Sender: IX2Config; const Name: String;
|
||||
const Data: Pointer);
|
||||
public
|
||||
constructor Create(const AStream: TStream); override;
|
||||
procedure Save(const AStream: TStream); override;
|
||||
end;
|
||||
|
||||
TX2IniConfig = class(TX2BaseConfig)
|
||||
protected
|
||||
procedure IniValue(Sender: TObject; Name, Value: String);
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
Variants,
|
||||
|
||||
X2UtIniParser;
|
||||
|
||||
{===================== TX2IniConfigSource
|
||||
Initialization
|
||||
========================================}
|
||||
constructor TX2IniConfigSource.Create(const AStream: TStream);
|
||||
begin
|
||||
|
||||
{========================================
|
||||
TX2IniConfigSource
|
||||
========================================}
|
||||
function TX2IniConfigSource.CreateConfig(const AName: String): TX2BaseConfig;
|
||||
begin
|
||||
Result := TX2IniConfig.Create(AName, Self);
|
||||
end;
|
||||
|
||||
procedure TX2IniConfigSource.LoadFromStream(const AStream: TStream);
|
||||
begin
|
||||
with TX2IniParser.Create() do
|
||||
try
|
||||
OnSection := IniSection;
|
||||
Execute(AStream);
|
||||
finally
|
||||
Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TX2IniConfigSource.Save(const AStream: TStream);
|
||||
procedure WriteLine(const ALine: String);
|
||||
var
|
||||
sLine: String;
|
||||
|
||||
begin
|
||||
sLine := ALine + #13#10;
|
||||
AStream.WriteBuffer(PChar(sLine)^, Length(sLine));
|
||||
end;
|
||||
|
||||
begin
|
||||
ConfigItems.First();
|
||||
while ConfigItems.Next() do
|
||||
begin
|
||||
WriteLine('[' + ConfigItems.CurrentValue.Name + ']');
|
||||
ConfigItems.CurrentValue.Iterate(SaveValue, Pointer(AStream));
|
||||
WriteLine('');
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2IniConfigSource.IniSection(Sender: TObject; Section: String);
|
||||
begin
|
||||
//
|
||||
(Sender as TX2IniParser).OnValue := (GetConfig(Section) as TX2IniConfig).IniValue;
|
||||
end;
|
||||
|
||||
procedure TX2IniConfigSource.IniValue(Sender: TObject; Name, Value: String);
|
||||
|
||||
{========================================
|
||||
TX2IniConfig
|
||||
========================================}
|
||||
procedure TX2IniConfig.IniValue(Sender: TObject; Name, Value: String);
|
||||
begin
|
||||
//
|
||||
InternalWrite(Name, Value, False);
|
||||
end;
|
||||
|
||||
procedure TX2IniConfigSource.SaveValue(Sender: IX2Config;
|
||||
const Name: String;
|
||||
const Data: Pointer);
|
||||
var
|
||||
sLine: String;
|
||||
|
||||
begin
|
||||
sLine := Name + '=' + VarAsType(Sender.Read(Name), varString) + #13#10;
|
||||
TStream(Data).WriteBuffer(PChar(sLine)^, Length(sLine));
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
152
X2UtConfigRanges.pas
Normal file
152
X2UtConfigRanges.pas
Normal file
@ -0,0 +1,152 @@
|
||||
{
|
||||
:: X2UtConfigRanges provides various definition observers to ensure
|
||||
:: a value is within the specified range. To enforce a range on a defined
|
||||
:: value, call:
|
||||
::
|
||||
:: IX2ConfigSource.Register(...).Attach(<RangeClass>.Create(...))
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
}
|
||||
unit X2UtConfigRanges;
|
||||
|
||||
interface
|
||||
uses
|
||||
X2UtConfig;
|
||||
|
||||
type
|
||||
TX2BaseConfigRange = class(TInterfacedObject, IX2ConfigDefinitionObserver)
|
||||
protected
|
||||
// IX2ConfigDefinitionObserver
|
||||
procedure Read(const AConfig, AName: String; var AValue: Variant); virtual;
|
||||
procedure Write(const AConfig, AName: String; var AValue: Variant); virtual;
|
||||
|
||||
procedure CheckRange(var AValue: Variant); virtual; abstract;
|
||||
end;
|
||||
|
||||
TX2ConfigStringPosition = (spLeft, spRight);
|
||||
TX2ConfigStringLengthRange = class(TX2BaseConfigRange)
|
||||
private
|
||||
FCutOffPosition: TX2ConfigStringPosition;
|
||||
FFillChar: Char;
|
||||
FFillPosition: TX2ConfigStringPosition;
|
||||
FMinLength: Integer;
|
||||
FMaxLength: Integer;
|
||||
protected
|
||||
procedure CheckRange(var AValue: Variant);
|
||||
public
|
||||
constructor Create(const AMinLength: Integer = 0;
|
||||
const AMaxLength: Integer = 0;
|
||||
const AFillChar: Char = #20;
|
||||
const AFillPosition: TX2ConfigStringPosition = spRight;
|
||||
const ACutOffPosition: TX2ConfigStringPosition = spRight);
|
||||
end;
|
||||
|
||||
TX2ConfigIntegerRange = class(TX2BaseConfigRange)
|
||||
private
|
||||
FDefault: Integer;
|
||||
FMax: Integer;
|
||||
FMin: Integer;
|
||||
protected
|
||||
procedure CheckRange(var AValue: Variant);
|
||||
public
|
||||
constructor Create(const AMin: Integer = Low(Integer);
|
||||
const AMax: Integer = High(Integer);
|
||||
const ADefault: Integer = 0);
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
Variants,
|
||||
|
||||
X2UtMisc;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2BaseConfigRange
|
||||
========================================}
|
||||
procedure TX2BaseConfigRange.Read(const AConfig, AName: String;
|
||||
var AValue: Variant);
|
||||
begin
|
||||
CheckRange(AValue);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigRange.Write(const AConfig, AName: String;
|
||||
var AValue: Variant);
|
||||
begin
|
||||
CheckRange(AValue);
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2ConfigStringRange
|
||||
========================================}
|
||||
constructor TX2ConfigStringLengthRange.Create(const AMinLength,
|
||||
AMaxLength: Integer;
|
||||
const AFillChar: Char;
|
||||
const AFillPosition: TX2ConfigStringPosition;
|
||||
const ACutOffPosition: TX2ConfigStringPosition);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
Assert((AMaxLength = 0) or
|
||||
(AMaxLength >= AMinLength),
|
||||
'MaxLength must be 0, equal to or larger than MinLength!');
|
||||
|
||||
FMinLength := AMinLength;
|
||||
FMaxLength := AMaxLength;
|
||||
FFillChar := AFillChar;
|
||||
FFillPosition := AFillPosition;
|
||||
FCutOffPosition := ACutOffPosition;
|
||||
end;
|
||||
|
||||
procedure TX2ConfigStringLengthRange.CheckRange(var AValue: Variant);
|
||||
var
|
||||
sFill: String;
|
||||
sValue: String;
|
||||
|
||||
begin
|
||||
if VarIsType(AValue, varString) then
|
||||
begin
|
||||
sValue := AValue;
|
||||
if Length(sValue) < FMinLength then
|
||||
begin
|
||||
sFill := StringOfChar(FFillChar, FMinLength - Length(sValue));
|
||||
|
||||
case FFillPosition of
|
||||
spLeft: sValue := sFill + sValue;
|
||||
spRight: sValue := sValue + sFill;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (FMaxLength > 0) and (Length(sValue) > FMaxLength) then
|
||||
case FCutOffPosition of
|
||||
spLeft: Delete(sValue, 1, Length(sValue) - FMaxLength);
|
||||
spRight: SetLength(sValue, FMaxLength);
|
||||
end;
|
||||
|
||||
AValue := sValue;
|
||||
end else
|
||||
AValue := StringOfChar(FFillChar, FMinLength);
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2ConfigIntegerRange
|
||||
========================================}
|
||||
constructor TX2ConfigIntegerRange.Create(const AMin, AMax, ADefault: Integer);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
FMin := AMin;
|
||||
FMax := AMax;
|
||||
FDefault := ADefault;
|
||||
end;
|
||||
|
||||
procedure TX2ConfigIntegerRange.CheckRange(var AValue: Variant);
|
||||
begin
|
||||
AValue := InRange(AValue, FMin, FMax, FDefault);
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -43,7 +43,11 @@ begin
|
||||
with Columns[SortColumn] do
|
||||
if Tag <> 0 then
|
||||
begin
|
||||
Color := TColor(Tag);
|
||||
if Tag = clNone then
|
||||
Options := Options + [coParentColor]
|
||||
else
|
||||
Color := Tag;
|
||||
|
||||
Tag := 0;
|
||||
end;
|
||||
|
||||
@ -58,7 +62,11 @@ begin
|
||||
if ASortColor <> clNone then
|
||||
with Columns[SortColumn] do
|
||||
begin
|
||||
Tag := Color;
|
||||
if coParentColor in Options then
|
||||
Tag := clNone
|
||||
else
|
||||
Tag := Color;
|
||||
|
||||
Color := ASortColor;
|
||||
end;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user