GitHub-Mirror/x2utils
1
0
Fork 0
mirror of synced 2024-09-19 09:46:09 +00:00
Code Issues Projects Releases Wiki Activity

Changed: renamed all tree and hash structure from X2Ut... to X2... for consistency

Browse Source 
Added: TObject tree and hash
This commit is contained in:
Mark van Renswoude 2004-08-20 13:03:07 +00:00
parent c47722f0db
commit dd627c8b74
7 changed files with 441 additions and 264 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Test/X2UtilsSettingsTest.dof
View File

@ -66,7 +66,7 @@ AutoIncBuild=1
MajorVer=1 MajorVer=1
MinorVer=0 MinorVer=0
Release=0 Release=0
Build=1 Build=2
Debug=0 Debug=0
PreRelease=0 PreRelease=0
Special=0 Special=0
@ -77,7 +77,7 @@ CodePage=1252
[Version Info Keys] [Version Info Keys]
CompanyName= CompanyName=
FileDescription= FileDescription=
FileVersion=1.0.0.1 FileVersion=1.0.0.2
InternalName= InternalName=
LegalCopyright= LegalCopyright=
LegalTrademarks= LegalTrademarks=

16
Test/X2UtilsSettingsTest.dpr
View File

@ -5,6 +5,7 @@ program X2UtilsSettingsTest;
uses uses
Classes, Classes,
SysUtils, SysUtils,
Variants,
Windows, Windows,
X2UtApp in '..\X2UtApp.pas', X2UtApp in '..\X2UtApp.pas',
X2UtSettings in '..\X2UtSettings.pas', X2UtSettings in '..\X2UtSettings.pas',
@ -70,7 +71,7 @@ var
begin begin
// INI settings // INI settings
WriteLn('INI data:'); //WriteLn('INI data:');
Settings := TX2INISettingsFactory.Create(); Settings := TX2INISettingsFactory.Create();
try try
with TX2INISettingsFactory(Settings) do with TX2INISettingsFactory(Settings) do
@ -97,11 +98,20 @@ begin
} }
// Test for the definitions // Test for the definitions
Settings.Define('Test', 'Value', 5, [[0, 5], [10, 15]]); Settings.Define('Test', 'Value', 5, [0, 5, 10, 15]);
Settings.ReadInteger('Test', 'Value');
with Settings['Test'] do
try
WriteInteger('Value', 6);
WriteLn(ReadInteger('Value'));
finally
Free();
end;
{
TraverseSection(Settings, '', 1); TraverseSection(Settings, '', 1);
WriteLn; WriteLn;
}
finally finally
FreeAndNil(Settings); FreeAndNil(Settings);
end; end;

333
X2UtBinaryTree.pas
View File

@ -25,16 +25,16 @@ uses
type type
//:$ Raised when the cursor is invalid. //:$ Raised when the cursor is invalid.
//:: Call Reset on the binary tree to create a valid cursor. //:: Call Reset on the binary tree to create a valid cursor.
EX2UtBTreeInvalidCursor = class(Exception); EX2BTreeInvalidCursor = class(Exception);
{ {
:$ Internal representation of a node. :$ Internal representation of a node.
} }
PPX2UtBTreeNode = ^PX2UtBTreeNode; PPX2BTreeNode = ^PX2BTreeNode;
PX2UtBTreeNode = ^TX2UtBTreeNode; PX2BTreeNode = ^TX2BTreeNode;
TX2UtBTreeNode = record TX2BTreeNode = record
Index: Cardinal; Index: Cardinal;
Children: array[0..1] of PX2UtBTreeNode; Children: array[0..1] of PX2BTreeNode;
Balance: Integer; Balance: Integer;
Data: record end; Data: record end;
end; end;
@ -42,34 +42,34 @@ type
{ {
:$ Internal node stack :$ Internal node stack
} }
TX2UtBTreeStackItem = record TX2BTreeStackItem = record
Node: PX2UtBTreeNode; Node: PX2BTreeNode;
Direction: Integer; Direction: Integer;
end; end;
TX2UtBTreeStack = class(TObject) TX2BTreeStack = class(TObject)
private private
FItems: array of TX2UtBTreeStackItem; FItems: array of TX2BTreeStackItem;
FCount: Integer; FCount: Integer;
FPosition: Integer; FPosition: Integer;
function GetCount(): Integer; function GetCount(): Integer;
function GetNode(Index: Integer): PX2UtBTreeNode; function GetNode(Index: Integer): PX2BTreeNode;
function GetDirection(Index: Integer): Integer; function GetDirection(Index: Integer): Integer;
procedure SetDirection(Index: Integer; const Value: Integer); procedure SetDirection(Index: Integer; const Value: Integer);
procedure SetNode(Index: Integer; const Value: PX2UtBTreeNode); procedure SetNode(Index: Integer; const Value: PX2BTreeNode);
public public
constructor Create(); constructor Create();
procedure Clear(); procedure Clear();
procedure Push(const ANode: PX2UtBTreeNode; const ADirection: Integer = 0); procedure Push(const ANode: PX2BTreeNode; const ADirection: Integer = 0);
function Pop(): PX2UtBTreeNode; overload; function Pop(): PX2BTreeNode; overload;
function Pop(var ADirection: Integer): PX2UtBTreeNode; overload; function Pop(var ADirection: Integer): PX2BTreeNode; overload;
property Node[Index: Integer]: PX2UtBTreeNode read GetNode property Node[Index: Integer]: PX2BTreeNode read GetNode
write SetNode; default; write SetNode; default;
property Direction[Index: Integer]: Integer read GetDirection property Direction[Index: Integer]: Integer read GetDirection
write SetDirection; write SetDirection;
property Count: Integer read GetCount; property Count: Integer read GetCount;
end; end;
@ -80,13 +80,13 @@ type
:: This class implements a binary tree without knowing anything about :: This class implements a binary tree without knowing anything about
:: the data it contains. :: the data it contains.
} }
TX2UtCustomBTree = class(TObject) TX2CustomBTree = class(TObject)
private private
FCount: Integer; FCount: Integer;
FRoot: PX2UtBTreeNode; FRoot: PX2BTreeNode;
FCursor: PX2UtBTreeNode; FCursor: PX2BTreeNode;
FIsReset: Boolean; FIsReset: Boolean;
FParents: TX2UtBTreeStack; FParents: TX2BTreeStack;
FNodeSize: Cardinal; FNodeSize: Cardinal;
FDataSize: Cardinal; FDataSize: Cardinal;
@ -94,51 +94,51 @@ type
function GetTotalSize(): Cardinal; function GetTotalSize(): Cardinal;
protected protected
function GetCurrentIndex(): Cardinal; function GetCurrentIndex(): Cardinal;
function GetNodeData(const ANode: PX2UtBTreeNode): Pointer; virtual; function GetNodeData(const ANode: PX2BTreeNode): Pointer; virtual;
procedure CopyNodeData(const ASource, ADest: PX2UtBTreeNode); procedure CopyNodeData(const ASource, ADest: PX2BTreeNode);
procedure BalanceInsert(var ANode: PX2UtBTreeNode); procedure BalanceInsert(var ANode: PX2BTreeNode);
function LookupNode(const AIndex: Cardinal; function LookupNode(const AIndex: Cardinal;
const ACanCreate: Boolean = False; const ACanCreate: Boolean = False;
const ASetCursor: Boolean = False): PX2UtBTreeNode; const ASetCursor: Boolean = False): PX2BTreeNode;
procedure RotateLeft(var ANode: PX2UtBTreeNode); procedure RotateLeft(var ANode: PX2BTreeNode);
procedure RotateRight(var ANode: PX2UtBTreeNode); procedure RotateRight(var ANode: PX2BTreeNode);
function DeleteLeftShrunk(var ANode: PX2UtBTreeNode): Integer; function DeleteLeftShrunk(var ANode: PX2BTreeNode): Integer;
function DeleteRightShrunk(var ANode: PX2UtBTreeNode): Integer; function DeleteRightShrunk(var ANode: PX2BTreeNode): Integer;
function DeleteFindHighest(const ATarget: PX2UtBTreeNode; function DeleteFindHighest(const ATarget: PX2BTreeNode;
var ANode: PX2UtBTreeNode; var ANode: PX2BTreeNode;
out AResult: Integer): Boolean; out AResult: Integer): Boolean;
function DeleteFindLowest(const ATarget: PX2UtBTreeNode; function DeleteFindLowest(const ATarget: PX2BTreeNode;
var ANode: PX2UtBTreeNode; var ANode: PX2BTreeNode;
out AResult: Integer): Boolean; out AResult: Integer): Boolean;
function InternalDeleteNode(var ARoot: PX2UtBTreeNode; function InternalDeleteNode(var ARoot: PX2BTreeNode;
const AIndex: Cardinal): Integer; const AIndex: Cardinal): Integer;
procedure DeleteNode(const AIndex: Cardinal); procedure DeleteNode(const AIndex: Cardinal);
procedure InitNode(var ANode: PX2UtBTreeNode); virtual; procedure InitNode(var ANode: PX2BTreeNode); virtual;
procedure FreeNode(var ANode: PX2UtBTreeNode); virtual; procedure FreeNode(var ANode: PX2BTreeNode); virtual;
procedure ClearCursor(); virtual; procedure ClearCursor(); virtual;
function ValidCursor(const ARaiseError: Boolean = True): Boolean; virtual; function ValidCursor(const ARaiseError: Boolean = True): Boolean; virtual;
property Cursor: PX2UtBTreeNode read FCursor write FCursor; property Cursor: PX2BTreeNode read FCursor write FCursor;
property Root: PX2UtBTreeNode read FRoot; property Root: PX2BTreeNode read FRoot;
property IsReset: Boolean read FIsReset write FIsReset; property IsReset: Boolean read FIsReset write FIsReset;
property Parents: TX2UtBTreeStack read FParents; property Parents: TX2BTreeStack read FParents;
property NodeSize: Cardinal read FNodeSize; property NodeSize: Cardinal read FNodeSize;
property TotalSize: Cardinal read GetTotalSize; property TotalSize: Cardinal read GetTotalSize;
// Note: do NOT change DataSize after the first node has // Note: do NOT change DataSize after the first node has
// been created! This will result in an Access Violation! // 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. //:$ Returns the index at the current cursor location.
property CurrentIndex: Cardinal read GetCurrentIndex; property CurrentIndex: Cardinal read GetCurrentIndex;
public public
constructor Create(); virtual; constructor Create(); virtual;
destructor Destroy(); override; destructor Destroy(); override;
@ -175,7 +175,7 @@ type
{ {
:$ Binary tree implementation for pointer values :$ Binary tree implementation for pointer values
} }
TX2UtBTree = class(TX2UtCustomBTree) TX2BTree = class(TX2CustomBTree)
private private
function GetItem(Index: Cardinal): Pointer; function GetItem(Index: Cardinal): Pointer;
procedure SetItem(Index: Cardinal; const Value: Pointer); procedure SetItem(Index: Cardinal; const Value: Pointer);
@ -196,7 +196,7 @@ type
{ {
:$ Binary tree implementation for integer values :$ Binary tree implementation for integer values
} }
TX2UtIntegerBTree = class(TX2UtBTree) TX2IntegerBTree = class(TX2BTree)
protected protected
function GetItem(Index: Cardinal): Integer; function GetItem(Index: Cardinal): Integer;
procedure SetItem(Index: Cardinal; const Value: Integer); procedure SetItem(Index: Cardinal; const Value: Integer);
@ -214,15 +214,15 @@ type
{ {
:$ Binary tree implementation for string values :$ Binary tree implementation for string values
} }
TX2UtStringBTree = class(TX2UtCustomBTree) TX2StringBTree = class(TX2CustomBTree)
protected protected
function GetItem(Index: Cardinal): String; function GetItem(Index: Cardinal): String;
procedure SetItem(Index: Cardinal; const Value: String); procedure SetItem(Index: Cardinal; const Value: String);
function GetCurrentValue(): String; function GetCurrentValue(): String;
protected protected
procedure InitNode(var ANode: PX2UtBTreeNode); override; procedure InitNode(var ANode: PX2BTreeNode); override;
procedure FreeNode(var ANode: PX2UtBTreeNode); override; procedure FreeNode(var ANode: PX2BTreeNode); override;
public public
constructor Create(); override; constructor Create(); override;
property CurrentIndex; property CurrentIndex;
@ -235,6 +235,35 @@ type
property CurrentValue: String read GetCurrentValue; property CurrentValue: String read GetCurrentValue;
end; 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 resourcestring
RSInvalidCursor = 'Cursor is invalid!'; RSInvalidCursor = 'Cursor is invalid!';
RSInvalidDataSize = 'Invalid data size!'; RSInvalidDataSize = 'Invalid data size!';
@ -254,10 +283,10 @@ const
CBalance = 2; CBalance = 2;
{======================== TX2UtBTreeStack {========================== TX2BTreeStack
Item Management Item Management
========================================} ========================================}
constructor TX2UtBTreeStack.Create; constructor TX2BTreeStack.Create;
begin begin
inherited; inherited;
@ -267,14 +296,14 @@ begin
end; end;
procedure TX2UtBTreeStack.Clear; procedure TX2BTreeStack.Clear;
begin begin
FCount := CStackSize; FCount := CStackSize;
FPosition := -1; FPosition := -1;
SetLength(FItems, FCount); SetLength(FItems, FCount);
end; end;
procedure TX2UtBTreeStack.Push; procedure TX2BTreeStack.Push;
begin begin
Inc(FPosition); Inc(FPosition);
if FPosition >= FCount then if FPosition >= FCount then
@ -290,7 +319,7 @@ begin
end; end;
end; end;
function TX2UtBTreeStack.Pop(): PX2UtBTreeNode; function TX2BTreeStack.Pop(): PX2BTreeNode;
begin begin
Result := nil; Result := nil;
if FPosition >= 0 then if FPosition >= 0 then
@ -300,7 +329,7 @@ begin
end; end;
end; end;
function TX2UtBTreeStack.Pop(var ADirection: Integer): PX2UtBTreeNode; function TX2BTreeStack.Pop(var ADirection: Integer): PX2BTreeNode;
begin begin
Result := nil; Result := nil;
if FPosition >= 0 then if FPosition >= 0 then
@ -311,49 +340,49 @@ begin
end; end;
end; end;
function TX2UtBTreeStack.GetNode; function TX2BTreeStack.GetNode;
begin begin
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!'); Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
Result := FItems[Index].Node; Result := FItems[Index].Node;
end; end;
procedure TX2UtBTreeStack.SetNode; procedure TX2BTreeStack.SetNode;
begin begin
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!'); Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
FItems[Index].Node := Value; FItems[Index].Node := Value;
end; end;
function TX2UtBTreeStack.GetDirection; function TX2BTreeStack.GetDirection;
begin begin
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!'); Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
Result := FItems[Index].Direction; Result := FItems[Index].Direction;
end; end;
procedure TX2UtBTreeStack.SetDirection; procedure TX2BTreeStack.SetDirection;
begin begin
Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!'); Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
FItems[Index].Direction := Value; FItems[Index].Direction := Value;
end; end;
function TX2UtBTreeStack.GetCount; function TX2BTreeStack.GetCount;
begin begin
Result := FPosition + 1; Result := FPosition + 1;
end; end;
{======================= TX2UtCustomBTree {======================= TX2CustomBTree
Initialization Initialization
========================================} ========================================}
constructor TX2UtCustomBTree.Create; constructor TX2CustomBTree.Create;
begin begin
inherited; inherited;
FParents := TX2UtBTreeStack.Create(); FParents := TX2BTreeStack.Create();
FNodeSize := SizeOf(TX2UtBTreeNode); FNodeSize := SizeOf(TX2BTreeNode);
end; end;
destructor TX2UtCustomBTree.Destroy; destructor TX2CustomBTree.Destroy;
begin begin
FreeAndNil(FParents); FreeAndNil(FParents);
Clear(); Clear();
@ -362,16 +391,16 @@ begin
end; end;
{======================= TX2UtCustomBTree {========================= TX2CustomBTree
Tree Management Tree Management
========================================} ========================================}
function TX2UtCustomBTree.GetNodeData; function TX2CustomBTree.GetNodeData;
begin begin
Assert(DataSize > 0, RSInvalidDataSize); Assert(DataSize > 0, RSInvalidDataSize);
Result := Pointer(Cardinal(ANode) + NodeSize); Result := Pointer(Cardinal(ANode) + NodeSize);
end; end;
procedure TX2UtCustomBTree.CopyNodeData; procedure TX2CustomBTree.CopyNodeData;
begin begin
ADest^.Index := ASource^.Index; ADest^.Index := ASource^.Index;
Move(GetNodeData(ASource)^, Move(GetNodeData(ASource)^,
@ -380,10 +409,10 @@ begin
end; end;
procedure TX2UtCustomBTree.BalanceInsert; procedure TX2CustomBTree.BalanceInsert;
var var
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
pSwap: PX2UtBTreeNode; pSwap: PX2BTreeNode;
begin begin
if ANode^.Balance = -2 then if ANode^.Balance = -2 then
@ -472,13 +501,13 @@ begin
end; end;
function TX2UtCustomBTree.LookupNode; function TX2CustomBTree.LookupNode;
var var
pCurrent: PPX2UtBTreeNode; pCurrent: PPX2BTreeNode;
pBalance: PPX2UtBTreeNode; pBalance: PPX2BTreeNode;
pLast: PX2UtBTreeNode; pLast: PX2BTreeNode;
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
pPath: TX2UtBTreeStack; pPath: TX2BTreeStack;
begin begin
Result := nil; Result := nil;
@ -486,7 +515,7 @@ begin
if ASetCursor then if ASetCursor then
Parents.Clear(); Parents.Clear();
pPath := TX2UtBTreeStack.Create(); pPath := TX2BTreeStack.Create();
try try
pCurrent := @FRoot; pCurrent := @FRoot;
pBalance := nil; pBalance := nil;
@ -547,9 +576,9 @@ begin
end; end;
procedure TX2UtCustomBTree.RotateLeft; procedure TX2CustomBTree.RotateLeft;
var var
pSwap: PX2UtBTreeNode; pSwap: PX2BTreeNode;
begin begin
pSwap := ANode; pSwap := ANode;
@ -558,9 +587,9 @@ begin
ANode^.Children[CLeft] := pSwap; ANode^.Children[CLeft] := pSwap;
end; end;
procedure TX2UtCustomBTree.RotateRight; procedure TX2CustomBTree.RotateRight;
var var
pSwap: PX2UtBTreeNode; pSwap: PX2BTreeNode;
begin begin
pSwap := ANode; pSwap := ANode;
@ -570,7 +599,7 @@ begin
end; end;
function TX2UtCustomBTree.DeleteLeftShrunk; function TX2CustomBTree.DeleteLeftShrunk;
begin begin
Result := CError; Result := CError;
@ -635,7 +664,7 @@ begin
end; end;
end; end;
function TX2UtCustomBTree.DeleteRightShrunk; function TX2CustomBTree.DeleteRightShrunk;
begin begin
Result := CError; Result := CError;
@ -700,9 +729,9 @@ begin
end; end;
end; end;
function TX2UtCustomBTree.DeleteFindHighest; function TX2CustomBTree.DeleteFindHighest;
var var
pSwap: PX2UtBTreeNode; pSwap: PX2BTreeNode;
begin begin
AResult := CBalance; AResult := CBalance;
@ -734,9 +763,9 @@ begin
Result := True; Result := True;
end; end;
function TX2UtCustomBTree.DeleteFindLowest; function TX2CustomBTree.DeleteFindLowest;
var var
pSwap: PX2UtBTreeNode; pSwap: PX2BTreeNode;
begin begin
AResult := CBalance; AResult := CBalance;
@ -769,7 +798,7 @@ begin
end; end;
function TX2UtCustomBTree.InternalDeleteNode; function TX2CustomBTree.InternalDeleteNode;
var var
iResult: Integer; iResult: Integer;
@ -826,7 +855,7 @@ begin
Result := CBalance; Result := CBalance;
end; end;
procedure TX2UtCustomBTree.DeleteNode; procedure TX2CustomBTree.DeleteNode;
begin begin
if not Assigned(FRoot) then if not Assigned(FRoot) then
exit; exit;
@ -835,7 +864,7 @@ begin
end; end;
procedure TX2UtCustomBTree.InitNode; procedure TX2CustomBTree.InitNode;
begin begin
Assert(DataSize > 0, RSInvalidDataSize); Assert(DataSize > 0, RSInvalidDataSize);
GetMem(ANode, TotalSize); GetMem(ANode, TotalSize);
@ -845,7 +874,7 @@ begin
ClearCursor(); ClearCursor();
end; end;
procedure TX2UtCustomBTree.FreeNode; procedure TX2CustomBTree.FreeNode;
begin begin
FreeMem(ANode, TotalSize); FreeMem(ANode, TotalSize);
ANode := nil; ANode := nil;
@ -855,8 +884,8 @@ begin
end; end;
procedure TX2UtCustomBTree.Clear; procedure TX2CustomBTree.Clear;
procedure ClearNode(var ANode: PX2UtBTreeNode); procedure ClearNode(var ANode: PX2BTreeNode);
begin begin
if Assigned(ANode^.Children[CLeft]) then if Assigned(ANode^.Children[CLeft]) then
ClearNode(ANode^.Children[CLeft]); ClearNode(ANode^.Children[CLeft]);
@ -874,45 +903,45 @@ begin
FRoot := nil; FRoot := nil;
end; end;
procedure TX2UtCustomBTree.Delete; procedure TX2CustomBTree.Delete;
begin begin
DeleteNode(AIndex); DeleteNode(AIndex);
end; end;
function TX2UtCustomBTree.Exists; function TX2CustomBTree.Exists;
begin begin
Result := Assigned(LookupNode(AIndex, False, True)); Result := Assigned(LookupNode(AIndex, False, True));
end; end;
{======================= TX2UtCustomBTree {========================= TX2CustomBTree
Tree Traversing Tree Traversing
========================================} ========================================}
function TX2UtCustomBTree.ValidCursor; function TX2CustomBTree.ValidCursor;
begin begin
Result := (Assigned(Cursor) and (not IsReset)); Result := (Assigned(Cursor) and (not IsReset));
if (not Result) and (ARaiseError) then if (not Result) and (ARaiseError) then
raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor); raise EX2BTreeInvalidCursor.Create(RSInvalidCursor);
end; end;
procedure TX2UtCustomBTree.ClearCursor; procedure TX2CustomBTree.ClearCursor;
begin begin
Cursor := nil; Cursor := nil;
end; end;
procedure TX2UtCustomBTree.Reset; procedure TX2CustomBTree.Reset;
begin begin
Cursor := Root; Cursor := Root;
IsReset := True; IsReset := True;
end; end;
function TX2UtCustomBTree.Next; function TX2CustomBTree.Next;
var var
pParent: PX2UtBTreeNode; pParent: PX2BTreeNode;
pCurrent: PX2UtBTreeNode; pCurrent: PX2BTreeNode;
begin begin
Result := False; Result := False;
@ -968,32 +997,32 @@ begin
end; end;
end; end;
function TX2UtCustomBTree.GetCurrentIndex; function TX2CustomBTree.GetCurrentIndex;
begin begin
Result := 0; Result := 0;
if ValidCursor(True) then if ValidCursor(True) then
Result := Cursor^.Index; Result := Cursor^.Index;
end; end;
function TX2UtCustomBTree.GetTotalSize; function TX2CustomBTree.GetTotalSize;
begin begin
Result := FNodeSize + FDataSize; Result := FNodeSize + FDataSize;
end; end;
{============================= TX2UtBTree {=============================== TX2BTree
Item Management Item Management
========================================} ========================================}
constructor TX2UtBTree.Create; constructor TX2BTree.Create;
begin begin
inherited; inherited;
DataSize := SizeOf(Pointer); DataSize := SizeOf(Pointer);
end; end;
function TX2UtBTree.GetItem; function TX2BTree.GetItem;
var var
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
begin begin
Result := nil; Result := nil;
@ -1002,9 +1031,9 @@ begin
Result := PPointer(GetNodeData(pNode))^; Result := PPointer(GetNodeData(pNode))^;
end; end;
procedure TX2UtBTree.SetItem; procedure TX2BTree.SetItem;
var var
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
begin begin
pNode := LookupNode(Index, True); pNode := LookupNode(Index, True);
@ -1012,7 +1041,7 @@ begin
PPointer(GetNodeData(pNode))^ := Value; PPointer(GetNodeData(pNode))^ := Value;
end; end;
function TX2UtBTree.GetCurrentValue; function TX2BTree.GetCurrentValue;
begin begin
Result := nil; Result := nil;
if ValidCursor(True) then if ValidCursor(True) then
@ -1020,29 +1049,29 @@ begin
end; end;
{====================== TX2UtIntegerBTree {======================== TX2IntegerBTree
Item Management Item Management
========================================} ========================================}
function TX2UtIntegerBTree.GetItem; function TX2IntegerBTree.GetItem;
begin begin
Result := Integer(inherited GetItem(Index)); Result := Integer(inherited GetItem(Index));
end; end;
procedure TX2UtIntegerBTree.SetItem; procedure TX2IntegerBTree.SetItem;
begin begin
inherited SetItem(Index, Pointer(Value)); inherited SetItem(Index, Pointer(Value));
end; end;
function TX2UtIntegerBTree.GetCurrentValue; function TX2IntegerBTree.GetCurrentValue;
begin begin
Result := Integer(inherited GetCurrentValue()); Result := Integer(inherited GetCurrentValue());
end; end;
{======================= TX2UtStringBTree {========================= TX2StringBTree
Item Management Item Management
========================================} ========================================}
constructor TX2UtStringBTree.Create; constructor TX2StringBTree.Create;
begin begin
inherited; inherited;
@ -1050,7 +1079,7 @@ begin
end; end;
procedure TX2UtStringBTree.InitNode; procedure TX2StringBTree.InitNode;
var var
pData: PString; pData: PString;
@ -1061,7 +1090,7 @@ begin
Initialize(pData^); Initialize(pData^);
end; end;
procedure TX2UtStringBTree.FreeNode; procedure TX2StringBTree.FreeNode;
var var
pData: PString; pData: PString;
@ -1073,9 +1102,9 @@ begin
end; end;
function TX2UtStringBTree.GetItem; function TX2StringBTree.GetItem;
var var
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
begin begin
pNode := LookupNode(Index); pNode := LookupNode(Index);
@ -1083,9 +1112,9 @@ begin
Result := PString(GetNodeData(pNode))^; Result := PString(GetNodeData(pNode))^;
end; end;
procedure TX2UtStringBTree.SetItem; procedure TX2StringBTree.SetItem;
var var
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
begin begin
pNode := LookupNode(Index, True); pNode := LookupNode(Index, True);
@ -1093,10 +1122,60 @@ begin
PString(GetNodeData(pNode))^ := Value; PString(GetNodeData(pNode))^ := Value;
end; end;
function TX2UtStringBTree.GetCurrentValue; function TX2StringBTree.GetCurrentValue;
begin begin
if ValidCursor(True) then if ValidCursor(True) then
Result := PString(GetNodeData(Cursor))^; Result := PString(GetNodeData(Cursor))^;
end; 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. end.

219
X2UtHashes.pas
View File

@ -20,10 +20,10 @@ type
{ {
:$ Internal representation of a hash item :$ Internal representation of a hash item
} }
PX2UtHashItem = ^TX2UtHashItem; PX2HashItem = ^TX2HashItem;
TX2UtHashItem = record TX2HashItem = record
Prev: PX2UtHashItem; Prev: PX2HashItem;
Next: PX2UtHashItem; Next: PX2HashItem;
Key: String; Key: String;
Data: record end; Data: record end;
end; end;
@ -31,20 +31,20 @@ type
{ {
:$ Internal hash list :$ Internal hash list
} }
PX2UtHashList = ^TX2UtHashList; PX2HashList = ^TX2HashList;
TX2UtHashList = record TX2HashList = record
Root: PX2UtHashItem; Root: PX2HashItem;
end; end;
{ {
:$ Hash implementation :$ Hash implementation
:: This class implements a hash without knowing anything about :: This class implements a hash without knowing anything about
:: the data it contains. :: the data it contains.
} }
TX2UtCustomHash = class(TX2UtCustomBTree) TX2CustomHash = class(TX2CustomBTree)
private private
FHashCursor: PX2UtHashItem; FHashCursor: PX2HashItem;
FHashDataSize: Cardinal; FHashDataSize: Cardinal;
FHashItemSize: Cardinal; FHashItemSize: Cardinal;
@ -53,21 +53,21 @@ type
protected protected
function Hash(const AValue: String): Cardinal; virtual; 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; function LookupItem(const AKey: String;
out ANode: PX2UtBTreeNode; out ANode: PX2BTreeNode;
const ACanCreate: Boolean = False; 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; procedure ClearCursor(); override;
function ValidCursor(const ARaiseError: Boolean = True): Boolean; override; function ValidCursor(const ARaiseError: Boolean = True): Boolean; override;
procedure InitHashItem(var AItem: PX2UtHashItem); virtual; procedure InitHashItem(var AItem: PX2HashItem); virtual;
procedure FreeHashItem(var AItem: PX2UtHashItem); 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 HashItemSize: Cardinal read FHashItemSize;
property HashTotalSize: Cardinal read GetHashTotalSize; property HashTotalSize: Cardinal read GetHashTotalSize;
property HashDataSize: Cardinal read FHashDataSize write FHashDataSize; property HashDataSize: Cardinal read FHashDataSize write FHashDataSize;
@ -91,8 +91,8 @@ type
{ {
:$ Hash implementation for pointer values :$ Hash implementation for pointer values
} }
TX2UtHash = class(TX2UtCustomHash) TX2Hash = class(TX2CustomHash)
private protected
function GetItem(Key: String): Pointer; function GetItem(Key: String): Pointer;
procedure SetItem(Key: String; const Value: Pointer); procedure SetItem(Key: String; const Value: Pointer);
@ -112,8 +112,8 @@ type
{ {
:$ Hash implementation for integer values :$ Hash implementation for integer values
} }
TX2UtIntegerHash = class(TX2UtHash) TX2IntegerHash = class(TX2Hash)
private protected
function GetItem(Key: String): Integer; function GetItem(Key: String): Integer;
procedure SetItem(Key: String; const Value: Integer); procedure SetItem(Key: String; const Value: Integer);
@ -131,15 +131,15 @@ type
{ {
:$ Hash implementation for string values :$ Hash implementation for string values
} }
TX2UtStringHash = class(TX2UtCustomHash) TX2StringHash = class(TX2CustomHash)
private protected
function GetItem(Key: String): String; function GetItem(Key: String): String;
procedure SetItem(Key: String; const Value: String); procedure SetItem(Key: String; const Value: String);
function GetCurrentValue(): String; function GetCurrentValue(): String;
protected protected
procedure InitHashItem(var AItem: PX2UtHashItem); override; procedure InitHashItem(var AItem: PX2HashItem); override;
procedure FreeHashItem(var AItem: PX2UtHashItem); override; procedure FreeHashItem(var AItem: PX2HashItem); override;
public public
constructor Create(); override; constructor Create(); override;
property CurrentKey; property CurrentKey;
@ -152,24 +152,46 @@ type
property CurrentValue: String read GetCurrentValue; property CurrentValue: String read GetCurrentValue;
end; 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 implementation
resourcestring resourcestring
RSEmptyKey = 'Cannot hash an empty key!'; RSEmptyKey = 'Cannot hash an empty key!';
{======================== TX2UtCustomHash {========================== TX2CustomHash
Initialization Initialization
========================================} ========================================}
constructor TX2UtCustomHash.Create; constructor TX2CustomHash.Create;
begin begin
inherited; inherited;
FHashItemSize := SizeOf(TX2UtHashItem); FHashItemSize := SizeOf(TX2HashItem);
DataSize := FHashItemSize; DataSize := FHashItemSize;
end; end;
{======================== TX2UtCustomHash {========================== TX2CustomHash
Hashing Hashing
========================================} ========================================}
procedure Mix(var A, B, C: Cardinal); 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; Dec(C, A); Dec(C, B); B := B shr 15; C := C xor B;
end; end;
function TX2UtCustomHash.Hash; function TX2CustomHash.Hash;
var var
iA: Cardinal; iA: Cardinal;
iB: Cardinal; iB: Cardinal;
@ -243,10 +265,10 @@ end;
{======================== TX2UtCustomHash {========================== TX2CustomHash
Tree Traversing Tree Traversing
========================================} ========================================}
function TX2UtCustomHash.ValidCursor; function TX2CustomHash.ValidCursor;
begin begin
Result := inherited ValidCursor(ARaiseError); Result := inherited ValidCursor(ARaiseError);
if Result then if Result then
@ -254,18 +276,18 @@ begin
Result := Assigned(FHashCursor); Result := Assigned(FHashCursor);
if (not Result) and (ARaiseError) then if (not Result) and (ARaiseError) then
raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor); raise EX2BTreeInvalidCursor.Create(RSInvalidCursor);
end; end;
end; end;
procedure TX2UtCustomHash.ClearCursor; procedure TX2CustomHash.ClearCursor;
begin begin
inherited; inherited;
FHashCursor := nil; FHashCursor := nil;
end; end;
function TX2UtCustomHash.Next; function TX2CustomHash.Next;
begin begin
if Assigned(FHashCursor) then if Assigned(FHashCursor) then
FHashCursor := FHashCursor^.Next; FHashCursor := FHashCursor^.Next;
@ -274,28 +296,28 @@ begin
begin begin
Result := inherited Next(); Result := inherited Next();
if Result then if Result then
FHashCursor := PX2UtHashList(GetNodeData(Cursor))^.Root; FHashCursor := PX2HashList(GetNodeData(Cursor))^.Root;
end else end else
Result := True; Result := True;
end; end;
{======================== TX2UtCustomHash {========================== TX2CustomHash
Item Management Item Management
========================================} ========================================}
function TX2UtCustomHash.GetItemData; function TX2CustomHash.GetItemData;
begin begin
Assert(HashDataSize > 0, RSInvalidDataSize); Assert(HashDataSize > 0, RSInvalidDataSize);
Result := Pointer(Cardinal(AItem) + HashItemSize); Result := Pointer(Cardinal(AItem) + HashItemSize);
end; end;
function TX2UtCustomHash.LookupItem; function TX2CustomHash.LookupItem;
var var
iIndex: Cardinal; iIndex: Cardinal;
pData: PX2UtHashList; pData: PX2HashList;
pFound: PX2UtHashItem; pFound: PX2HashItem;
pItem: PX2UtHashItem; pItem: PX2HashItem;
pLast: PX2UtHashItem; pLast: PX2HashItem;
begin begin
Result := nil; Result := nil;
@ -304,7 +326,7 @@ begin
if Assigned(ANode) then if Assigned(ANode) then
begin begin
pData := PX2UtHashList(GetNodeData(ANode)); pData := PX2HashList(GetNodeData(ANode));
pItem := pData^.Root; pItem := pData^.Root;
pLast := nil; pLast := nil;
@ -352,12 +374,12 @@ begin
end; end;
procedure TX2UtCustomHash.Delete; procedure TX2CustomHash.Delete;
var var
bFree: Boolean; bFree: Boolean;
pData: PX2UtHashList; pData: PX2HashList;
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
pItem: PX2UtHashItem; pItem: PX2HashItem;
begin begin
pItem := LookupItem(AKey, pNode); pItem := LookupItem(AKey, pNode);
@ -385,13 +407,13 @@ begin
inherited Delete(Hash(AKey)); inherited Delete(Hash(AKey));
end; end;
function TX2UtCustomHash.Exists; function TX2CustomHash.Exists;
begin begin
Result := inherited Exists(Hash(AKey), ASetCursor); Result := inherited Exists(Hash(AKey), ASetCursor);
end; end;
function TX2UtCustomHash.GetCurrentKey; function TX2CustomHash.GetCurrentKey;
begin begin
Result := ''; Result := '';
if ValidCursor(True) then if ValidCursor(True) then
@ -399,13 +421,13 @@ begin
end; end;
procedure TX2UtCustomHash.FreeNode; procedure TX2CustomHash.FreeNode;
var var
pData: PX2UtHashItem; pData: PX2HashItem;
pNext: PX2UtHashItem; pNext: PX2HashItem;
begin begin
pData := PX2UtHashList(GetNodeData(ANode))^.Root; pData := PX2HashList(GetNodeData(ANode))^.Root;
while Assigned(pData) do while Assigned(pData) do
begin begin
pNext := pData^.Next; pNext := pData^.Next;
@ -417,14 +439,14 @@ begin
end; end;
procedure TX2UtCustomHash.InitHashItem; procedure TX2CustomHash.InitHashItem;
begin begin
Assert(HashDataSize > 0, RSInvalidDataSize); Assert(HashDataSize > 0, RSInvalidDataSize);
GetMem(AItem, HashTotalSize); GetMem(AItem, HashTotalSize);
FillChar(AItem^, HashTotalSize, #0); FillChar(AItem^, HashTotalSize, #0);
end; end;
procedure TX2UtCustomHash.FreeHashItem; procedure TX2CustomHash.FreeHashItem;
begin begin
if Assigned(AItem^.Prev) then if Assigned(AItem^.Prev) then
AItem^.Prev^.Next := AItem^.Next; AItem^.Prev^.Next := AItem^.Next;
@ -439,26 +461,26 @@ begin
end; end;
function TX2UtCustomHash.GetHashTotalSize; function TX2CustomHash.GetHashTotalSize;
begin begin
Result := FHashItemSize + FHashDataSize; Result := FHashItemSize + FHashDataSize;
end; end;
{============================== TX2UtHash {================================ TX2Hash
Item Management Item Management
========================================} ========================================}
constructor TX2UtHash.Create; constructor TX2Hash.Create;
begin begin
inherited; inherited;
HashDataSize := SizeOf(Pointer); HashDataSize := SizeOf(Pointer);
end; end;
function TX2UtHash.GetItem; function TX2Hash.GetItem;
var var
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
pItem: PX2UtHashItem; pItem: PX2HashItem;
begin begin
Assert(Length(Key) > 0, RSEmptyKey); Assert(Length(Key) > 0, RSEmptyKey);
@ -467,10 +489,10 @@ begin
Result := PPointer(GetItemData(pItem))^; Result := PPointer(GetItemData(pItem))^;
end; end;
procedure TX2UtHash.SetItem; procedure TX2Hash.SetItem;
var var
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
pItem: PX2UtHashItem; pItem: PX2HashItem;
begin begin
Assert(Length(Key) > 0, RSEmptyKey); Assert(Length(Key) > 0, RSEmptyKey);
@ -479,7 +501,7 @@ begin
PPointer(GetItemData(pItem))^ := Value; PPointer(GetItemData(pItem))^ := Value;
end; end;
function TX2UtHash.GetCurrentValue; function TX2Hash.GetCurrentValue;
begin begin
Result := nil; Result := nil;
if ValidCursor() then if ValidCursor() then
@ -487,39 +509,39 @@ begin
end; end;
{======================= TX2UtIntegerHash {========================= TX2IntegerHash
Item Management Item Management
========================================} ========================================}
function TX2UtIntegerHash.GetItem; function TX2IntegerHash.GetItem;
begin begin
Result := Integer(inherited GetItem(Key)); Result := Integer(inherited GetItem(Key));
end; end;
procedure TX2UtIntegerHash.SetItem; procedure TX2IntegerHash.SetItem;
begin begin
inherited SetItem(Key, Pointer(Value)); inherited SetItem(Key, Pointer(Value));
end; end;
function TX2UtIntegerHash.GetCurrentValue; function TX2IntegerHash.GetCurrentValue;
begin begin
Result := Integer(inherited GetCurrentValue()); Result := Integer(inherited GetCurrentValue());
end; end;
{======================== TX2UtStringHash {========================== TX2StringHash
Item Management Item Management
========================================} ========================================}
constructor TX2UtStringHash.Create; constructor TX2StringHash.Create;
begin begin
inherited; inherited;
HashDataSize := SizeOf(PString); HashDataSize := SizeOf(PString);
end; end;
function TX2UtStringHash.GetItem; function TX2StringHash.GetItem;
var var
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
pItem: PX2UtHashItem; pItem: PX2HashItem;
begin begin
Assert(Length(Key) > 0, RSEmptyKey); Assert(Length(Key) > 0, RSEmptyKey);
@ -528,10 +550,10 @@ begin
Result := PString(GetItemData(pItem))^; Result := PString(GetItemData(pItem))^;
end; end;
procedure TX2UtStringHash.SetItem; procedure TX2StringHash.SetItem;
var var
pNode: PX2UtBTreeNode; pNode: PX2BTreeNode;
pItem: PX2UtHashItem; pItem: PX2HashItem;
begin begin
Assert(Length(Key) > 0, RSEmptyKey); Assert(Length(Key) > 0, RSEmptyKey);
@ -541,7 +563,7 @@ begin
end; end;
procedure TX2UtStringHash.InitHashItem; procedure TX2StringHash.InitHashItem;
var var
pData: PString; pData: PString;
@ -552,7 +574,7 @@ begin
Initialize(pData^); Initialize(pData^);
end; end;
procedure TX2UtStringHash.FreeHashItem; procedure TX2StringHash.FreeHashItem;
var var
pData: PString; pData: PString;
@ -564,11 +586,46 @@ begin
end; end;
function TX2UtStringHash.GetCurrentValue; function TX2StringHash.GetCurrentValue;
begin begin
Result := ''; Result := '';
if ValidCursor() then if ValidCursor() then
Result := PString(GetItemData(HashCursor))^; Result := PString(GetItemData(HashCursor))^;
end; 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. end.

59
X2UtSettings.pas
View File

@ -13,7 +13,8 @@ interface
uses uses
Classes, Classes,
SysUtils, SysUtils,
Variants; Variants,
X2UtHashes;
type type
//:$ Raised when an unregistered setting is requested without providing a //:$ Raised when an unregistered setting is requested without providing a
@ -27,6 +28,18 @@ type
//:$ Raised when the specified range is invalid. //:$ Raised when the specified range is invalid.
EX2SettingsRange = class(Exception); 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 // Forward declaration
TX2SettingsFactory = class; TX2SettingsFactory = class;
@ -124,6 +137,25 @@ type
//:: this into a compatible section. //:: this into a compatible section.
//:! The application is responsible for freeing the returned class. //:! The application is responsible for freeing the returned class.
property Sections[const ASection: String]: TX2Settings read GetSection; default; 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; end;
@ -151,53 +183,62 @@ end;
========================================} ========================================}
function TX2Settings.ReadBool(const AName: String): Boolean; function TX2Settings.ReadBool(const AName: String): Boolean;
begin begin
if not (ValueExists(AName) and InternalReadBool(AName, Result)) then if not InternalReadBool(AName, Result) then
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]); raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
end; end;
function TX2Settings.ReadBool(const AName: String; function TX2Settings.ReadBool(const AName: String;
const ADefault: Boolean): Boolean; const ADefault: Boolean): Boolean;
begin begin
if not (ValueExists(AName) and InternalReadBool(AName, Result)) then if not InternalReadBool(AName, Result) then
Result := ADefault; Result := ADefault;
end; end;
function TX2Settings.ReadFloat(const AName: String): Double; function TX2Settings.ReadFloat(const AName: String): Double;
begin begin
if not (ValueExists(AName) and InternalReadFloat(AName, Result)) then if not InternalReadFloat(AName, Result) then
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]); raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
end; end;
function TX2Settings.ReadFloat(const AName: String; function TX2Settings.ReadFloat(const AName: String;
const ADefault: Double): Double; const ADefault: Double): Double;
begin begin
if not (ValueExists(AName) and InternalReadFloat(AName, Result)) then if not InternalReadFloat(AName, Result) then
Result := ADefault; Result := ADefault;
end; end;
function TX2Settings.ReadInteger(const AName: String): Integer; function TX2Settings.ReadInteger(const AName: String): Integer;
begin begin
if not (ValueExists(AName) and InternalReadInteger(AName, Result)) then if not InternalReadInteger(AName, Result) then
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]); raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
end; end;
function TX2Settings.ReadInteger(const AName: String; function TX2Settings.ReadInteger(const AName: String;
const ADefault: Integer): Integer; const ADefault: Integer): Integer;
begin begin
if not (ValueExists(AName) and InternalReadInteger(AName, Result)) then if not InternalReadInteger(AName, Result) then
Result := ADefault; Result := ADefault;
end; end;
function TX2Settings.ReadString(const AName: String): String; function TX2Settings.ReadString(const AName: String): String;
begin begin
if not (ValueExists(AName) and InternalReadString(AName, Result)) then if not InternalReadString(AName, Result) then
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]); raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
end; end;
function TX2Settings.ReadString(const AName, ADefault: String): String; function TX2Settings.ReadString(const AName, ADefault: String): String;
begin begin
if not (ValueExists(AName) and InternalReadString(AName, Result)) then if not InternalReadString(AName, Result) then
Result := ADefault; Result := ADefault;
end; end;
{===================== TX2SettingsFactory
Defines
========================================}
procedure TX2SettingsFactory.Define;
begin
//
end;
end. end.

24
X2UtSettingsINI.pas
View File

@ -101,26 +101,34 @@ end;
========================================} ========================================}
function TX2INISettings.InternalReadBool; function TX2INISettings.InternalReadBool;
begin begin
AValue := FData.ReadBool(FSection, AName, False); Result := ValueExists(AName);
Result := True;
if Result then
AValue := FData.ReadBool(FSection, AName, False);
end; end;
function TX2INISettings.InternalReadFloat; function TX2INISettings.InternalReadFloat;
begin begin
AValue := FData.ReadFloat(FSection, AName, 0); Result := ValueExists(AName);
Result := True;
if Result then
AValue := FData.ReadFloat(FSection, AName, 0);
end; end;
function TX2INISettings.InternalReadInteger; function TX2INISettings.InternalReadInteger;
begin begin
AValue := FData.ReadInteger(FSection, AName, 0); Result := ValueExists(AName);
Result := True;
if Result then
AValue := FData.ReadInteger(FSection, AName, 0);
end; end;
function TX2INISettings.InternalReadString; function TX2INISettings.InternalReadString;
begin begin
AValue := FData.ReadString(FSection, AName, ''); Result := ValueExists(AName);
Result := True;
if Result then
AValue := FData.ReadString(FSection, AName, '');
end; end;

50
X2UtSettingsRegistry.pas
View File

@ -7,32 +7,6 @@
:: Last changed: $Date$ :: Last changed: $Date$
:: Revision: $Rev$ :: Revision: $Rev$
:: Author: $Author$ :: 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; unit X2UtSettingsRegistry;
@ -173,8 +147,10 @@ begin
if OpenRead() then if OpenRead() then
begin begin
AValue := FData.ReadBool(AName); Result := ValueExists(AName);
Result := True;
if Result then
AValue := FData.ReadBool(AName);
end; end;
end; end;
@ -184,8 +160,10 @@ begin
if OpenRead() then if OpenRead() then
begin begin
AValue := FData.ReadFloat(AName); Result := ValueExists(AName);
Result := True;
if Result then
AValue := FData.ReadFloat(AName);
end; end;
end; end;
@ -195,8 +173,10 @@ begin
if OpenRead() then if OpenRead() then
begin begin
AValue := FData.ReadInteger(AName); Result := ValueExists(AName);
Result := True;
if Result then
AValue := FData.ReadInteger(AName);
end; end;
end; end;
@ -206,8 +186,10 @@ begin
if OpenRead() then if OpenRead() then
begin begin
AValue := FData.ReadString(AName); Result := ValueExists(AName);
Result := True;
if Result then
AValue := FData.ReadString(AName);
end; end;
end; end;