GitHub-Mirror/x2utils
1
0
Fork 0
mirror of synced 2024-12-22 09:13:07 +01:00
Code Issues Projects Releases Wiki Activity

Added: X2UtStreams

Browse Source 
Added: X2UtMisc - InRange overloads
Added: X2UtMisc - RectWidth/RectHeight functions
Added: X2UtPersistForm/VirtualTree similar to X2UtSettingsForm/VirtualTree
Changed: X2UtPersist split into reader/writer classes
This commit is contained in:
Mark van Renswoude 2007-08-10 12:48:00 +00:00
parent 59d62f8d8c
commit b44732c18f
10 changed files with 1293 additions and 204 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

148
UnitTests/Units/PersistTest.pas
View File

@ -10,6 +10,8 @@ uses
type type
TPersistTest = class(TTestCase) TPersistTest = class(TTestCase)
published published
procedure QueryReaderWriter;
procedure WriteNoTypeInfo; procedure WriteNoTypeInfo;
procedure WriteSimpleTypes; procedure WriteSimpleTypes;
end; end;
@ -19,14 +21,44 @@ implementation
uses uses
SysUtils, SysUtils,
X2UtPersist; X2UtPersist,
X2UtPersistIntf;
type type
IPersistTestOutput = interface
['{F0BFDA30-B2BF-449D-9A6E-0EDEBCDAE701}']
function GetLines(): TStrings;
property Lines: TStrings read GetLines;
end;
TPersistTestOutput = class(TInterfacedObject, IPersistTestOutput)
private
FLines: TStrings;
protected
function GetLines(): TStrings;
public
constructor Create();
destructor Destroy(); override;
end;
TX2UtPersistTest = class(TX2CustomPersist) TX2UtPersistTest = class(TX2CustomPersist)
private private
FOutput: TStrings; FOutput: IPersistTestOutput;
protected protected
function CreateFiler(AIsReader: Boolean): IX2PersistFiler; override;
public
constructor Create();
property Output: IPersistTestOutput read FOutput;
end;
TX2UtPersistTestFiler = class(TX2CustomPersistFiler)
private
FOutput: IPersistTestOutput;
public
function BeginSection(const AName: String): Boolean; override; function BeginSection(const AName: String): Boolean; override;
procedure EndSection(); override; procedure EndSection(); override;
@ -39,13 +71,8 @@ type
function WriteInt64(const AName: String; AValue: Int64): Boolean; override; function WriteInt64(const AName: String; AValue: Int64): Boolean; override;
function WriteInteger(const AName: String; AValue: Integer): Boolean; override; function WriteInteger(const AName: String; AValue: Integer): Boolean; override;
function WriteString(const AName: String; const AValue: String): Boolean; override; function WriteString(const AName: String; const AValue: String): Boolean; override;
public
constructor Create();
destructor Destroy(); override;
procedure Write(AObject: TObject); override; property Output: IPersistTestOutput read FOutput write FOutput;
property Output: TStrings read FOutput;
end; end;
@ -83,6 +110,32 @@ end;
{ TPersistTest } { TPersistTest }
procedure TPersistTest.QueryReaderWriter;
var
persistTest: TX2UtPersistTest;
begin
persistTest := TX2UtPersistTest.Create();
try
{ Regular filer }
CheckTrue(Supports(persistTest.CreateReader(), IX2PersistReader), 'Reader -> Reader');
CheckFalse(Supports(persistTest.CreateReader(), IX2PersistWriter), 'Reader -> Writer');
CheckTrue(Supports(persistTest.CreateWriter(), IX2PersistWriter), 'Writer -> Writer');
CheckFalse(Supports(persistTest.CreateWriter(), IX2PersistReader), 'Writer -> Reader');
{ Section proxy }
CheckTrue(Supports(persistTest.CreateSectionReader('Test.Section'), IX2PersistReader), 'Section Reader -> Reader');
CheckFalse(Supports(persistTest.CreateSectionReader('Test.Section'), IX2PersistWriter), 'Section Reader -> Writer');
CheckTrue(Supports(persistTest.CreateSectionWriter('Test.Section'), IX2PersistWriter), 'Section Writer -> Writer');
CheckFalse(Supports(persistTest.CreateSectionWriter('Test.Section'), IX2PersistReader), 'Section Writer -> Reader');
finally
FreeAndNil(persistTest);
end;
end;
procedure TPersistTest.WriteNoTypeInfo; procedure TPersistTest.WriteNoTypeInfo;
var var
testObject: TTypeInfoLess; testObject: TTypeInfoLess;
@ -94,7 +147,7 @@ begin
try try
Write(testObject); Write(testObject);
CheckEquals('', Output.Text); CheckEquals('', Output.Lines.Text);
finally finally
Free; Free;
end; end;
@ -114,7 +167,7 @@ begin
try try
Write(testObject); Write(testObject);
CheckEquals('Integer:42'#13#10, Output.Text); CheckEquals('Integer:42'#13#10, Output.Lines.Text);
finally finally
Free; Free;
end; end;
@ -129,93 +182,112 @@ constructor TX2UtPersistTest.Create();
begin begin
inherited; inherited;
FOutput := TStringList.Create(); FOutput := TPersistTestOutput.Create();
end; end;
destructor TX2UtPersistTest.Destroy(); function TX2UtPersistTest.CreateFiler(AIsReader: Boolean): IX2PersistFiler;
var
testFiler: TX2UtPersistTestFiler;
begin begin
FreeAndNil(FOutput); testFiler := TX2UtPersistTestFiler.Create(AIsReader);;
testFiler.Output := Self.Output;
inherited; Result := testFiler;
end; end;
procedure TX2UtPersistTest.Write(AObject: TObject); { TX2UtPersistTestFiler }
begin function TX2UtPersistTestFiler.BeginSection(const AName: String): Boolean;
Output.Clear();
inherited;
end;
function TX2UtPersistTest.BeginSection(const AName: String): Boolean;
begin begin
Result := inherited BeginSection(AName); Result := inherited BeginSection(AName);
if Result then if Result then
Output.Add(AName + ' {'); Output.Lines.Add(AName + ' {');
end; end;
procedure TX2UtPersistTest.EndSection(); procedure TX2UtPersistTestFiler.EndSection();
begin begin
Output.Add('}'); Output.Lines.Add('}');
inherited EndSection(); inherited EndSection();
end; end;
function TX2UtPersistTest.ReadFloat(const AName: String; out AValue: Extended): Boolean; function TX2UtPersistTestFiler.ReadFloat(const AName: String; out AValue: Extended): Boolean;
begin begin
Result := False; Result := False;
end; end;
function TX2UtPersistTest.ReadInt64(const AName: String; out AValue: Int64): Boolean; function TX2UtPersistTestFiler.ReadInt64(const AName: String; out AValue: Int64): Boolean;
begin begin
Result := False; Result := False;
end; end;
function TX2UtPersistTest.ReadInteger(const AName: String; out AValue: Integer): Boolean; function TX2UtPersistTestFiler.ReadInteger(const AName: String; out AValue: Integer): Boolean;
begin begin
Result := False; Result := False;
end; end;
function TX2UtPersistTest.ReadString(const AName: String; out AValue: String): Boolean; function TX2UtPersistTestFiler.ReadString(const AName: String; out AValue: String): Boolean;
begin begin
Result := False; Result := False;
end; end;
function TX2UtPersistTest.WriteFloat(const AName: String; AValue: Extended): Boolean; function TX2UtPersistTestFiler.WriteFloat(const AName: String; AValue: Extended): Boolean;
begin begin
Output.Add(Format('Float:%.2f', [AValue])); Output.Lines.Add(Format('Float:%.2f', [AValue]));
Result := True; Result := True;
end; end;
function TX2UtPersistTest.WriteInt64(const AName: String; AValue: Int64): Boolean; function TX2UtPersistTestFiler.WriteInt64(const AName: String; AValue: Int64): Boolean;
begin begin
Output.Add(Format('Int64:%d', [AValue])); Output.Lines.Add(Format('Int64:%d', [AValue]));
Result := True; Result := True;
end; end;
function TX2UtPersistTest.WriteInteger(const AName: String; AValue: Integer): Boolean; function TX2UtPersistTestFiler.WriteInteger(const AName: String; AValue: Integer): Boolean;
begin begin
Output.Add(Format('Integer:%d', [AValue])); Output.Lines.Add(Format('Integer:%d', [AValue]));
Result := True; Result := True;
end; end;
function TX2UtPersistTest.WriteString(const AName, AValue: String): Boolean; function TX2UtPersistTestFiler.WriteString(const AName, AValue: String): Boolean;
begin begin
Output.Add(Format('String:%s', [AValue])); Output.Lines.Add(Format('String:%s', [AValue]));
Result := True; Result := True;
end; end;
{ TPersistTestOutput }
constructor TPersistTestOutput.Create();
begin
inherited;
FLines := TStringList.Create();
end;
destructor TPersistTestOutput.Destroy();
begin
FreeAndNil(FLines);
inherited;
end;
function TPersistTestOutput.GetLines(): TStrings;
begin
Result := FLines;
end;
initialization initialization
RegisterTest(TPersistTest.Suite); RegisterTest(TPersistTest.Suite);

2
UnitTests/X2UtUnitTests.dpr
View File

@ -13,7 +13,7 @@ uses
//IniParserTest in 'Units\IniParserTest.pas'; //IniParserTest in 'Units\IniParserTest.pas';
begin begin
// MemChk(); ReportMemoryLeaksOnShutdown := True;
RunRegisteredTests(); RunRegisteredTests();
end. end.

72
X2UtMisc.pas
View File

@ -9,6 +9,10 @@
unit X2UtMisc; unit X2UtMisc;
interface interface
uses
Types;
//:$ Returns IfTrue or IfFalse depending on the Value //:$ Returns IfTrue or IfFalse depending on the Value
function iif(const AValue: Boolean; const AIfTrue: Integer; function iif(const AValue: Boolean; const AIfTrue: Integer;
const AIfFalse: Integer = 0): Integer; overload; const AIfFalse: Integer = 0): Integer; overload;
@ -44,11 +48,23 @@ interface
//:$ Checks if the value is within the specified range //:$ Checks if the value is within the specified range
//:: Returns the Default parameter is the range is exceeded, otherwise //:: Returns the Default parameter is the range is exceeded, otherwise
//:: the value is returned. //:: the value is returned. The overloads without a Default parameter
function InRange(const AValue, AMin, AMax, ADefault: Integer): Integer; //:: return the nearest Min or Max value.
function InRange(const AValue, AMin, AMax, ADefault: Integer): Integer; overload;
function InRange(const AValue, AMin, AMax, ADefault: Int64): Int64; overload;
function InRange(const AValue, AMin, AMax: Integer): Integer; overload;
function InRange(const AValue, AMin, AMax: Int64): Int64; overload;
//:$ Returns the width of a rectangle
function RectWidth(const ARect: TRect): Integer; inline;
//:$ Returns the height of a rectangle
function RectHeight(const ARect: TRect): Integer; inline;
implementation implementation
function iif(const AValue: Boolean; const AIfTrue, AIfFalse: Integer): Integer; function iif(const AValue: Boolean; const AIfTrue, AIfFalse: Integer): Integer;
begin begin
if AValue then if AValue then
@ -57,6 +73,7 @@ begin
Result := AIfFalse; Result := AIfFalse;
end; end;
function iif(const AValue: Boolean; const AIfTrue, AIfFalse: String): String; function iif(const AValue: Boolean; const AIfTrue, AIfFalse: String): String;
begin begin
if AValue then if AValue then
@ -65,6 +82,7 @@ begin
Result := AIfFalse; Result := AIfFalse;
end; end;
function CompareInt(const AValue1, AValue2: Integer): Integer; function CompareInt(const AValue1, AValue2: Integer): Integer;
begin begin
Result := 0; Result := 0;
@ -74,6 +92,7 @@ begin
Result := -1; Result := -1;
end; end;
function CompareInt(const AValue1, AValue2: Cardinal): Integer; function CompareInt(const AValue1, AValue2: Cardinal): Integer;
begin begin
Result := 0; Result := 0;
@ -83,6 +102,7 @@ begin
Result := -1; Result := -1;
end; end;
function CompareInt(const AValue1, AValue2: Int64): Integer; function CompareInt(const AValue1, AValue2: Int64): Integer;
begin begin
Result := 0; Result := 0;
@ -92,6 +112,7 @@ begin
Result := -1; Result := -1;
end; end;
function CompareFloat(const AValue1, AValue2: Single): Integer; function CompareFloat(const AValue1, AValue2: Single): Integer;
begin begin
Result := 0; Result := 0;
@ -101,6 +122,7 @@ begin
Result := -1; Result := -1;
end; end;
function CompareFloat(const AValue1, AValue2: Double): Integer; function CompareFloat(const AValue1, AValue2: Double): Integer;
begin begin
Result := 0; Result := 0;
@ -110,7 +132,8 @@ begin
Result := -1; Result := -1;
end; end;
function InRange;
function InRange(const AValue, AMin, AMax, ADefault: Integer): Integer;
begin begin
Result := ADefault; Result := ADefault;
@ -118,4 +141,47 @@ begin
Result := AValue; Result := AValue;
end; end;
function InRange(const AValue, AMin, AMax, ADefault: Int64): Int64;
begin
Result := ADefault;
if (AValue >= AMin) and (AValue <= AMax) then
Result := AValue;
end;
function InRange(const AValue, AMin, AMax: Integer): Integer;
begin
Result := AValue;
if Result < AMin then
Result := AMin
else if Result > AMax then
Result := AMax;
end;
function InRange(const AValue, AMin, AMax: Int64): Int64;
begin
Result := AValue;
if Result < AMin then
Result := AMin
else if Result > AMax then
Result := AMax;
end;
function RectWidth(const ARect: TRect): Integer;
begin
Result := (ARect.Right - ARect.Left);
end;
function RectHeight(const ARect: TRect): Integer;
begin
Result := (ARect.Bottom - ARect.Top);
end;
end. end.

526
X2UtPersist.pas
View File

@ -1,66 +1,101 @@
{
:: X2UtPersist provides a framework for persisting objects and settings.
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2UtPersist; unit X2UtPersist;
interface interface
uses uses
Classes, Classes,
Contnrs,
Types, Types,
TypInfo; TypInfo,
X2UtPersistIntf;
type type
TX2IterateObjectProc = procedure(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean) of object; TX2IterateObjectProc = procedure(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean) of object;
TX2CustomPersist = class(TObject)
TX2CustomPersist = class(TInterfacedPersistent, IX2Persist)
protected
function CreateFiler(AIsReader: Boolean): IX2PersistFiler; virtual; abstract;
public
function Read(AObject: TObject): Boolean; virtual;
procedure Write(AObject: TObject); virtual;
function CreateReader(): IX2PersistReader; virtual;
function CreateWriter(): IX2PersistWriter; virtual;
function CreateSectionReader(const ASection: String): IX2PersistReader; virtual;
function CreateSectionWriter(const ASection: String): IX2PersistWriter; virtual;
end;
TX2CustomPersistFiler = class(TInterfacedObject, IInterface, IX2PersistFiler,
IX2PersistReader, IX2PersistWriter)
private private
FIsReader: Boolean;
FSections: TStrings; FSections: TStrings;
protected protected
{ IInterface }
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function IterateObject(AObject: TObject; ACallback: TX2IterateObjectProc): Boolean; virtual; function IterateObject(AObject: TObject; ACallback: TX2IterateObjectProc): Boolean; virtual;
procedure ReadObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean); procedure ReadObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean); virtual;
procedure WriteObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean); procedure WriteObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean); virtual;
protected
function DoRead(AObject: TObject): Boolean; virtual;
procedure DoWrite(AObject: TObject); virtual;
property IsReader: Boolean read FIsReader;
property Sections: TStrings read FSections;
public
constructor Create(AIsReader: Boolean);
destructor Destroy(); override;
{ IX2PersistFiler }
function BeginSection(const AName: String): Boolean; virtual; function BeginSection(const AName: String): Boolean; virtual;
procedure EndSection(); virtual; procedure EndSection(); virtual;
procedure GetKeys(const ADest: TStrings); virtual; abstract;
procedure GetSections(const ADest: TStrings); virtual; abstract;
{ IX2PersistReader }
function Read(AObject: TObject): Boolean; virtual;
function ReadBoolean(const AName: String; out AValue: Boolean): Boolean; virtual;
function ReadInteger(const AName: String; out AValue: Integer): Boolean; virtual; abstract; function ReadInteger(const AName: String; out AValue: Integer): Boolean; virtual; abstract;
function ReadFloat(const AName: String; out AValue: Extended): Boolean; virtual; abstract; function ReadFloat(const AName: String; out AValue: Extended): Boolean; virtual; abstract;
function ReadString(const AName: String; out AValue: String): Boolean; virtual; abstract; function ReadString(const AName: String; out AValue: String): Boolean; virtual; abstract;
function ReadInt64(const AName: String; out AValue: Int64): Boolean; virtual; abstract; function ReadInt64(const AName: String; out AValue: Int64): Boolean; virtual; abstract;
function ReadStream(const AName: String; AStream: TStream): Boolean; virtual;
procedure ReadCollection(const AName: String; ACollection: TCollection); virtual; procedure ReadCollection(ACollection: TCollection); virtual;
procedure ReadStream(const AName: String; AStream: TStream); virtual;
{ IX2PersistWriter }
procedure Write(AObject: TObject); virtual;
function WriteBoolean(const AName: String; AValue: Boolean): Boolean; virtual;
function WriteInteger(const AName: String; AValue: Integer): Boolean; virtual; abstract; function WriteInteger(const AName: String; AValue: Integer): Boolean; virtual; abstract;
function WriteFloat(const AName: String; AValue: Extended): Boolean; virtual; abstract; function WriteFloat(const AName: String; AValue: Extended): Boolean; virtual; abstract;
function WriteString(const AName, AValue: String): Boolean; virtual; abstract; function WriteString(const AName, AValue: String): Boolean; virtual; abstract;
function WriteInt64(const AName: String; AValue: Int64): Boolean; virtual; abstract; function WriteInt64(const AName: String; AValue: Int64): Boolean; virtual; abstract;
function WriteStream(const AName: String; AStream: TStream): Boolean; virtual;
procedure ClearCollection(); virtual; procedure ClearCollection(); virtual;
procedure WriteCollection(const AName: String; ACollection: TCollection); virtual; procedure WriteCollection(ACollection: TCollection); virtual;
procedure WriteStream(const AName: String; AStream: TStream); virtual;
procedure DeleteKey(const AName: String); virtual; abstract;
property Sections: TStrings read FSections; procedure DeleteSection(const AName: String); virtual; abstract;
public
constructor Create();
destructor Destroy(); override;
function Read(AObject: TObject): Boolean; virtual;
procedure Write(AObject: TObject); virtual;
end; end;
const
CollectionCountName = 'Count';
CollectionItemNamePrefix = 'Item';
implementation implementation
uses uses
SysUtils, SysUtils,
@ -68,16 +103,110 @@ uses
X2UtStrings; X2UtStrings;
{ TX2CustomPersist } type
constructor TX2CustomPersist.Create(); { This class has to proxy all the interfaces in order for
begin reference counting to go through this class. }
inherited; TX2PersistSectionFilerProxy = class(TInterfacedObject, IInterface,
IX2PersistFiler, IX2PersistReader,
IX2PersistWriter)
private
FFiler: IX2PersistFiler;
FSectionCount: Integer;
protected
property SectionCount: Integer read FSectionCount;
property Filer: IX2PersistFiler read FFiler;
{ IInterface }
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
{ IX2PersistFiler }
function BeginSection(const AName: String): Boolean;
procedure EndSection();
procedure GetKeys(const ADest: TStrings);
procedure GetSections(const ADest: TStrings);
{ IX2PersistReader }
function Read(AObject: TObject): Boolean;
function ReadBoolean(const AName: string; out AValue: Boolean): Boolean;
function ReadInteger(const AName: String; out AValue: Integer): Boolean;
function ReadFloat(const AName: String; out AValue: Extended): Boolean;
function ReadString(const AName: String; out AValue: String): Boolean;
function ReadInt64(const AName: String; out AValue: Int64): Boolean;
function ReadStream(const AName: String; AStream: TStream): Boolean;
{ IX2PersistWriter }
procedure Write(AObject: TObject);
function WriteBoolean(const AName: String; AValue: Boolean): Boolean;
function WriteInteger(const AName: String; AValue: Integer): Boolean;
function WriteFloat(const AName: String; AValue: Extended): Boolean;
function WriteString(const AName, AValue: String): Boolean;
function WriteInt64(const AName: String; AValue: Int64): Boolean;
function WriteStream(const AName: String; AStream: TStream): Boolean;
procedure DeleteKey(const AName: String);
procedure DeleteSection(const AName: String);
public
constructor Create(const AFiler: IX2PersistFiler; const ASection: String);
destructor Destroy(); override;
end;
{ TX2CustomPersist }
function TX2CustomPersist.CreateReader(): IX2PersistReader;
begin
Result := (CreateFiler(True) as IX2PersistReader);
end;
function TX2CustomPersist.CreateWriter(): IX2PersistWriter;
begin
Result := (CreateFiler(False) as IX2PersistWriter);
end;
function TX2CustomPersist.CreateSectionReader(const ASection: String): IX2PersistReader;
begin
Result := (TX2PersistSectionFilerProxy.Create(CreateReader(), ASection) as IX2PersistReader);
end;
function TX2CustomPersist.CreateSectionWriter(const ASection: String): IX2PersistWriter;
begin
Result := (TX2PersistSectionFilerProxy.Create(CreateWriter(), ASection) as IX2PersistWriter);
end;
function TX2CustomPersist.Read(AObject: TObject): Boolean;
begin
with CreateReader() do
Result := Read(AObject);
end;
procedure TX2CustomPersist.Write(AObject: TObject);
begin
with CreateWriter() do
Write(AObject);
end;
{ TX2CustomPersistFiler }
constructor TX2CustomPersistFiler.Create(AIsReader: Boolean);
begin
inherited Create();
FIsReader := AIsReader;
FSections := TStringList.Create(); FSections := TStringList.Create();
end; end;
destructor TX2CustomPersist.Destroy(); destructor TX2CustomPersistFiler.Destroy();
begin begin
FreeAndNil(FSections); FreeAndNil(FSections);
@ -85,7 +214,37 @@ begin
end; end;
function TX2CustomPersist.IterateObject(AObject: TObject; ACallback: TX2IterateObjectProc): Boolean; function TX2CustomPersistFiler.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
Pointer(Obj) := nil;
Result := E_NOINTERFACE;
{ A filer is one-way, prevent the wrong interface from being obtained }
if IsEqualGUID(IID, IX2PersistReader) and (not IsReader) then
Exit;
if IsEqualGUID(IID, IX2PersistWriter) and IsReader then
Exit;
Result := inherited QueryInterface(IID, Obj);
end;
function TX2CustomPersistFiler.BeginSection(const AName: String): Boolean;
begin
FSections.Add(AName);
Result := True;
end;
procedure TX2CustomPersistFiler.EndSection();
begin
Assert(FSections.Count > 0, 'EndSection called without BeginSection');
FSections.Delete(Pred(FSections.Count));
end;
function TX2CustomPersistFiler.IterateObject(AObject: TObject; ACallback: TX2IterateObjectProc): Boolean;
var var
propCount: Integer; propCount: Integer;
propList: PPropList; propList: PPropList;
@ -125,50 +284,35 @@ begin
end; end;
function TX2CustomPersist.Read(AObject: TObject): Boolean; function TX2CustomPersistFiler.Read(AObject: TObject): Boolean;
var
customDataIntf: IX2PersistCustomData;
begin begin
Assert(Assigned(AObject), 'AObject must be assigned.'); Assert(Assigned(AObject), 'AObject must be assigned.');
Result := DoRead(AObject);
if AObject is TCollection then
ReadCollection(TCollection(AObject));
Result := IterateObject(AObject, ReadObject);
if Result and Supports(AObject, IX2PersistCustomData, customDataIntf) then
customDataIntf.Read(Self);
end; end;
procedure TX2CustomPersist.Write(AObject: TObject); function TX2CustomPersistFiler.ReadBoolean(const AName: String; out AValue: Boolean): Boolean;
var
value: String;
begin begin
Assert(Assigned(AObject), 'AObject must be assigned.'); AValue := False;
DoWrite(AObject); Result := ReadString(AName, value) and
TryStrToBool(value, AValue);
end; end;
procedure TX2CustomPersistFiler.ReadObject(AObject: TObject; APropInfo: PPropInfo;
function TX2CustomPersist.DoRead(AObject: TObject): Boolean;
begin
IterateObject(AObject, ReadObject);
Result := True;
end;
procedure TX2CustomPersist.DoWrite(AObject: TObject);
begin
IterateObject(AObject, WriteObject);
end;
function TX2CustomPersist.BeginSection(const AName: String): Boolean;
begin
FSections.Add(AName);
Result := True;
end;
procedure TX2CustomPersist.EndSection();
begin
Assert(FSections.Count > 0, 'EndSection called without BeginSection');
FSections.Delete(Pred(FSections.Count));
end;
procedure TX2CustomPersist.ReadObject(AObject: TObject; APropInfo: PPropInfo;
var AContinue: Boolean); var AContinue: Boolean);
var var
ordValue: Integer; ordValue: Integer;
@ -240,10 +384,7 @@ begin
{ Recurse into object properties } { Recurse into object properties }
if BeginSection(APropInfo^.Name) then if BeginSection(APropInfo^.Name) then
try try
if objectProp is TCollection then AContinue := Read(objectProp);
ReadCollection(APropInfo^.Name, TCollection(objectProp));
AContinue := IterateObject(objectProp, ReadObject);
finally finally
EndSection(); EndSection();
end; end;
@ -254,7 +395,29 @@ begin
end; end;
procedure TX2CustomPersist.WriteObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean); procedure TX2CustomPersistFiler.Write(AObject: TObject);
var
customDataIntf: IX2PersistCustomData;
begin
Assert(Assigned(AObject), 'AObject must be assigned.');
if AObject is TCollection then
WriteCollection(TCollection(AObject));
if IterateObject(AObject, WriteObject) and
Supports(AObject, IX2PersistCustomData, customDataIntf) then
customDataIntf.Write(Self);
end;
function TX2CustomPersistFiler.WriteBoolean(const AName: String; AValue: Boolean): Boolean;
begin
Result := WriteString(AName, BoolToStr(AValue, True));
end;
procedure TX2CustomPersistFiler.WriteObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean);
var var
ordValue: Integer; ordValue: Integer;
floatValue: Extended; floatValue: Extended;
@ -332,10 +495,7 @@ begin
{ Recurse into object properties } { Recurse into object properties }
if BeginSection(APropInfo^.Name) then if BeginSection(APropInfo^.Name) then
try try
if objectProp is TCollection then Write(objectProp);
WriteCollection(APropInfo^.Name, TCollection(objectProp));
AContinue := IterateObject(objectProp, WriteObject);
finally finally
EndSection(); EndSection();
end; end;
@ -346,7 +506,7 @@ begin
end; end;
procedure TX2CustomPersist.ReadCollection(const AName: String; ACollection: TCollection); procedure TX2CustomPersistFiler.ReadCollection(ACollection: TCollection);
var var
itemCount: Integer; itemCount: Integer;
itemIndex: Integer; itemIndex: Integer;
@ -364,7 +524,7 @@ begin
if BeginSection(CollectionItemNamePrefix + IntToStr(itemIndex)) then if BeginSection(CollectionItemNamePrefix + IntToStr(itemIndex)) then
try try
collectionItem := ACollection.Add(); collectionItem := ACollection.Add();
IterateObject(collectionItem, ReadObject); Read(collectionItem);
finally finally
EndSection(); EndSection();
end; end;
@ -376,18 +536,39 @@ begin
end; end;
procedure TX2CustomPersist.ReadStream(const AName: String; AStream: TStream); function TX2CustomPersistFiler.ReadStream(const AName: String; AStream: TStream): Boolean;
var
data: String;
begin begin
// #ToDo1 (MvR) 8-6-2007: ReadStream Result := ReadString(AName, data);
if Result then
AStream.WriteBuffer(PChar(data)^, Length(data));
end; end;
procedure TX2CustomPersist.ClearCollection(); procedure TX2CustomPersistFiler.ClearCollection();
var
keyNames: TStringList;
keyIndex: Integer;
begin begin
inherited;
keyNames := TStringList.Create();
try
GetKeys(keyNames);
for keyIndex := 0 to Pred(keyNames.Count) do
if SameTextS(keyNames[keyIndex], CollectionItemNamePrefix) then
DeleteKey(keyNames[keyIndex]);
finally
FreeAndNil(keyNames);
end;
end; end;
procedure TX2CustomPersist.WriteCollection(const AName: String; ACollection: TCollection); procedure TX2CustomPersistFiler.WriteCollection(ACollection: TCollection);
var var
itemIndex: Integer; itemIndex: Integer;
@ -399,16 +580,193 @@ begin
begin begin
if BeginSection(CollectionItemNamePrefix + IntToStr(itemIndex)) then if BeginSection(CollectionItemNamePrefix + IntToStr(itemIndex)) then
try try
IterateObject(ACollection.Items[itemIndex], WriteObject); Write(ACollection.Items[itemIndex]);
finally finally
EndSection(); EndSection();
end; end;
end; end;
end; end;
procedure TX2CustomPersist.WriteStream(const AName: String; AStream: TStream);
function TX2CustomPersistFiler.WriteStream(const AName: String; AStream: TStream): Boolean;
var
data: String;
begin begin
// #ToDo1 (MvR) 8-6-2007: WriteStream Result := True;
AStream.Position := 0;
SetLength(data, AStream.Size);
AStream.ReadBuffer(PChar(data)^, AStream.Size);
WriteString(AName, data);
end;
{ TX2PersistSectionFilerProxy }
constructor TX2PersistSectionFilerProxy.Create(const AFiler: IX2PersistFiler; const ASection: String);
var
sections: TSplitArray;
sectionIndex: Integer;
begin
inherited Create();
FFiler := AFiler;
Split(ASection, SectionSeparator, sections);
FSectionCount := Length(sections);
for sectionIndex := Low(sections) to High(sections) do
Filer.BeginSection(sections[sectionIndex]);
end;
destructor TX2PersistSectionFilerProxy.Destroy();
var
sectionIndex: Integer;
begin
for sectionIndex := 0 to Pred(SectionCount) do
Filer.EndSection();
inherited;
end;
function TX2PersistSectionFilerProxy.QueryInterface(const IID: TGUID; out Obj): HResult;
var
filerInterface: IInterface;
begin
{ Only return interfaces supported by the filer
- see TX2CustomPersistFiler.QueryInterface }
if Filer.QueryInterface(IID, filerInterface) = S_OK then
{ ...but always return the proxy version of the interface to prevent
issues with reference counting. }
Result := inherited QueryInterface(IID, Obj)
else
Result := E_NOINTERFACE;
end;
function TX2PersistSectionFilerProxy.BeginSection(const AName: String): Boolean;
begin
Result := Filer.BeginSection(AName);
end;
procedure TX2PersistSectionFilerProxy.EndSection();
begin
Filer.EndSection();
end;
procedure TX2PersistSectionFilerProxy.GetKeys(const ADest: TStrings);
begin
Filer.GetKeys(ADest);
end;
procedure TX2PersistSectionFilerProxy.GetSections(const ADest: TStrings);
begin
Filer.GetSections(ADest);
end;
function TX2PersistSectionFilerProxy.Read(AObject: TObject): Boolean;
begin
Result := (Filer as IX2PersistReader).Read(AObject);
end;
function TX2PersistSectionFilerProxy.ReadBoolean(const AName: string; out AValue: Boolean): Boolean;
begin
Result := (Filer as IX2PersistReader).ReadBoolean(AName, AValue);
end;
function TX2PersistSectionFilerProxy.ReadInteger(const AName: String; out AValue: Integer): Boolean;
begin
Result := (Filer as IX2PersistReader).ReadInteger(AName, AValue);
end;
function TX2PersistSectionFilerProxy.ReadFloat(const AName: String; out AValue: Extended): Boolean;
begin
Result := (Filer as IX2PersistReader).ReadFloat(AName, AValue);
end;
function TX2PersistSectionFilerProxy.ReadString(const AName: String; out AValue: String): Boolean;
begin
Result := (Filer as IX2PersistReader).ReadString(AName, AValue);
end;
function TX2PersistSectionFilerProxy.ReadInt64(const AName: String; out AValue: Int64): Boolean;
begin
Result := (Filer as IX2PersistReader).ReadInt64(AName, AValue);
end;
function TX2PersistSectionFilerProxy.ReadStream(const AName: String; AStream: TStream): Boolean;
begin
Result := (Filer as IX2PersistReader).ReadStream(AName, AStream);
end;
procedure TX2PersistSectionFilerProxy.Write(AObject: TObject);
begin
(Filer as IX2PersistWriter).Write(AObject);
end;
function TX2PersistSectionFilerProxy.WriteBoolean(const AName: String; AValue: Boolean): Boolean;
begin
Result := (Filer as IX2PersistWriter).WriteBoolean(AName, AValue);
end;
function TX2PersistSectionFilerProxy.WriteInteger(const AName: String; AValue: Integer): Boolean;
begin
Result := (Filer as IX2PersistWriter).WriteInteger(AName, AValue);
end;
function TX2PersistSectionFilerProxy.WriteFloat(const AName: String; AValue: Extended): Boolean;
begin
Result := (Filer as IX2PersistWriter).WriteFloat(AName, AValue);
end;
function TX2PersistSectionFilerProxy.WriteString(const AName, AValue: String): Boolean;
begin
Result := (Filer as IX2PersistWriter).WriteString(AName, AValue);
end;
function TX2PersistSectionFilerProxy.WriteInt64(const AName: String; AValue: Int64): Boolean;
begin
Result := (Filer as IX2PersistWriter).WriteInt64(AName, AValue);
end;
function TX2PersistSectionFilerProxy.WriteStream(const AName: String; AStream: TStream): Boolean;
begin
Result := (Filer as IX2PersistWriter).WriteStream(AName, AStream);
end;
procedure TX2PersistSectionFilerProxy.DeleteKey(const AName: String);
begin
(Filer as IX2PersistWriter).DeleteKey(AName);
end;
procedure TX2PersistSectionFilerProxy.DeleteSection(const AName: String);
begin
(Filer as IX2PersistWriter).DeleteSection(AName);
end; end;
end. end.

160
X2UtPersistForm.pas Normal file
View File

@ -0,0 +1,160 @@
{
:: X2UtPersistForm provides functions to read and write form settings.
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2UtPersistForm;
interface
uses
Classes,
Forms,
Windows,
X2UtPersistIntf;
type
TX2FormPosSettings = class(TPersistent)
private
FHeight: Integer;
FLeft: Integer;
FMaximized: Boolean;
FTop: Integer;
FWidth: Integer;
function GetBounds(): TRect;
procedure SetBounds(const Value: TRect);
protected
procedure AssignTo(Dest: TPersistent); override;
public
procedure Assign(Source: TPersistent); override;
property Bounds: TRect read GetBounds write SetBounds;
published
property Maximized: Boolean read FMaximized write FMaximized;
property Left: Integer read FLeft write FLeft;
property Top: Integer read FTop write FTop;
property Width: Integer read FWidth write FWidth;
property Height: Integer read FHeight write FHeight;
end;
procedure ReadFormPos(const AReader: IX2PersistReader; const AForm: TCustomForm);
procedure WriteFormPos(const AWriter: IX2PersistWriter; const AForm: TCustomForm);
implementation
uses
MultiMon,
SysUtils,
Types,
X2UtMisc;
type
TProtectedCustomForm = class(TCustomForm);
procedure ReadFormPos(const AReader: IX2PersistReader; const AForm: TCustomForm);
var
formPos: TX2FormPosSettings;
begin
formPos := TX2FormPosSettings.Create();
try
formPos.Assign(AForm);
AReader.Read(formPos);
AForm.Assign(formPos);
finally
FreeAndNil(formPos);
end;
end;
procedure WriteFormPos(const AWriter: IX2PersistWriter; const AForm: TCustomForm);
var
formPos: TX2FormPosSettings;
begin
formPos := TX2FormPosSettings.Create();
try
formPos.Assign(AForm);
AWriter.Write(formPos);
finally
FreeAndNil(formPos);
end;
end;
{ TX2FormPosSettings }
procedure TX2FormPosSettings.Assign(Source: TPersistent);
var
sourceForm: TProtectedCustomForm;
placement: TWindowPlacement;
begin
if Source is TCustomForm then
begin
sourceForm := TProtectedCustomForm(Source);
FMaximized := (sourceForm.WindowState = wsMaximized);
FillChar(placement, SizeOf(TWindowPlacement), #0);
placement.length := SizeOf(TWindowPlacement);
{ Get the form's normal position independant of the maximized state }
if GetWindowPlacement(sourceForm.Handle, @placement) then
SetBounds(placement.rcNormalPosition);
end else
inherited;
end;
procedure TX2FormPosSettings.AssignTo(Dest: TPersistent);
var
destForm: TProtectedCustomForm;
boundsRect: TRect;
begin
if Dest is TCustomForm then
begin
destForm := TProtectedCustomForm(Dest);
boundsRect := Self.Bounds;
{ Make sure the window is at least partially visible }
if MonitorFromRect(@boundsRect, MONITOR_DEFAULTTONULL) <> 0 then
begin
if FMaximized then
begin
destForm.WindowState := wsMaximized;
end else
begin
destForm.WindowState := wsNormal;
destForm.Position := poDesigned;
destForm.BoundsRect := boundsRect;
end;
end;
end else
inherited;
end;
function TX2FormPosSettings.GetBounds(): TRect;
begin
Result := Rect(FLeft, FTop, FLeft + FWidth, FTop + FHeight);
end;
procedure TX2FormPosSettings.SetBounds(const Value: TRect);
begin
FLeft := Value.Left;
FTop := Value.Top;
FWidth := RectWidth(Value);
FHeight := RectHeight(Value);
end;
end.

88
X2UtPersistIntf.pas Normal file
View File

@ -0,0 +1,88 @@
{
:: X2UtPersistIntf declares the interfaces used for X2UtPersist.
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2UtPersistIntf;
interface
uses
Classes;
const
SectionSeparator = '.';
CollectionCountName = 'Count';
CollectionItemNamePrefix = 'Item';
type
IX2PersistFiler = interface;
IX2PersistReader = interface;
IX2PersistWriter = interface;
IX2Persist = interface
['{E490D44F-EF97-45C6-A0B1-11D592A292F5}']
function Read(AObject: TObject): Boolean;
procedure Write(AObject: TObject);
function CreateReader(): IX2PersistReader;
function CreateWriter(): IX2PersistWriter;
function CreateSectionReader(const ASection: String): IX2PersistReader;
function CreateSectionWriter(const ASection: String): IX2PersistWriter;
end;
IX2PersistFiler = interface
['{BF63CDAA-98D4-42EE-A937-DFCD0074A0ED}']
function BeginSection(const AName: String): Boolean;
procedure EndSection();
procedure GetKeys(const ADest: TStrings);
procedure GetSections(const ADest: TStrings);
end;
IX2PersistReader = interface(IX2PersistFiler)
['{250C0BFB-734D-438A-A692-0B4B50771D97}']
function Read(AObject: TObject): Boolean;
function ReadBoolean(const AName: String; out AValue: Boolean): Boolean;
function ReadInteger(const AName: String; out AValue: Integer): Boolean;
function ReadFloat(const AName: String; out AValue: Extended): Boolean;
function ReadString(const AName: String; out AValue: String): Boolean;
function ReadInt64(const AName: String; out AValue: Int64): Boolean;
function ReadStream(const AName: String; AStream: TStream): Boolean;
end;
IX2PersistWriter = interface(IX2PersistFiler)
['{2F8D1B01-D1EA-48D7-A727-D32A6DBA5EA3}']
procedure Write(AObject: TObject);
function WriteBoolean(const AName: String; AValue: Boolean): Boolean;
function WriteInteger(const AName: String; AValue: Integer): Boolean;
function WriteFloat(const AName: String; AValue: Extended): Boolean;
function WriteString(const AName, AValue: String): Boolean;
function WriteInt64(const AName: String; AValue: Int64): Boolean;
function WriteStream(const AName: String; AStream: TStream): Boolean;
procedure DeleteKey(const AName: String);
procedure DeleteSection(const AName: String);
end;
IX2PersistCustomData = interface
['{43E3348B-F48B-4F9B-A877-A92F8B417E0E}']
procedure Read(AReader: IX2PersistReader);
procedure Write(AWriter: IX2PersistWriter);
end;
implementation
end.

216
X2UtPersistRegistry.pas
View File

@ -1,3 +1,10 @@
{
:: X2UtPersistRegistry implements persistency to the Windows Registry.
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2UtPersistRegistry; unit X2UtPersistRegistry;
interface interface
@ -6,7 +13,8 @@ uses
Registry, Registry,
Windows, Windows,
X2UtPersist; X2UtPersist,
X2UtPersistIntf;
type type
@ -14,42 +22,55 @@ type
private private
FKey: String; FKey: String;
FRootKey: HKEY; FRootKey: HKEY;
FRegistry: TRegistry;
FReading: Boolean;
protected protected
procedure InitRegistry(AReading: Boolean); function CreateFiler(AIsReader: Boolean): IX2PersistFiler; override;
procedure FinalizeRegistry(); public
constructor Create();
property Key: String read FKey write FKey;
property RootKey: HKEY read FRootKey write FRootKey;
end;
TX2UtPersistRegistryFiler = class(TX2CustomPersistFiler)
private
FKey: String;
FRegistry: TRegistry;
protected
function OpenKey(const ANewKey: String): Boolean; function OpenKey(const ANewKey: String): Boolean;
public
function DoRead(AObject: TObject): Boolean; override;
procedure DoWrite(AObject: TObject); override;
function BeginSection(const AName: String): Boolean; override; function BeginSection(const AName: String): Boolean; override;
procedure EndSection(); override; procedure EndSection(); override;
procedure GetKeys(const ADest: TStrings); override;
procedure GetSections(const ADest: TStrings); override;
function ReadInteger(const AName: String; out AValue: Integer): Boolean; override; function ReadInteger(const AName: String; out AValue: Integer): Boolean; override;
function ReadFloat(const AName: String; out AValue: Extended): Boolean; override; function ReadFloat(const AName: String; out AValue: Extended): Boolean; override;
function ReadString(const AName: String; out AValue: String): Boolean; override; function ReadString(const AName: String; out AValue: String): Boolean; override;
function ReadInt64(const AName: String; out AValue: Int64): Boolean; override; function ReadInt64(const AName: String; out AValue: Int64): Boolean; override;
function ReadStream(const AName: string; AStream: TStream): Boolean; override;
function WriteInteger(const AName: String; AValue: Integer): Boolean; override; function WriteInteger(const AName: String; AValue: Integer): Boolean; override;
function WriteFloat(const AName: String; AValue: Extended): Boolean; override; function WriteFloat(const AName: String; AValue: Extended): Boolean; override;
function WriteString(const AName, AValue: String): Boolean; override; function WriteString(const AName, AValue: String): Boolean; override;
function WriteInt64(const AName: String; AValue: Int64): Boolean; override; function WriteInt64(const AName: String; AValue: Int64): Boolean; override;
procedure ClearCollection(); override; function WriteStream(const AName: string; AStream: TStream): Boolean; override;
procedure DeleteKey(const AName: string); override;
procedure DeleteSection(const AName: string); override;
property Key: String read FKey;
property Registry: TRegistry read FRegistry; property Registry: TRegistry read FRegistry;
public public
constructor Create(); constructor Create(AIsReader: Boolean; ARootKey: HKEY; const AKey: String);
destructor Destroy(); override; destructor Destroy(); override;
property Key: String read FKey write FKey;
property RootKey: HKEY read FRootKey write FRootKey;
end; end;
@ -105,32 +126,38 @@ begin
end; end;
destructor TX2UtPersistRegistry.Destroy(); function TX2UtPersistRegistry.CreateFiler(AIsReader: Boolean): IX2PersistFiler;
begin begin
inherited; Result := TX2UtPersistRegistryFiler.Create(AIsReader, Self.RootKey, Self.Key);
end; end;
procedure TX2UtPersistRegistry.InitRegistry(AReading: Boolean); { TX2UtPersistRegistry }
constructor TX2UtPersistRegistryFiler.Create(AIsReader: Boolean; ARootKey: HKEY; const AKey: String);
begin begin
FReading := AReading; inherited Create(AIsReader);
if AReading then if AIsReader then
FRegistry := TRegistry.Create(KEY_READ) FRegistry := TRegistry.Create(KEY_READ)
else else
FRegistry := TRegistry.Create(); FRegistry := TRegistry.Create();
FRegistry.RootKey := Self.RootKey; FRegistry.RootKey := ARootKey;
FKey := AKey;
OpenKey('');
end; end;
procedure TX2UtPersistRegistry.FinalizeRegistry(); destructor TX2UtPersistRegistryFiler.Destroy();
begin begin
FreeAndNil(FRegistry); FreeAndNil(FRegistry);
inherited;
end; end;
function TX2UtPersistRegistry.OpenKey(const ANewKey: String): Boolean; function TX2UtPersistRegistryFiler.OpenKey(const ANewKey: String): Boolean;
var var
keyName: String; keyName: String;
sectionIndex: Integer; sectionIndex: Integer;
@ -150,7 +177,7 @@ begin
if Length(keyName) > 0 then if Length(keyName) > 0 then
begin begin
if FReading then if IsReader then
Result := FRegistry.OpenKeyReadOnly(keyName) Result := FRegistry.OpenKeyReadOnly(keyName)
else else
Result := FRegistry.OpenKey(keyName, True); Result := FRegistry.OpenKey(keyName, True);
@ -159,31 +186,7 @@ begin
end; end;
function TX2UtPersistRegistry.DoRead(AObject: TObject): Boolean; function TX2UtPersistRegistryFiler.BeginSection(const AName: String): Boolean;
begin
InitRegistry(True);
try
OpenKey('');
Result := inherited DoRead(AObject);
finally
FinalizeRegistry();
end;
end;
procedure TX2UtPersistRegistry.DoWrite(AObject: TObject);
begin
InitRegistry(False);
try
OpenKey('');
inherited DoWrite(AObject);
finally
FinalizeRegistry();
end;
end;
function TX2UtPersistRegistry.BeginSection(const AName: String): Boolean;
begin begin
Result := OpenKey(AName); Result := OpenKey(AName);
@ -192,7 +195,7 @@ begin
end; end;
procedure TX2UtPersistRegistry.EndSection(); procedure TX2UtPersistRegistryFiler.EndSection();
begin begin
inherited; inherited;
@ -201,84 +204,149 @@ begin
end; end;
function TX2UtPersistRegistry.ReadInteger(const AName: String; out AValue: Integer): Boolean; procedure TX2UtPersistRegistryFiler.GetKeys(const ADest: TStrings);
begin begin
Registry.GetValueNames(ADest);
end;
procedure TX2UtPersistRegistryFiler.GetSections(const ADest: TStrings);
begin
Registry.GetKeyNames(ADest);
end;
function TX2UtPersistRegistryFiler.ReadInteger(const AName: String; out AValue: Integer): Boolean;
begin
AValue := 0;
Result := Registry.ValueExists(AName); Result := Registry.ValueExists(AName);
if Result then if Result then
AValue := Registry.ReadInteger(AName); AValue := Registry.ReadInteger(AName);
end; end;
function TX2UtPersistRegistry.ReadFloat(const AName: String; out AValue: Extended): Boolean; function TX2UtPersistRegistryFiler.ReadFloat(const AName: String; out AValue: Extended): Boolean;
begin begin
AValue := 0;
Result := Registry.ValueExists(AName); Result := Registry.ValueExists(AName);
if Result then if Result then
AValue := Registry.ReadFloat(AName); AValue := Registry.ReadFloat(AName);
end; end;
function TX2UtPersistRegistry.ReadString(const AName: String; out AValue: String): Boolean; function TX2UtPersistRegistryFiler.ReadStream(const AName: string; AStream: TStream): Boolean;
var
bufferSize: Integer;
buffer: PChar;
begin begin
Result := Registry.ValueExists(AName); Result := Registry.ValueExists(AName);
if Result then if Result then
AValue := Registry.ReadString(AName); begin
bufferSize := Registry.GetDataSize(AName);
if bufferSize > 0 then
begin
AStream.Size := 0;
GetMem(buffer, bufferSize);
try
Registry.ReadBinaryData(AName, buffer^, bufferSize);
AStream.WriteBuffer(buffer^, bufferSize);
finally
FreeMem(buffer, bufferSize);
end;
end;
end;
end; end;
function TX2UtPersistRegistry.ReadInt64(const AName: String; out AValue: Int64): Boolean; function TX2UtPersistRegistryFiler.ReadString(const AName: String; out AValue: String): Boolean;
begin begin
AValue := '';
Result := Registry.ValueExists(AName);
if Result then
begin
{ Required for conversion of integer-based booleans }
if Registry.GetDataType(AName) = rdInteger then
AValue := IntToStr(Registry.ReadInteger(AName))
else
AValue := Registry.ReadString(AName);
end;
end;
function TX2UtPersistRegistryFiler.ReadInt64(const AName: String; out AValue: Int64): Boolean;
begin
AValue := 0;
Result := (Registry.GetDataSize(AName) = SizeOf(AValue)); Result := (Registry.GetDataSize(AName) = SizeOf(AValue));
if Result then if Result then
Registry.ReadBinaryData(AName, AValue, SizeOf(AValue)); Registry.ReadBinaryData(AName, AValue, SizeOf(AValue));
end; end;
function TX2UtPersistRegistry.WriteInteger(const AName: String; AValue: Integer): Boolean; function TX2UtPersistRegistryFiler.WriteInteger(const AName: String; AValue: Integer): Boolean;
begin begin
Registry.WriteInteger(AName, AValue); Registry.WriteInteger(AName, AValue);
Result := True; Result := True;
end; end;
function TX2UtPersistRegistry.WriteFloat(const AName: String; AValue: Extended): Boolean; function TX2UtPersistRegistryFiler.WriteFloat(const AName: String; AValue: Extended): Boolean;
begin begin
Registry.WriteFloat(AName, AValue); Registry.WriteFloat(AName, AValue);
Result := True; Result := True;
end; end;
function TX2UtPersistRegistry.WriteString(const AName, AValue: String): Boolean; function TX2UtPersistRegistryFiler.WriteStream(const AName: string; AStream: TStream): Boolean;
var
bufferSize: Integer;
buffer: PChar;
begin
Result := False;
AStream.Position := 0;
bufferSize := AStream.Size;
if bufferSize > 0 then
begin
GetMem(buffer, bufferSize);
try
AStream.ReadBuffer(buffer^, bufferSize);
Registry.WriteBinaryData(AName, buffer^, bufferSize);
finally
FreeMem(buffer, bufferSize);
end;
Result := True;
end;
end;
function TX2UtPersistRegistryFiler.WriteString(const AName, AValue: String): Boolean;
begin begin
Registry.WriteString(AName, AValue); Registry.WriteString(AName, AValue);
Result := True; Result := True;
end; end;
function TX2UtPersistRegistry.WriteInt64(const AName: String; AValue: Int64): Boolean; function TX2UtPersistRegistryFiler.WriteInt64(const AName: String; AValue: Int64): Boolean;
begin begin
Registry.WriteBinaryData(AName, AValue, SizeOf(AValue)); Registry.WriteBinaryData(AName, AValue, SizeOf(AValue));
Result := True; Result := True;
end; end;
procedure TX2UtPersistRegistry.ClearCollection(); procedure TX2UtPersistRegistryFiler.DeleteKey(const AName: string);
var
keyNames: TStringList;
keyIndex: Integer;
begin begin
inherited; Registry.DeleteValue(AName);
end;
keyNames := TStringList.Create();
try
Registry.GetKeyNames(keyNames);
for keyIndex := 0 to Pred(keyNames.Count) do procedure TX2UtPersistRegistryFiler.DeleteSection(const AName: string);
if SameTextS(keyNames[keyIndex], CollectionItemNamePrefix) then begin
Registry.DeleteKey(keyNames[keyIndex]); Registry.DeleteKey(AName);
finally
FreeAndNil(keyNames);
end;
end; end;
end. end.

92
X2UtPersistVirtualTree.pas Normal file
View File

@ -0,0 +1,92 @@
{
:: X2UtPersistVirtualTree provides functions to read and write VirtualTree
:: settings.
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2UtPersistVirtualTree;
interface
uses
VirtualTrees,
X2UtPersistIntf;
procedure ReadVTHeader(const AReader: IX2PersistReader; const AHeader: TVTHeader);
procedure WriteVTHeader(const AWriter: IX2PersistWriter; const AHeader: TVTHeader);
implementation
uses
SysUtils;
procedure ReadVTHeader(const AReader: IX2PersistReader; const AHeader: TVTHeader);
var
sortColumn: Integer;
sortAscending: Boolean;
columnIndex: Integer;
column: TVirtualTreeColumn;
keyPrefix: String;
position: Integer;
width: Integer;
visible: Boolean;
begin
if AReader.ReadInteger('SortColumn', sortColumn) then
AHeader.SortColumn := sortColumn;
if AReader.ReadBoolean('SortAscending', sortAscending) then
begin
if sortAscending then
AHeader.SortDirection := sdAscending
else
AHeader.SortDirection := sdDescending;
end;
for columnIndex := 0 to Pred(AHeader.Columns.Count) do
begin
column := AHeader.Columns[columnIndex];
keyPrefix := IntToStr(columnIndex) + '.';
if AReader.ReadInteger(keyPrefix + 'Position', position) then
column.Position := position;
if AReader.ReadInteger(keyPrefix + 'Width', width) then
column.Width := width;
if AReader.ReadBoolean(keyPrefix + 'Visible', visible) then
begin
if visible then
column.Options := column.Options + [coVisible]
else
column.Options := column.Options - [coVisible];
end;
end;
end;
procedure WriteVTHeader(const AWriter: IX2PersistWriter; const AHeader: TVTHeader);
var
columnIndex: Integer;
keyPrefix: String;
begin
AWriter.WriteInteger('SortColumn', AHeader.SortColumn);
AWriter.WriteBoolean('SortAscending', (AHeader.SortDirection = sdAscending));
for columnIndex := 0 to Pred(AHeader.Columns.Count) do
with AHeader.Columns[columnIndex] do
begin
keyPrefix := IntToStr(columnIndex) + '.';
AWriter.WriteInteger(keyPrefix + 'Position', Position);
AWriter.WriteInteger(keyPrefix + 'Width', Width);
AWriter.WriteBoolean(keyPrefix + 'Visible', coVisible in Options);
end;
end;
end.

1
X2UtSettingsRegistry.pas
View File

@ -51,6 +51,7 @@ type
procedure DeleteSection(); override; procedure DeleteSection(); override;
procedure DeleteValue(const AName: String); override; procedure DeleteValue(const AName: String); override;
// procedure RenameSection(const ANewName: String)
public public
constructor CreateInit(const AFactory: TX2SettingsFactory; constructor CreateInit(const AFactory: TX2SettingsFactory;
const AKey, ASection: String; const AKey, ASection: String;

184
X2UtStreams.pas Normal file
View File

@ -0,0 +1,184 @@
{
:: X2UtStreams provides a helper class for reading and writing standard
:: data types to and from streams.
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2UtStreams;
interface
uses
Classes;
type
TX2StreamHelper = class(TObject)
private
FOwnership: TStreamOwnership;
FStream: TStream;
function GetBof(): Boolean;
function GetEof(): Boolean;
public
constructor Create(const AStream: TStream; const AOwnership: TStreamOwnership = soReference);
destructor Destroy(); override;
function ReadBool(): Boolean;
function ReadByte(): Byte;
function ReadDateTime(): TDateTime;
function ReadFloat(): Double;
function ReadInteger(): Integer;
function ReadString(const ALength: Integer = -1): String;
procedure WriteBool(const AValue: Boolean);
procedure WriteByte(const AValue: Byte);
procedure WriteDateTime(const AValue: TDateTime);
procedure WriteFloat(const AValue: Double);
procedure WriteInteger(const AValue: Integer);
procedure WriteString(const AValue: String; const AWriteLength: Boolean = True);
procedure Skip(const ACount: Integer);
property Bof: Boolean read GetBof;
property Eof: Boolean read GetEof;
property Ownership: TStreamOwnership read FOwnership write FOwnership;
property Stream: TStream read FStream;
end;
implementation
uses
SysUtils;
{ TX2UtStreamHelper }
constructor TX2StreamHelper.Create(const AStream: TStream; const AOwnership: TStreamOwnership);
begin
inherited Create();
FStream := AStream;
FOwnership := AOwnership;
end;
destructor TX2StreamHelper.Destroy();
begin
if FOwnership = soOwned then
FreeAndNil(FStream);
inherited;
end;
function TX2StreamHelper.ReadBool(): Boolean;
begin
Stream.ReadBuffer(Result, SizeOf(Boolean));
end;
function TX2StreamHelper.ReadByte(): Byte;
begin
Stream.ReadBuffer(Result, SizeOf(Byte));
end;
function TX2StreamHelper.ReadDateTime(): TDateTime;
begin
Result := ReadFloat();
end;
function TX2StreamHelper.ReadFloat(): Double;
begin
Stream.ReadBuffer(Result, SizeOf(Double));
end;
function TX2StreamHelper.ReadInteger(): Integer;
begin
Stream.ReadBuffer(Result, SizeOf(Integer));
end;
function TX2StreamHelper.ReadString(const ALength: Integer): String;
var
valueLength: Integer;
begin
valueLength := ALength;
if valueLength = -1 then
valueLength := ReadInteger();
if valueLength > 0 then
begin
SetLength(Result, valueLength);
Stream.ReadBuffer(PChar(Result)^, valueLength);
end else
Result := '';
end;
procedure TX2StreamHelper.WriteBool(const AValue: Boolean);
begin
Stream.Write(AValue, SizeOf(Boolean));
end;
procedure TX2StreamHelper.WriteByte(const AValue: Byte);
begin
Stream.WriteBuffer(AValue, SizeOf(Byte));
end;
procedure TX2StreamHelper.WriteDateTime(const AValue: TDateTime);
begin
WriteFloat(AValue);
end;
procedure TX2StreamHelper.WriteFloat(const AValue: Double);
begin
Stream.Write(AValue, SizeOf(Double));
end;
procedure TX2StreamHelper.WriteInteger(const AValue: Integer);
begin
Stream.Write(AValue, SizeOf(Integer));
end;
procedure TX2StreamHelper.WriteString(const AValue: String; const AWriteLength: Boolean);
var
valueLength: Integer;
begin
valueLength := Length(AValue);
if AWriteLength then
WriteInteger(valueLength);
Stream.Write(PChar(AValue)^, valueLength);
end;
procedure TX2StreamHelper.Skip(const ACount: Integer);
begin
Stream.Seek(ACount, soFromCurrent);
end;
function TX2StreamHelper.GetBof(): Boolean;
begin
Result := (Stream.Position = 0);
end;
function TX2StreamHelper.GetEof(): Boolean;
begin
Result := (Stream.Position = Stream.Size);
end;
end.