From f5535247faa06f57e8264a949e5e847c3851ff59 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Tue, 18 Oct 2005 09:25:05 +0000 Subject: [PATCH] Fixed: VirtualTree columns revert to ParentColor properly in SortColumn Changed: X2UtConfig implementation --- UnitTests/Units/SettingsTest.pas | 155 +++++++ UnitTests/X2UtUnitTests.cfg | 1 + UnitTests/X2UtUnitTests.dof | 2 +- X2UtConfig.pas | 502 +++----------------- X2UtConfigBase.pas | 763 +++++++++++++++++++++++++++++++ X2UtConfigIni.pas | 82 +++- X2UtConfigRanges.pas | 152 ++++++ X2UtVirtualTree.pas | 12 +- 8 files changed, 1228 insertions(+), 441 deletions(-) create mode 100644 X2UtConfigBase.pas create mode 100644 X2UtConfigRanges.pas diff --git a/UnitTests/Units/SettingsTest.pas b/UnitTests/Units/SettingsTest.pas index fba8a6c..3a33383 100644 --- a/UnitTests/Units/SettingsTest.pas +++ b/UnitTests/Units/SettingsTest.pas @@ -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. diff --git a/UnitTests/X2UtUnitTests.cfg b/UnitTests/X2UtUnitTests.cfg index 44403d1..4d9f9e5 100644 --- a/UnitTests/X2UtUnitTests.cfg +++ b/UnitTests/X2UtUnitTests.cfg @@ -25,6 +25,7 @@ -$YD -$Z1 -cg +-vn -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -H+ -W+ diff --git a/UnitTests/X2UtUnitTests.dof b/UnitTests/X2UtUnitTests.dof index cdafc69..db9f998 100644 --- a/UnitTests/X2UtUnitTests.dof +++ b/UnitTests/X2UtUnitTests.dof @@ -83,7 +83,7 @@ UnsafeCast=0 MapFile=0 OutputObjs=0 ConsoleApp=1 -DebugInfo=0 +DebugInfo=1 RemoteSymbols=0 MinStackSize=16384 MaxStackSize=1048576 diff --git a/X2UtConfig.pas b/X2UtConfig.pas index 22d2346..5d9270a 100644 --- a/X2UtConfig.pas +++ b/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. diff --git a/X2UtConfigBase.pas b/X2UtConfigBase.pas new file mode 100644 index 0000000..a4b8279 --- /dev/null +++ b/X2UtConfigBase.pas @@ -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. diff --git a/X2UtConfigIni.pas b/X2UtConfigIni.pas index 969f78a..e532472 100644 --- a/X2UtConfigIni.pas +++ b/X2UtConfigIni.pas @@ -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 + +{======================================== + TX2IniConfigSource ========================================} -constructor TX2IniConfigSource.Create(const AStream: TStream); +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. - \ No newline at end of file diff --git a/X2UtConfigRanges.pas b/X2UtConfigRanges.pas new file mode 100644 index 0000000..3ba5599 --- /dev/null +++ b/X2UtConfigRanges.pas @@ -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(.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. diff --git a/X2UtVirtualTree.pas b/X2UtVirtualTree.pas index d42b451..5a43e62 100644 --- a/X2UtVirtualTree.pas +++ b/X2UtVirtualTree.pas @@ -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;