diff --git a/Test/X2UtilsSettingsTest.dof b/Test/X2UtilsSettingsTest.dof index d5ef746..0b28a25 100644 --- a/Test/X2UtilsSettingsTest.dof +++ b/Test/X2UtilsSettingsTest.dof @@ -66,7 +66,7 @@ AutoIncBuild=1 MajorVer=1 MinorVer=0 Release=0 -Build=1 +Build=2 Debug=0 PreRelease=0 Special=0 @@ -77,7 +77,7 @@ CodePage=1252 [Version Info Keys] CompanyName= FileDescription= -FileVersion=1.0.0.1 +FileVersion=1.0.0.2 InternalName= LegalCopyright= LegalTrademarks= diff --git a/Test/X2UtilsSettingsTest.dpr b/Test/X2UtilsSettingsTest.dpr index 185b191..c8c967e 100644 --- a/Test/X2UtilsSettingsTest.dpr +++ b/Test/X2UtilsSettingsTest.dpr @@ -5,6 +5,7 @@ program X2UtilsSettingsTest; uses Classes, SysUtils, + Variants, Windows, X2UtApp in '..\X2UtApp.pas', X2UtSettings in '..\X2UtSettings.pas', @@ -70,7 +71,7 @@ var begin // INI settings - WriteLn('INI data:'); + //WriteLn('INI data:'); Settings := TX2INISettingsFactory.Create(); try with TX2INISettingsFactory(Settings) do @@ -97,11 +98,20 @@ begin } // Test for the definitions - Settings.Define('Test', 'Value', 5, [[0, 5], [10, 15]]); - Settings.ReadInteger('Test', 'Value'); + Settings.Define('Test', 'Value', 5, [0, 5, 10, 15]); + with Settings['Test'] do + try + WriteInteger('Value', 6); + WriteLn(ReadInteger('Value')); + finally + Free(); + end; + + { TraverseSection(Settings, '', 1); WriteLn; + } finally FreeAndNil(Settings); end; diff --git a/X2UtBinaryTree.pas b/X2UtBinaryTree.pas index 6595eb2..0e6e363 100644 --- a/X2UtBinaryTree.pas +++ b/X2UtBinaryTree.pas @@ -25,16 +25,16 @@ uses type //:$ Raised when the cursor is invalid. //:: Call Reset on the binary tree to create a valid cursor. - EX2UtBTreeInvalidCursor = class(Exception); + EX2BTreeInvalidCursor = class(Exception); { :$ Internal representation of a node. } - PPX2UtBTreeNode = ^PX2UtBTreeNode; - PX2UtBTreeNode = ^TX2UtBTreeNode; - TX2UtBTreeNode = record + PPX2BTreeNode = ^PX2BTreeNode; + PX2BTreeNode = ^TX2BTreeNode; + TX2BTreeNode = record Index: Cardinal; - Children: array[0..1] of PX2UtBTreeNode; + Children: array[0..1] of PX2BTreeNode; Balance: Integer; Data: record end; end; @@ -42,34 +42,34 @@ type { :$ Internal node stack } - TX2UtBTreeStackItem = record - Node: PX2UtBTreeNode; + TX2BTreeStackItem = record + Node: PX2BTreeNode; Direction: Integer; end; - TX2UtBTreeStack = class(TObject) + TX2BTreeStack = class(TObject) private - FItems: array of TX2UtBTreeStackItem; + FItems: array of TX2BTreeStackItem; FCount: Integer; FPosition: Integer; function GetCount(): Integer; - function GetNode(Index: Integer): PX2UtBTreeNode; + function GetNode(Index: Integer): PX2BTreeNode; function GetDirection(Index: Integer): Integer; procedure SetDirection(Index: Integer; const Value: Integer); - procedure SetNode(Index: Integer; const Value: PX2UtBTreeNode); + procedure SetNode(Index: Integer; const Value: PX2BTreeNode); public constructor Create(); procedure Clear(); - procedure Push(const ANode: PX2UtBTreeNode; const ADirection: Integer = 0); - function Pop(): PX2UtBTreeNode; overload; - function Pop(var ADirection: Integer): PX2UtBTreeNode; overload; + procedure Push(const ANode: PX2BTreeNode; const ADirection: Integer = 0); + function Pop(): PX2BTreeNode; overload; + function Pop(var ADirection: Integer): PX2BTreeNode; overload; - property Node[Index: Integer]: PX2UtBTreeNode read GetNode - write SetNode; default; - property Direction[Index: Integer]: Integer read GetDirection - write SetDirection; + property Node[Index: Integer]: PX2BTreeNode read GetNode + write SetNode; default; + property Direction[Index: Integer]: Integer read GetDirection + write SetDirection; property Count: Integer read GetCount; end; @@ -80,13 +80,13 @@ type :: This class implements a binary tree without knowing anything about :: the data it contains. } - TX2UtCustomBTree = class(TObject) + TX2CustomBTree = class(TObject) private FCount: Integer; - FRoot: PX2UtBTreeNode; - FCursor: PX2UtBTreeNode; + FRoot: PX2BTreeNode; + FCursor: PX2BTreeNode; FIsReset: Boolean; - FParents: TX2UtBTreeStack; + FParents: TX2BTreeStack; FNodeSize: Cardinal; FDataSize: Cardinal; @@ -94,51 +94,51 @@ type function GetTotalSize(): Cardinal; protected function GetCurrentIndex(): Cardinal; - function GetNodeData(const ANode: PX2UtBTreeNode): Pointer; virtual; - procedure CopyNodeData(const ASource, ADest: PX2UtBTreeNode); + function GetNodeData(const ANode: PX2BTreeNode): Pointer; virtual; + procedure CopyNodeData(const ASource, ADest: PX2BTreeNode); - procedure BalanceInsert(var ANode: PX2UtBTreeNode); + procedure BalanceInsert(var ANode: PX2BTreeNode); function LookupNode(const AIndex: Cardinal; const ACanCreate: Boolean = False; - const ASetCursor: Boolean = False): PX2UtBTreeNode; + const ASetCursor: Boolean = False): PX2BTreeNode; - procedure RotateLeft(var ANode: PX2UtBTreeNode); - procedure RotateRight(var ANode: PX2UtBTreeNode); + procedure RotateLeft(var ANode: PX2BTreeNode); + procedure RotateRight(var ANode: PX2BTreeNode); - function DeleteLeftShrunk(var ANode: PX2UtBTreeNode): Integer; - function DeleteRightShrunk(var ANode: PX2UtBTreeNode): Integer; - function DeleteFindHighest(const ATarget: PX2UtBTreeNode; - var ANode: PX2UtBTreeNode; + function DeleteLeftShrunk(var ANode: PX2BTreeNode): Integer; + function DeleteRightShrunk(var ANode: PX2BTreeNode): Integer; + function DeleteFindHighest(const ATarget: PX2BTreeNode; + var ANode: PX2BTreeNode; out AResult: Integer): Boolean; - function DeleteFindLowest(const ATarget: PX2UtBTreeNode; - var ANode: PX2UtBTreeNode; + function DeleteFindLowest(const ATarget: PX2BTreeNode; + var ANode: PX2BTreeNode; out AResult: Integer): Boolean; - function InternalDeleteNode(var ARoot: PX2UtBTreeNode; + function InternalDeleteNode(var ARoot: PX2BTreeNode; const AIndex: Cardinal): Integer; procedure DeleteNode(const AIndex: Cardinal); - procedure InitNode(var ANode: PX2UtBTreeNode); virtual; - procedure FreeNode(var ANode: PX2UtBTreeNode); virtual; + procedure InitNode(var ANode: PX2BTreeNode); virtual; + procedure FreeNode(var ANode: PX2BTreeNode); virtual; procedure ClearCursor(); virtual; function ValidCursor(const ARaiseError: Boolean = True): Boolean; virtual; - property Cursor: PX2UtBTreeNode read FCursor write FCursor; - property Root: PX2UtBTreeNode read FRoot; - property IsReset: Boolean read FIsReset write FIsReset; - property Parents: TX2UtBTreeStack read FParents; + property Cursor: PX2BTreeNode read FCursor write FCursor; + property Root: PX2BTreeNode read FRoot; + property IsReset: Boolean read FIsReset write FIsReset; + property Parents: TX2BTreeStack read FParents; - property NodeSize: Cardinal read FNodeSize; - property TotalSize: Cardinal read GetTotalSize; + property NodeSize: Cardinal read FNodeSize; + property TotalSize: Cardinal read GetTotalSize; // Note: do NOT change DataSize after the first node has // been created! This will result in an Access Violation! - property DataSize: Cardinal read FDataSize write FDataSize; + property DataSize: Cardinal read FDataSize write FDataSize; //:$ Returns the index at the current cursor location. - property CurrentIndex: Cardinal read GetCurrentIndex; + property CurrentIndex: Cardinal read GetCurrentIndex; public constructor Create(); virtual; destructor Destroy(); override; @@ -175,7 +175,7 @@ type { :$ Binary tree implementation for pointer values } - TX2UtBTree = class(TX2UtCustomBTree) + TX2BTree = class(TX2CustomBTree) private function GetItem(Index: Cardinal): Pointer; procedure SetItem(Index: Cardinal; const Value: Pointer); @@ -196,7 +196,7 @@ type { :$ Binary tree implementation for integer values } - TX2UtIntegerBTree = class(TX2UtBTree) + TX2IntegerBTree = class(TX2BTree) protected function GetItem(Index: Cardinal): Integer; procedure SetItem(Index: Cardinal; const Value: Integer); @@ -214,15 +214,15 @@ type { :$ Binary tree implementation for string values } - TX2UtStringBTree = class(TX2UtCustomBTree) + TX2StringBTree = class(TX2CustomBTree) protected function GetItem(Index: Cardinal): String; procedure SetItem(Index: Cardinal; const Value: String); function GetCurrentValue(): String; protected - procedure InitNode(var ANode: PX2UtBTreeNode); override; - procedure FreeNode(var ANode: PX2UtBTreeNode); override; + procedure InitNode(var ANode: PX2BTreeNode); override; + procedure FreeNode(var ANode: PX2BTreeNode); override; public constructor Create(); override; property CurrentIndex; @@ -235,6 +235,35 @@ type property CurrentValue: String read GetCurrentValue; end; + { + :$ Binary tree implementation for object values + } + TX2ObjectBTree = class(TX2BTree) + private + FOwnsObjects: Boolean; + protected + function GetItem(Index: Cardinal): TObject; + procedure SetItem(Index: Cardinal; const Value: TObject); + + function GetCurrentValue(): TObject; + protected + procedure FreeNode(var ANode: PX2BTreeNode); override; + public + constructor Create(); overload; override; + constructor Create(AOwnsObjects: Boolean); reintroduce; overload; + + //:$ Gets or sets an item. + property Items[Index: Cardinal]: TObject read GetItem + write SetItem; default; + + //:$ Returns the value at the current cursor location + property CurrentValue: TObject read GetCurrentValue; + + //:$ Determines if objects are destroyed when they are removed + property OwnsObjects: Boolean read FOwnsObjects + write FOwnsObjects; + end; + resourcestring RSInvalidCursor = 'Cursor is invalid!'; RSInvalidDataSize = 'Invalid data size!'; @@ -254,10 +283,10 @@ const CBalance = 2; -{======================== TX2UtBTreeStack +{========================== TX2BTreeStack Item Management ========================================} -constructor TX2UtBTreeStack.Create; +constructor TX2BTreeStack.Create; begin inherited; @@ -267,14 +296,14 @@ begin end; -procedure TX2UtBTreeStack.Clear; +procedure TX2BTreeStack.Clear; begin FCount := CStackSize; FPosition := -1; SetLength(FItems, FCount); end; -procedure TX2UtBTreeStack.Push; +procedure TX2BTreeStack.Push; begin Inc(FPosition); if FPosition >= FCount then @@ -290,7 +319,7 @@ begin end; end; -function TX2UtBTreeStack.Pop(): PX2UtBTreeNode; +function TX2BTreeStack.Pop(): PX2BTreeNode; begin Result := nil; if FPosition >= 0 then @@ -300,7 +329,7 @@ begin end; end; -function TX2UtBTreeStack.Pop(var ADirection: Integer): PX2UtBTreeNode; +function TX2BTreeStack.Pop(var ADirection: Integer): PX2BTreeNode; begin Result := nil; if FPosition >= 0 then @@ -311,49 +340,49 @@ begin end; end; -function TX2UtBTreeStack.GetNode; +function TX2BTreeStack.GetNode; begin Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!'); Result := FItems[Index].Node; end; -procedure TX2UtBTreeStack.SetNode; +procedure TX2BTreeStack.SetNode; begin Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!'); FItems[Index].Node := Value; end; -function TX2UtBTreeStack.GetDirection; +function TX2BTreeStack.GetDirection; begin Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!'); Result := FItems[Index].Direction; end; -procedure TX2UtBTreeStack.SetDirection; +procedure TX2BTreeStack.SetDirection; begin Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!'); FItems[Index].Direction := Value; end; -function TX2UtBTreeStack.GetCount; +function TX2BTreeStack.GetCount; begin Result := FPosition + 1; end; -{======================= TX2UtCustomBTree +{======================= TX2CustomBTree Initialization ========================================} -constructor TX2UtCustomBTree.Create; +constructor TX2CustomBTree.Create; begin inherited; - FParents := TX2UtBTreeStack.Create(); - FNodeSize := SizeOf(TX2UtBTreeNode); + FParents := TX2BTreeStack.Create(); + FNodeSize := SizeOf(TX2BTreeNode); end; -destructor TX2UtCustomBTree.Destroy; +destructor TX2CustomBTree.Destroy; begin FreeAndNil(FParents); Clear(); @@ -362,16 +391,16 @@ begin end; -{======================= TX2UtCustomBTree +{========================= TX2CustomBTree Tree Management ========================================} -function TX2UtCustomBTree.GetNodeData; +function TX2CustomBTree.GetNodeData; begin Assert(DataSize > 0, RSInvalidDataSize); Result := Pointer(Cardinal(ANode) + NodeSize); end; -procedure TX2UtCustomBTree.CopyNodeData; +procedure TX2CustomBTree.CopyNodeData; begin ADest^.Index := ASource^.Index; Move(GetNodeData(ASource)^, @@ -380,10 +409,10 @@ begin end; -procedure TX2UtCustomBTree.BalanceInsert; +procedure TX2CustomBTree.BalanceInsert; var - pNode: PX2UtBTreeNode; - pSwap: PX2UtBTreeNode; + pNode: PX2BTreeNode; + pSwap: PX2BTreeNode; begin if ANode^.Balance = -2 then @@ -472,13 +501,13 @@ begin end; -function TX2UtCustomBTree.LookupNode; +function TX2CustomBTree.LookupNode; var - pCurrent: PPX2UtBTreeNode; - pBalance: PPX2UtBTreeNode; - pLast: PX2UtBTreeNode; - pNode: PX2UtBTreeNode; - pPath: TX2UtBTreeStack; + pCurrent: PPX2BTreeNode; + pBalance: PPX2BTreeNode; + pLast: PX2BTreeNode; + pNode: PX2BTreeNode; + pPath: TX2BTreeStack; begin Result := nil; @@ -486,7 +515,7 @@ begin if ASetCursor then Parents.Clear(); - pPath := TX2UtBTreeStack.Create(); + pPath := TX2BTreeStack.Create(); try pCurrent := @FRoot; pBalance := nil; @@ -547,9 +576,9 @@ begin end; -procedure TX2UtCustomBTree.RotateLeft; +procedure TX2CustomBTree.RotateLeft; var - pSwap: PX2UtBTreeNode; + pSwap: PX2BTreeNode; begin pSwap := ANode; @@ -558,9 +587,9 @@ begin ANode^.Children[CLeft] := pSwap; end; -procedure TX2UtCustomBTree.RotateRight; +procedure TX2CustomBTree.RotateRight; var - pSwap: PX2UtBTreeNode; + pSwap: PX2BTreeNode; begin pSwap := ANode; @@ -570,7 +599,7 @@ begin end; -function TX2UtCustomBTree.DeleteLeftShrunk; +function TX2CustomBTree.DeleteLeftShrunk; begin Result := CError; @@ -635,7 +664,7 @@ begin end; end; -function TX2UtCustomBTree.DeleteRightShrunk; +function TX2CustomBTree.DeleteRightShrunk; begin Result := CError; @@ -700,9 +729,9 @@ begin end; end; -function TX2UtCustomBTree.DeleteFindHighest; +function TX2CustomBTree.DeleteFindHighest; var - pSwap: PX2UtBTreeNode; + pSwap: PX2BTreeNode; begin AResult := CBalance; @@ -734,9 +763,9 @@ begin Result := True; end; -function TX2UtCustomBTree.DeleteFindLowest; +function TX2CustomBTree.DeleteFindLowest; var - pSwap: PX2UtBTreeNode; + pSwap: PX2BTreeNode; begin AResult := CBalance; @@ -769,7 +798,7 @@ begin end; -function TX2UtCustomBTree.InternalDeleteNode; +function TX2CustomBTree.InternalDeleteNode; var iResult: Integer; @@ -826,7 +855,7 @@ begin Result := CBalance; end; -procedure TX2UtCustomBTree.DeleteNode; +procedure TX2CustomBTree.DeleteNode; begin if not Assigned(FRoot) then exit; @@ -835,7 +864,7 @@ begin end; -procedure TX2UtCustomBTree.InitNode; +procedure TX2CustomBTree.InitNode; begin Assert(DataSize > 0, RSInvalidDataSize); GetMem(ANode, TotalSize); @@ -845,7 +874,7 @@ begin ClearCursor(); end; -procedure TX2UtCustomBTree.FreeNode; +procedure TX2CustomBTree.FreeNode; begin FreeMem(ANode, TotalSize); ANode := nil; @@ -855,8 +884,8 @@ begin end; -procedure TX2UtCustomBTree.Clear; - procedure ClearNode(var ANode: PX2UtBTreeNode); +procedure TX2CustomBTree.Clear; + procedure ClearNode(var ANode: PX2BTreeNode); begin if Assigned(ANode^.Children[CLeft]) then ClearNode(ANode^.Children[CLeft]); @@ -874,45 +903,45 @@ begin FRoot := nil; end; -procedure TX2UtCustomBTree.Delete; +procedure TX2CustomBTree.Delete; begin DeleteNode(AIndex); end; -function TX2UtCustomBTree.Exists; +function TX2CustomBTree.Exists; begin Result := Assigned(LookupNode(AIndex, False, True)); end; -{======================= TX2UtCustomBTree +{========================= TX2CustomBTree Tree Traversing ========================================} -function TX2UtCustomBTree.ValidCursor; +function TX2CustomBTree.ValidCursor; begin Result := (Assigned(Cursor) and (not IsReset)); if (not Result) and (ARaiseError) then - raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor); + raise EX2BTreeInvalidCursor.Create(RSInvalidCursor); end; -procedure TX2UtCustomBTree.ClearCursor; +procedure TX2CustomBTree.ClearCursor; begin Cursor := nil; end; -procedure TX2UtCustomBTree.Reset; +procedure TX2CustomBTree.Reset; begin Cursor := Root; IsReset := True; end; -function TX2UtCustomBTree.Next; +function TX2CustomBTree.Next; var - pParent: PX2UtBTreeNode; - pCurrent: PX2UtBTreeNode; + pParent: PX2BTreeNode; + pCurrent: PX2BTreeNode; begin Result := False; @@ -968,32 +997,32 @@ begin end; end; -function TX2UtCustomBTree.GetCurrentIndex; +function TX2CustomBTree.GetCurrentIndex; begin Result := 0; if ValidCursor(True) then Result := Cursor^.Index; end; -function TX2UtCustomBTree.GetTotalSize; +function TX2CustomBTree.GetTotalSize; begin Result := FNodeSize + FDataSize; end; -{============================= TX2UtBTree +{=============================== TX2BTree Item Management ========================================} -constructor TX2UtBTree.Create; +constructor TX2BTree.Create; begin inherited; DataSize := SizeOf(Pointer); end; -function TX2UtBTree.GetItem; +function TX2BTree.GetItem; var - pNode: PX2UtBTreeNode; + pNode: PX2BTreeNode; begin Result := nil; @@ -1002,9 +1031,9 @@ begin Result := PPointer(GetNodeData(pNode))^; end; -procedure TX2UtBTree.SetItem; +procedure TX2BTree.SetItem; var - pNode: PX2UtBTreeNode; + pNode: PX2BTreeNode; begin pNode := LookupNode(Index, True); @@ -1012,7 +1041,7 @@ begin PPointer(GetNodeData(pNode))^ := Value; end; -function TX2UtBTree.GetCurrentValue; +function TX2BTree.GetCurrentValue; begin Result := nil; if ValidCursor(True) then @@ -1020,29 +1049,29 @@ begin end; -{====================== TX2UtIntegerBTree +{======================== TX2IntegerBTree Item Management ========================================} -function TX2UtIntegerBTree.GetItem; +function TX2IntegerBTree.GetItem; begin Result := Integer(inherited GetItem(Index)); end; -procedure TX2UtIntegerBTree.SetItem; +procedure TX2IntegerBTree.SetItem; begin inherited SetItem(Index, Pointer(Value)); end; -function TX2UtIntegerBTree.GetCurrentValue; +function TX2IntegerBTree.GetCurrentValue; begin Result := Integer(inherited GetCurrentValue()); end; -{======================= TX2UtStringBTree +{========================= TX2StringBTree Item Management ========================================} -constructor TX2UtStringBTree.Create; +constructor TX2StringBTree.Create; begin inherited; @@ -1050,7 +1079,7 @@ begin end; -procedure TX2UtStringBTree.InitNode; +procedure TX2StringBTree.InitNode; var pData: PString; @@ -1061,7 +1090,7 @@ begin Initialize(pData^); end; -procedure TX2UtStringBTree.FreeNode; +procedure TX2StringBTree.FreeNode; var pData: PString; @@ -1073,9 +1102,9 @@ begin end; -function TX2UtStringBTree.GetItem; +function TX2StringBTree.GetItem; var - pNode: PX2UtBTreeNode; + pNode: PX2BTreeNode; begin pNode := LookupNode(Index); @@ -1083,9 +1112,9 @@ begin Result := PString(GetNodeData(pNode))^; end; -procedure TX2UtStringBTree.SetItem; +procedure TX2StringBTree.SetItem; var - pNode: PX2UtBTreeNode; + pNode: PX2BTreeNode; begin pNode := LookupNode(Index, True); @@ -1093,10 +1122,60 @@ begin PString(GetNodeData(pNode))^ := Value; end; -function TX2UtStringBTree.GetCurrentValue; +function TX2StringBTree.GetCurrentValue; begin if ValidCursor(True) then Result := PString(GetNodeData(Cursor))^; end; + +{========================= TX2ObjectBTree + Item Management +========================================} +constructor TX2ObjectBTree.Create; +begin + inherited; + + FOwnsObjects := False; +end; + +constructor TX2ObjectBTree.Create(AOwnsObjects: Boolean); +begin + inherited Create(); + + FOwnsObjects := AOwnsObjects; +end; + + +function TX2ObjectBTree.GetItem; +begin + Result := TObject(inherited GetItem(Index)); +end; + +procedure TX2ObjectBTree.SetItem; +begin + inherited SetItem(Index, Pointer(Value)); +end; + +function TX2ObjectBTree.GetCurrentValue; +begin + Result := TObject(inherited GetCurrentValue()); +end; + +procedure TX2ObjectBTree.FreeNode; +var + pObject: ^TObject; + +begin + if FOwnsObjects then + begin + pObject := GetNodeData(ANode); + + if Assigned(pObject) then + FreeAndNil(pObject^); + end; + + inherited; +end; + end. diff --git a/X2UtHashes.pas b/X2UtHashes.pas index e2f95d9..f9e7efb 100644 --- a/X2UtHashes.pas +++ b/X2UtHashes.pas @@ -20,10 +20,10 @@ type { :$ Internal representation of a hash item } - PX2UtHashItem = ^TX2UtHashItem; - TX2UtHashItem = record - Prev: PX2UtHashItem; - Next: PX2UtHashItem; + PX2HashItem = ^TX2HashItem; + TX2HashItem = record + Prev: PX2HashItem; + Next: PX2HashItem; Key: String; Data: record end; end; @@ -31,20 +31,20 @@ type { :$ Internal hash list } - PX2UtHashList = ^TX2UtHashList; - TX2UtHashList = record - Root: PX2UtHashItem; + PX2HashList = ^TX2HashList; + TX2HashList = record + Root: PX2HashItem; end; - + { :$ Hash implementation :: This class implements a hash without knowing anything about :: the data it contains. } - TX2UtCustomHash = class(TX2UtCustomBTree) + TX2CustomHash = class(TX2CustomBTree) private - FHashCursor: PX2UtHashItem; + FHashCursor: PX2HashItem; FHashDataSize: Cardinal; FHashItemSize: Cardinal; @@ -53,21 +53,21 @@ type protected function Hash(const AValue: String): Cardinal; virtual; - function GetItemData(const AItem: PX2UtHashItem): Pointer; virtual; + function GetItemData(const AItem: PX2HashItem): Pointer; virtual; function LookupItem(const AKey: String; - out ANode: PX2UtBTreeNode; + out ANode: PX2BTreeNode; const ACanCreate: Boolean = False; - const ASetCursor: Boolean = False): PX2UtHashItem; + const ASetCursor: Boolean = False): PX2HashItem; - procedure FreeNode(var ANode: PX2UtBTreeNode); override; + procedure FreeNode(var ANode: PX2BTreeNode); override; procedure ClearCursor(); override; function ValidCursor(const ARaiseError: Boolean = True): Boolean; override; - procedure InitHashItem(var AItem: PX2UtHashItem); virtual; - procedure FreeHashItem(var AItem: PX2UtHashItem); virtual; + procedure InitHashItem(var AItem: PX2HashItem); virtual; + procedure FreeHashItem(var AItem: PX2HashItem); virtual; - property HashCursor: PX2UtHashItem read FHashCursor write FHashCursor; + property HashCursor: PX2HashItem read FHashCursor write FHashCursor; property HashItemSize: Cardinal read FHashItemSize; property HashTotalSize: Cardinal read GetHashTotalSize; property HashDataSize: Cardinal read FHashDataSize write FHashDataSize; @@ -91,8 +91,8 @@ type { :$ Hash implementation for pointer values } - TX2UtHash = class(TX2UtCustomHash) - private + TX2Hash = class(TX2CustomHash) + protected function GetItem(Key: String): Pointer; procedure SetItem(Key: String; const Value: Pointer); @@ -112,8 +112,8 @@ type { :$ Hash implementation for integer values } - TX2UtIntegerHash = class(TX2UtHash) - private + TX2IntegerHash = class(TX2Hash) + protected function GetItem(Key: String): Integer; procedure SetItem(Key: String; const Value: Integer); @@ -131,15 +131,15 @@ type { :$ Hash implementation for string values } - TX2UtStringHash = class(TX2UtCustomHash) - private + TX2StringHash = class(TX2CustomHash) + protected function GetItem(Key: String): String; procedure SetItem(Key: String; const Value: String); function GetCurrentValue(): String; protected - procedure InitHashItem(var AItem: PX2UtHashItem); override; - procedure FreeHashItem(var AItem: PX2UtHashItem); override; + procedure InitHashItem(var AItem: PX2HashItem); override; + procedure FreeHashItem(var AItem: PX2HashItem); override; public constructor Create(); override; property CurrentKey; @@ -152,24 +152,46 @@ type property CurrentValue: String read GetCurrentValue; end; + { + :$ Hash implementation for object values + } + TX2ObjectHash = class(TX2Hash) + private + FOwnsObjects: Boolean; + protected + function GetItem(Key: String): TObject; + procedure SetItem(Key: String; const Value: TObject); + + function GetCurrentValue(): TObject; + protected + procedure FreeHashItem(var AItem: PX2HashItem); override; + public + //:$ Gets or sets an item. + property Items[Key: String]: TObject read GetItem + write SetItem; default; + + //:$ Returns the value at the current cursor location. + property CurrentValue: TObject read GetCurrentValue; + end; + implementation resourcestring RSEmptyKey = 'Cannot hash an empty key!'; -{======================== TX2UtCustomHash +{========================== TX2CustomHash Initialization ========================================} -constructor TX2UtCustomHash.Create; +constructor TX2CustomHash.Create; begin inherited; - FHashItemSize := SizeOf(TX2UtHashItem); + FHashItemSize := SizeOf(TX2HashItem); DataSize := FHashItemSize; end; -{======================== TX2UtCustomHash +{========================== TX2CustomHash Hashing ========================================} procedure Mix(var A, B, C: Cardinal); @@ -185,7 +207,7 @@ begin Dec(C, A); Dec(C, B); B := B shr 15; C := C xor B; end; -function TX2UtCustomHash.Hash; +function TX2CustomHash.Hash; var iA: Cardinal; iB: Cardinal; @@ -243,10 +265,10 @@ end; -{======================== TX2UtCustomHash +{========================== TX2CustomHash Tree Traversing ========================================} -function TX2UtCustomHash.ValidCursor; +function TX2CustomHash.ValidCursor; begin Result := inherited ValidCursor(ARaiseError); if Result then @@ -254,18 +276,18 @@ begin Result := Assigned(FHashCursor); if (not Result) and (ARaiseError) then - raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor); + raise EX2BTreeInvalidCursor.Create(RSInvalidCursor); end; end; -procedure TX2UtCustomHash.ClearCursor; +procedure TX2CustomHash.ClearCursor; begin inherited; FHashCursor := nil; end; -function TX2UtCustomHash.Next; +function TX2CustomHash.Next; begin if Assigned(FHashCursor) then FHashCursor := FHashCursor^.Next; @@ -274,28 +296,28 @@ begin begin Result := inherited Next(); if Result then - FHashCursor := PX2UtHashList(GetNodeData(Cursor))^.Root; + FHashCursor := PX2HashList(GetNodeData(Cursor))^.Root; end else Result := True; end; -{======================== TX2UtCustomHash +{========================== TX2CustomHash Item Management ========================================} -function TX2UtCustomHash.GetItemData; +function TX2CustomHash.GetItemData; begin Assert(HashDataSize > 0, RSInvalidDataSize); Result := Pointer(Cardinal(AItem) + HashItemSize); end; -function TX2UtCustomHash.LookupItem; +function TX2CustomHash.LookupItem; var iIndex: Cardinal; - pData: PX2UtHashList; - pFound: PX2UtHashItem; - pItem: PX2UtHashItem; - pLast: PX2UtHashItem; + pData: PX2HashList; + pFound: PX2HashItem; + pItem: PX2HashItem; + pLast: PX2HashItem; begin Result := nil; @@ -304,7 +326,7 @@ begin if Assigned(ANode) then begin - pData := PX2UtHashList(GetNodeData(ANode)); + pData := PX2HashList(GetNodeData(ANode)); pItem := pData^.Root; pLast := nil; @@ -352,12 +374,12 @@ begin end; -procedure TX2UtCustomHash.Delete; +procedure TX2CustomHash.Delete; var bFree: Boolean; - pData: PX2UtHashList; - pNode: PX2UtBTreeNode; - pItem: PX2UtHashItem; + pData: PX2HashList; + pNode: PX2BTreeNode; + pItem: PX2HashItem; begin pItem := LookupItem(AKey, pNode); @@ -385,13 +407,13 @@ begin inherited Delete(Hash(AKey)); end; -function TX2UtCustomHash.Exists; +function TX2CustomHash.Exists; begin Result := inherited Exists(Hash(AKey), ASetCursor); end; -function TX2UtCustomHash.GetCurrentKey; +function TX2CustomHash.GetCurrentKey; begin Result := ''; if ValidCursor(True) then @@ -399,13 +421,13 @@ begin end; -procedure TX2UtCustomHash.FreeNode; +procedure TX2CustomHash.FreeNode; var - pData: PX2UtHashItem; - pNext: PX2UtHashItem; + pData: PX2HashItem; + pNext: PX2HashItem; begin - pData := PX2UtHashList(GetNodeData(ANode))^.Root; + pData := PX2HashList(GetNodeData(ANode))^.Root; while Assigned(pData) do begin pNext := pData^.Next; @@ -417,14 +439,14 @@ begin end; -procedure TX2UtCustomHash.InitHashItem; +procedure TX2CustomHash.InitHashItem; begin Assert(HashDataSize > 0, RSInvalidDataSize); GetMem(AItem, HashTotalSize); FillChar(AItem^, HashTotalSize, #0); end; -procedure TX2UtCustomHash.FreeHashItem; +procedure TX2CustomHash.FreeHashItem; begin if Assigned(AItem^.Prev) then AItem^.Prev^.Next := AItem^.Next; @@ -439,26 +461,26 @@ begin end; -function TX2UtCustomHash.GetHashTotalSize; +function TX2CustomHash.GetHashTotalSize; begin Result := FHashItemSize + FHashDataSize; end; -{============================== TX2UtHash +{================================ TX2Hash Item Management ========================================} -constructor TX2UtHash.Create; +constructor TX2Hash.Create; begin inherited; HashDataSize := SizeOf(Pointer); end; -function TX2UtHash.GetItem; +function TX2Hash.GetItem; var - pNode: PX2UtBTreeNode; - pItem: PX2UtHashItem; + pNode: PX2BTreeNode; + pItem: PX2HashItem; begin Assert(Length(Key) > 0, RSEmptyKey); @@ -467,10 +489,10 @@ begin Result := PPointer(GetItemData(pItem))^; end; -procedure TX2UtHash.SetItem; +procedure TX2Hash.SetItem; var - pNode: PX2UtBTreeNode; - pItem: PX2UtHashItem; + pNode: PX2BTreeNode; + pItem: PX2HashItem; begin Assert(Length(Key) > 0, RSEmptyKey); @@ -479,7 +501,7 @@ begin PPointer(GetItemData(pItem))^ := Value; end; -function TX2UtHash.GetCurrentValue; +function TX2Hash.GetCurrentValue; begin Result := nil; if ValidCursor() then @@ -487,39 +509,39 @@ begin end; -{======================= TX2UtIntegerHash +{========================= TX2IntegerHash Item Management ========================================} -function TX2UtIntegerHash.GetItem; +function TX2IntegerHash.GetItem; begin Result := Integer(inherited GetItem(Key)); end; -procedure TX2UtIntegerHash.SetItem; +procedure TX2IntegerHash.SetItem; begin inherited SetItem(Key, Pointer(Value)); end; -function TX2UtIntegerHash.GetCurrentValue; +function TX2IntegerHash.GetCurrentValue; begin Result := Integer(inherited GetCurrentValue()); end; -{======================== TX2UtStringHash +{========================== TX2StringHash Item Management ========================================} -constructor TX2UtStringHash.Create; +constructor TX2StringHash.Create; begin inherited; HashDataSize := SizeOf(PString); end; -function TX2UtStringHash.GetItem; +function TX2StringHash.GetItem; var - pNode: PX2UtBTreeNode; - pItem: PX2UtHashItem; + pNode: PX2BTreeNode; + pItem: PX2HashItem; begin Assert(Length(Key) > 0, RSEmptyKey); @@ -528,10 +550,10 @@ begin Result := PString(GetItemData(pItem))^; end; -procedure TX2UtStringHash.SetItem; +procedure TX2StringHash.SetItem; var - pNode: PX2UtBTreeNode; - pItem: PX2UtHashItem; + pNode: PX2BTreeNode; + pItem: PX2HashItem; begin Assert(Length(Key) > 0, RSEmptyKey); @@ -541,7 +563,7 @@ begin end; -procedure TX2UtStringHash.InitHashItem; +procedure TX2StringHash.InitHashItem; var pData: PString; @@ -552,7 +574,7 @@ begin Initialize(pData^); end; -procedure TX2UtStringHash.FreeHashItem; +procedure TX2StringHash.FreeHashItem; var pData: PString; @@ -564,11 +586,46 @@ begin end; -function TX2UtStringHash.GetCurrentValue; +function TX2StringHash.GetCurrentValue; begin Result := ''; if ValidCursor() then Result := PString(GetItemData(HashCursor))^; end; + +{========================== TX2ObjectHash + Item Management +========================================} +function TX2ObjectHash.GetItem; +begin + Result := TObject(inherited GetItem(Key)); +end; + +procedure TX2ObjectHash.SetItem; +begin + inherited SetItem(Key, Pointer(Value)); +end; + +function TX2ObjectHash.GetCurrentValue; +begin + Result := TObject(inherited GetCurrentValue()); +end; + +procedure TX2ObjectHash.FreeHashItem; +var + pObject: ^TObject; + +begin + if FOwnsObjects then + begin + pObject := GetItemData(AItem); + + if Assigned(pObject) then + FreeAndNil(pObject^); + end; + + inherited; +end; + end. diff --git a/X2UtSettings.pas b/X2UtSettings.pas index b5f01f0..cc1b060 100644 --- a/X2UtSettings.pas +++ b/X2UtSettings.pas @@ -13,7 +13,8 @@ interface uses Classes, SysUtils, - Variants; + Variants, + X2UtHashes; type //:$ Raised when an unregistered setting is requested without providing a @@ -27,6 +28,18 @@ type //:$ Raised when the specified range is invalid. EX2SettingsRange = class(Exception); + //:$ Callback method for defines + TX2SettingsCallback = procedure(const ASection, AName: String; + var AValue: Variant) of object; + + { + :$ Internal representation of defines + } + TX2SettingsDefine = class(TObject) + private + + end; + // Forward declaration TX2SettingsFactory = class; @@ -124,6 +137,25 @@ type //:: this into a compatible section. //:! The application is responsible for freeing the returned class. property Sections[const ASection: String]: TX2Settings read GetSection; default; + + //:$ Defines a persistent setting + //:: Persistent settings are a way for the application to register it's + //:: configuration settings on startup with a default value and a range. + //:: When reading a setting it will be checked against the specified range + //:: (if supplied), or if not found, the registered default value will be + //:: returned. This allows the setting to be read in many places without + //:: having to do all the checks every time. In addition you may provide + //:: a callback method to handle more advanced checks. + //:: /n/n + //:: Ranges must be specified as an array where each pair of values + //:: specifies the minimum and maximum value of that range. The type + //:: of the values in the ranges must be the same as the type of the + //:: value, and is used later on for type checking. The only exception + //:: to this rule is that you are allowed to specify integer ranges for + //:: a floating value. + procedure Define(const ASection, AName: String; const AValue: Variant; + const ARanges: array of const; + const ACallback: TX2SettingsCallback = nil); end; @@ -151,53 +183,62 @@ end; ========================================} function TX2Settings.ReadBool(const AName: String): Boolean; begin - if not (ValueExists(AName) and InternalReadBool(AName, Result)) then + if not InternalReadBool(AName, Result) then raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]); end; function TX2Settings.ReadBool(const AName: String; const ADefault: Boolean): Boolean; begin - if not (ValueExists(AName) and InternalReadBool(AName, Result)) then + if not InternalReadBool(AName, Result) then Result := ADefault; end; function TX2Settings.ReadFloat(const AName: String): Double; begin - if not (ValueExists(AName) and InternalReadFloat(AName, Result)) then + if not InternalReadFloat(AName, Result) then raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]); end; function TX2Settings.ReadFloat(const AName: String; const ADefault: Double): Double; begin - if not (ValueExists(AName) and InternalReadFloat(AName, Result)) then + if not InternalReadFloat(AName, Result) then Result := ADefault; end; function TX2Settings.ReadInteger(const AName: String): Integer; begin - if not (ValueExists(AName) and InternalReadInteger(AName, Result)) then + if not InternalReadInteger(AName, Result) then raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]); end; function TX2Settings.ReadInteger(const AName: String; const ADefault: Integer): Integer; begin - if not (ValueExists(AName) and InternalReadInteger(AName, Result)) then + if not InternalReadInteger(AName, Result) then Result := ADefault; end; function TX2Settings.ReadString(const AName: String): String; begin - if not (ValueExists(AName) and InternalReadString(AName, Result)) then + if not InternalReadString(AName, Result) then raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]); end; function TX2Settings.ReadString(const AName, ADefault: String): String; begin - if not (ValueExists(AName) and InternalReadString(AName, Result)) then + if not InternalReadString(AName, Result) then Result := ADefault; end; + +{===================== TX2SettingsFactory + Defines +========================================} +procedure TX2SettingsFactory.Define; +begin + // +end; + end. diff --git a/X2UtSettingsINI.pas b/X2UtSettingsINI.pas index 9a9032e..848e8c8 100644 --- a/X2UtSettingsINI.pas +++ b/X2UtSettingsINI.pas @@ -101,26 +101,34 @@ end; ========================================} function TX2INISettings.InternalReadBool; begin - AValue := FData.ReadBool(FSection, AName, False); - Result := True; + Result := ValueExists(AName); + + if Result then + AValue := FData.ReadBool(FSection, AName, False); end; function TX2INISettings.InternalReadFloat; begin - AValue := FData.ReadFloat(FSection, AName, 0); - Result := True; + Result := ValueExists(AName); + + if Result then + AValue := FData.ReadFloat(FSection, AName, 0); end; function TX2INISettings.InternalReadInteger; begin - AValue := FData.ReadInteger(FSection, AName, 0); - Result := True; + Result := ValueExists(AName); + + if Result then + AValue := FData.ReadInteger(FSection, AName, 0); end; function TX2INISettings.InternalReadString; begin - AValue := FData.ReadString(FSection, AName, ''); - Result := True; + Result := ValueExists(AName); + + if Result then + AValue := FData.ReadString(FSection, AName, ''); end; diff --git a/X2UtSettingsRegistry.pas b/X2UtSettingsRegistry.pas index ec038f8..fba420d 100644 --- a/X2UtSettingsRegistry.pas +++ b/X2UtSettingsRegistry.pas @@ -7,32 +7,6 @@ :: Last changed: $Date$ :: Revision: $Rev$ :: Author: $Author$ - - :$ - :$ - :$ X2Utils is released under the zlib/libpng OSI-approved license. - :$ For more information: http://www.opensource.org/ - :$ /n/n - :$ /n/n - :$ Copyright (c) 2003 X2Software - :$ /n/n - :$ This software is provided 'as-is', without any express or implied warranty. - :$ In no event will the authors be held liable for any damages arising from - :$ the use of this software. - :$ /n/n - :$ Permission is granted to anyone to use this software for any purpose, - :$ including commercial applications, and to alter it and redistribute it - :$ freely, subject to the following restrictions: - :$ /n/n - :$ 1. The origin of this software must not be misrepresented; you must not - :$ claim that you wrote the original software. If you use this software in a - :$ product, an acknowledgment in the product documentation would be - :$ appreciated but is not required. - :$ /n/n - :$ 2. Altered source versions must be plainly marked as such, and must not be - :$ misrepresented as being the original software. - :$ /n/n - :$ 3. This notice may not be removed or altered from any source distribution. } unit X2UtSettingsRegistry; @@ -173,8 +147,10 @@ begin if OpenRead() then begin - AValue := FData.ReadBool(AName); - Result := True; + Result := ValueExists(AName); + + if Result then + AValue := FData.ReadBool(AName); end; end; @@ -184,8 +160,10 @@ begin if OpenRead() then begin - AValue := FData.ReadFloat(AName); - Result := True; + Result := ValueExists(AName); + + if Result then + AValue := FData.ReadFloat(AName); end; end; @@ -195,8 +173,10 @@ begin if OpenRead() then begin - AValue := FData.ReadInteger(AName); - Result := True; + Result := ValueExists(AName); + + if Result then + AValue := FData.ReadInteger(AName); end; end; @@ -206,8 +186,10 @@ begin if OpenRead() then begin - AValue := FData.ReadString(AName); - Result := True; + Result := ValueExists(AName); + + if Result then + AValue := FData.ReadString(AName); end; end;