Changed: renamed all tree and hash structure from X2Ut... to X2... for consistency
Added: TObject tree and hash
This commit is contained in:
parent
c47722f0db
commit
dd627c8b74
@ -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=
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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.
|
||||
|
||||
219
X2UtHashes.pas
219
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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user