Added: X2UtStreams
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:
parent
59d62f8d8c
commit
b44732c18f
@ -10,6 +10,8 @@ uses
|
||||
type
|
||||
TPersistTest = class(TTestCase)
|
||||
published
|
||||
procedure QueryReaderWriter;
|
||||
|
||||
procedure WriteNoTypeInfo;
|
||||
procedure WriteSimpleTypes;
|
||||
end;
|
||||
@ -19,14 +21,44 @@ implementation
|
||||
uses
|
||||
SysUtils,
|
||||
|
||||
X2UtPersist;
|
||||
X2UtPersist,
|
||||
X2UtPersistIntf;
|
||||
|
||||
|
||||
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)
|
||||
private
|
||||
FOutput: TStrings;
|
||||
FOutput: IPersistTestOutput;
|
||||
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;
|
||||
procedure EndSection(); override;
|
||||
|
||||
@ -39,13 +71,8 @@ type
|
||||
function WriteInt64(const AName: String; AValue: Int64): Boolean; override;
|
||||
function WriteInteger(const AName: String; AValue: Integer): 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: TStrings read FOutput;
|
||||
property Output: IPersistTestOutput read FOutput write FOutput;
|
||||
end;
|
||||
|
||||
|
||||
@ -83,6 +110,32 @@ end;
|
||||
|
||||
|
||||
{ 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;
|
||||
var
|
||||
testObject: TTypeInfoLess;
|
||||
@ -94,7 +147,7 @@ begin
|
||||
try
|
||||
Write(testObject);
|
||||
|
||||
CheckEquals('', Output.Text);
|
||||
CheckEquals('', Output.Lines.Text);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
@ -114,7 +167,7 @@ begin
|
||||
try
|
||||
Write(testObject);
|
||||
|
||||
CheckEquals('Integer:42'#13#10, Output.Text);
|
||||
CheckEquals('Integer:42'#13#10, Output.Lines.Text);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
@ -129,93 +182,112 @@ constructor TX2UtPersistTest.Create();
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FOutput := TStringList.Create();
|
||||
FOutput := TPersistTestOutput.Create();
|
||||
end;
|
||||
|
||||
|
||||
destructor TX2UtPersistTest.Destroy();
|
||||
function TX2UtPersistTest.CreateFiler(AIsReader: Boolean): IX2PersistFiler;
|
||||
var
|
||||
testFiler: TX2UtPersistTestFiler;
|
||||
|
||||
begin
|
||||
FreeAndNil(FOutput);
|
||||
testFiler := TX2UtPersistTestFiler.Create(AIsReader);;
|
||||
testFiler.Output := Self.Output;
|
||||
|
||||
inherited;
|
||||
Result := testFiler;
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtPersistTest.Write(AObject: TObject);
|
||||
begin
|
||||
Output.Clear();
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistTest.BeginSection(const AName: String): Boolean;
|
||||
{ TX2UtPersistTestFiler }
|
||||
function TX2UtPersistTestFiler.BeginSection(const AName: String): Boolean;
|
||||
begin
|
||||
Result := inherited BeginSection(AName);
|
||||
if Result then
|
||||
Output.Add(AName + ' {');
|
||||
Output.Lines.Add(AName + ' {');
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtPersistTest.EndSection();
|
||||
procedure TX2UtPersistTestFiler.EndSection();
|
||||
begin
|
||||
Output.Add('}');
|
||||
Output.Lines.Add('}');
|
||||
inherited EndSection();
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistTest.ReadFloat(const AName: String; out AValue: Extended): Boolean;
|
||||
function TX2UtPersistTestFiler.ReadFloat(const AName: String; out AValue: Extended): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistTest.ReadInt64(const AName: String; out AValue: Int64): Boolean;
|
||||
function TX2UtPersistTestFiler.ReadInt64(const AName: String; out AValue: Int64): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistTest.ReadInteger(const AName: String; out AValue: Integer): Boolean;
|
||||
function TX2UtPersistTestFiler.ReadInteger(const AName: String; out AValue: Integer): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistTest.ReadString(const AName: String; out AValue: String): Boolean;
|
||||
function TX2UtPersistTestFiler.ReadString(const AName: String; out AValue: String): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistTest.WriteFloat(const AName: String; AValue: Extended): Boolean;
|
||||
function TX2UtPersistTestFiler.WriteFloat(const AName: String; AValue: Extended): Boolean;
|
||||
begin
|
||||
Output.Add(Format('Float:%.2f', [AValue]));
|
||||
Output.Lines.Add(Format('Float:%.2f', [AValue]));
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistTest.WriteInt64(const AName: String; AValue: Int64): Boolean;
|
||||
function TX2UtPersistTestFiler.WriteInt64(const AName: String; AValue: Int64): Boolean;
|
||||
begin
|
||||
Output.Add(Format('Int64:%d', [AValue]));
|
||||
Output.Lines.Add(Format('Int64:%d', [AValue]));
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistTest.WriteInteger(const AName: String; AValue: Integer): Boolean;
|
||||
function TX2UtPersistTestFiler.WriteInteger(const AName: String; AValue: Integer): Boolean;
|
||||
begin
|
||||
Output.Add(Format('Integer:%d', [AValue]));
|
||||
Output.Lines.Add(Format('Integer:%d', [AValue]));
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistTest.WriteString(const AName, AValue: String): Boolean;
|
||||
function TX2UtPersistTestFiler.WriteString(const AName, AValue: String): Boolean;
|
||||
begin
|
||||
Output.Add(Format('String:%s', [AValue]));
|
||||
Output.Lines.Add(Format('String:%s', [AValue]));
|
||||
Result := True;
|
||||
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
|
||||
RegisterTest(TPersistTest.Suite);
|
||||
|
||||
|
||||
@ -13,7 +13,7 @@ uses
|
||||
//IniParserTest in 'Units\IniParserTest.pas';
|
||||
|
||||
begin
|
||||
// MemChk();
|
||||
ReportMemoryLeaksOnShutdown := True;
|
||||
RunRegisteredTests();
|
||||
end.
|
||||
|
||||
|
||||
72
X2UtMisc.pas
72
X2UtMisc.pas
@ -9,6 +9,10 @@
|
||||
unit X2UtMisc;
|
||||
|
||||
interface
|
||||
uses
|
||||
Types;
|
||||
|
||||
|
||||
//:$ Returns IfTrue or IfFalse depending on the Value
|
||||
function iif(const AValue: Boolean; const AIfTrue: Integer;
|
||||
const AIfFalse: Integer = 0): Integer; overload;
|
||||
@ -44,11 +48,23 @@ interface
|
||||
|
||||
//:$ Checks if the value is within the specified range
|
||||
//:: Returns the Default parameter is the range is exceeded, otherwise
|
||||
//:: the value is returned.
|
||||
function InRange(const AValue, AMin, AMax, ADefault: Integer): Integer;
|
||||
//:: the value is returned. The overloads without a Default parameter
|
||||
//:: 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
|
||||
|
||||
|
||||
function iif(const AValue: Boolean; const AIfTrue, AIfFalse: Integer): Integer;
|
||||
begin
|
||||
if AValue then
|
||||
@ -57,6 +73,7 @@ begin
|
||||
Result := AIfFalse;
|
||||
end;
|
||||
|
||||
|
||||
function iif(const AValue: Boolean; const AIfTrue, AIfFalse: String): String;
|
||||
begin
|
||||
if AValue then
|
||||
@ -65,6 +82,7 @@ begin
|
||||
Result := AIfFalse;
|
||||
end;
|
||||
|
||||
|
||||
function CompareInt(const AValue1, AValue2: Integer): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
@ -74,6 +92,7 @@ begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
|
||||
function CompareInt(const AValue1, AValue2: Cardinal): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
@ -83,6 +102,7 @@ begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
|
||||
function CompareInt(const AValue1, AValue2: Int64): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
@ -92,6 +112,7 @@ begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
|
||||
function CompareFloat(const AValue1, AValue2: Single): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
@ -101,6 +122,7 @@ begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
|
||||
function CompareFloat(const AValue1, AValue2: Double): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
@ -110,7 +132,8 @@ begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function InRange;
|
||||
|
||||
function InRange(const AValue, AMin, AMax, ADefault: Integer): Integer;
|
||||
begin
|
||||
Result := ADefault;
|
||||
|
||||
@ -118,4 +141,47 @@ begin
|
||||
Result := AValue;
|
||||
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.
|
||||
|
||||
530
X2UtPersist.pas
530
X2UtPersist.pas
@ -1,66 +1,101 @@
|
||||
{
|
||||
:: X2UtPersist provides a framework for persisting objects and settings.
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
}
|
||||
unit X2UtPersist;
|
||||
|
||||
interface
|
||||
uses
|
||||
Classes,
|
||||
Contnrs,
|
||||
Types,
|
||||
TypInfo;
|
||||
TypInfo,
|
||||
|
||||
X2UtPersistIntf;
|
||||
|
||||
|
||||
type
|
||||
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
|
||||
FIsReader: Boolean;
|
||||
FSections: TStrings;
|
||||
protected
|
||||
{ IInterface }
|
||||
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
|
||||
|
||||
function IterateObject(AObject: TObject; ACallback: TX2IterateObjectProc): Boolean; virtual;
|
||||
|
||||
procedure ReadObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean);
|
||||
procedure WriteObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean);
|
||||
protected
|
||||
function DoRead(AObject: TObject): Boolean; virtual;
|
||||
procedure DoWrite(AObject: TObject); virtual;
|
||||
procedure ReadObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean); virtual;
|
||||
procedure WriteObject(AObject: TObject; APropInfo: PPropInfo; var AContinue: Boolean); 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;
|
||||
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 ReadFloat(const AName: String; out AValue: Extended): 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 ReadStream(const AName: String; AStream: TStream): Boolean; virtual;
|
||||
|
||||
procedure ReadCollection(const AName: String; ACollection: TCollection); virtual;
|
||||
procedure ReadStream(const AName: String; AStream: TStream); virtual;
|
||||
procedure ReadCollection(ACollection: TCollection); 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 WriteFloat(const AName: String; AValue: Extended): Boolean; virtual; abstract;
|
||||
function WriteString(const AName, AValue: String): 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 WriteCollection(const AName: String; ACollection: TCollection); virtual;
|
||||
procedure WriteStream(const AName: String; AStream: TStream); virtual;
|
||||
procedure WriteCollection(ACollection: TCollection); virtual;
|
||||
|
||||
|
||||
property Sections: TStrings read FSections;
|
||||
public
|
||||
constructor Create();
|
||||
destructor Destroy(); override;
|
||||
|
||||
function Read(AObject: TObject): Boolean; virtual;
|
||||
procedure Write(AObject: TObject); virtual;
|
||||
procedure DeleteKey(const AName: String); virtual; abstract;
|
||||
procedure DeleteSection(const AName: String); virtual; abstract;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
const
|
||||
CollectionCountName = 'Count';
|
||||
CollectionItemNamePrefix = 'Item';
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils,
|
||||
@ -68,16 +103,110 @@ uses
|
||||
X2UtStrings;
|
||||
|
||||
|
||||
{ TX2CustomPersist }
|
||||
constructor TX2CustomPersist.Create();
|
||||
begin
|
||||
inherited;
|
||||
type
|
||||
{ This class has to proxy all the interfaces in order for
|
||||
reference counting to go through this class. }
|
||||
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();
|
||||
end;
|
||||
|
||||
|
||||
destructor TX2CustomPersist.Destroy();
|
||||
destructor TX2CustomPersistFiler.Destroy();
|
||||
begin
|
||||
FreeAndNil(FSections);
|
||||
|
||||
@ -85,7 +214,37 @@ begin
|
||||
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
|
||||
propCount: Integer;
|
||||
propList: PPropList;
|
||||
@ -125,51 +284,36 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TX2CustomPersist.Read(AObject: TObject): Boolean;
|
||||
function TX2CustomPersistFiler.Read(AObject: TObject): Boolean;
|
||||
var
|
||||
customDataIntf: IX2PersistCustomData;
|
||||
|
||||
begin
|
||||
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;
|
||||
|
||||
|
||||
procedure TX2CustomPersist.Write(AObject: TObject);
|
||||
function TX2CustomPersistFiler.ReadBoolean(const AName: String; out AValue: Boolean): Boolean;
|
||||
var
|
||||
value: String;
|
||||
|
||||
begin
|
||||
Assert(Assigned(AObject), 'AObject must be assigned.');
|
||||
DoWrite(AObject);
|
||||
AValue := False;
|
||||
Result := ReadString(AName, value) and
|
||||
TryStrToBool(value, AValue);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
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);
|
||||
procedure TX2CustomPersistFiler.ReadObject(AObject: TObject; APropInfo: PPropInfo;
|
||||
var AContinue: Boolean);
|
||||
var
|
||||
ordValue: Integer;
|
||||
floatValue: Extended;
|
||||
@ -240,10 +384,7 @@ begin
|
||||
{ Recurse into object properties }
|
||||
if BeginSection(APropInfo^.Name) then
|
||||
try
|
||||
if objectProp is TCollection then
|
||||
ReadCollection(APropInfo^.Name, TCollection(objectProp));
|
||||
|
||||
AContinue := IterateObject(objectProp, ReadObject);
|
||||
AContinue := Read(objectProp);
|
||||
finally
|
||||
EndSection();
|
||||
end;
|
||||
@ -254,7 +395,29 @@ begin
|
||||
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
|
||||
ordValue: Integer;
|
||||
floatValue: Extended;
|
||||
@ -332,10 +495,7 @@ begin
|
||||
{ Recurse into object properties }
|
||||
if BeginSection(APropInfo^.Name) then
|
||||
try
|
||||
if objectProp is TCollection then
|
||||
WriteCollection(APropInfo^.Name, TCollection(objectProp));
|
||||
|
||||
AContinue := IterateObject(objectProp, WriteObject);
|
||||
Write(objectProp);
|
||||
finally
|
||||
EndSection();
|
||||
end;
|
||||
@ -346,7 +506,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2CustomPersist.ReadCollection(const AName: String; ACollection: TCollection);
|
||||
procedure TX2CustomPersistFiler.ReadCollection(ACollection: TCollection);
|
||||
var
|
||||
itemCount: Integer;
|
||||
itemIndex: Integer;
|
||||
@ -363,8 +523,8 @@ begin
|
||||
begin
|
||||
if BeginSection(CollectionItemNamePrefix + IntToStr(itemIndex)) then
|
||||
try
|
||||
collectionItem := ACollection.Add();
|
||||
IterateObject(collectionItem, ReadObject);
|
||||
collectionItem := ACollection.Add();
|
||||
Read(collectionItem);
|
||||
finally
|
||||
EndSection();
|
||||
end;
|
||||
@ -376,18 +536,39 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2CustomPersist.ReadStream(const AName: String; AStream: TStream);
|
||||
function TX2CustomPersistFiler.ReadStream(const AName: String; AStream: TStream): Boolean;
|
||||
var
|
||||
data: String;
|
||||
|
||||
begin
|
||||
// #ToDo1 (MvR) 8-6-2007: ReadStream
|
||||
Result := ReadString(AName, data);
|
||||
if Result then
|
||||
AStream.WriteBuffer(PChar(data)^, Length(data));
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2CustomPersist.ClearCollection();
|
||||
procedure TX2CustomPersistFiler.ClearCollection();
|
||||
var
|
||||
keyNames: TStringList;
|
||||
keyIndex: Integer;
|
||||
|
||||
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;
|
||||
|
||||
|
||||
procedure TX2CustomPersist.WriteCollection(const AName: String; ACollection: TCollection);
|
||||
procedure TX2CustomPersistFiler.WriteCollection(ACollection: TCollection);
|
||||
var
|
||||
itemIndex: Integer;
|
||||
|
||||
@ -399,16 +580,193 @@ begin
|
||||
begin
|
||||
if BeginSection(CollectionItemNamePrefix + IntToStr(itemIndex)) then
|
||||
try
|
||||
IterateObject(ACollection.Items[itemIndex], WriteObject);
|
||||
Write(ACollection.Items[itemIndex]);
|
||||
finally
|
||||
EndSection();
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TX2CustomPersist.WriteStream(const AName: String; AStream: TStream);
|
||||
|
||||
function TX2CustomPersistFiler.WriteStream(const AName: String; AStream: TStream): Boolean;
|
||||
var
|
||||
data: String;
|
||||
|
||||
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.
|
||||
|
||||
160
X2UtPersistForm.pas
Normal file
160
X2UtPersistForm.pas
Normal 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
88
X2UtPersistIntf.pas
Normal 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.
|
||||
@ -1,3 +1,10 @@
|
||||
{
|
||||
:: X2UtPersistRegistry implements persistency to the Windows Registry.
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
}
|
||||
unit X2UtPersistRegistry;
|
||||
|
||||
interface
|
||||
@ -6,50 +13,64 @@ uses
|
||||
Registry,
|
||||
Windows,
|
||||
|
||||
X2UtPersist;
|
||||
X2UtPersist,
|
||||
X2UtPersistIntf;
|
||||
|
||||
|
||||
|
||||
type
|
||||
TX2UtPersistRegistry = class(TX2CustomPersist)
|
||||
private
|
||||
FKey: String;
|
||||
FRootKey: HKEY;
|
||||
|
||||
FRegistry: TRegistry;
|
||||
FReading: Boolean;
|
||||
protected
|
||||
procedure InitRegistry(AReading: Boolean);
|
||||
procedure FinalizeRegistry();
|
||||
function CreateFiler(AIsReader: Boolean): IX2PersistFiler; override;
|
||||
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 DoRead(AObject: TObject): Boolean; override;
|
||||
procedure DoWrite(AObject: TObject); override;
|
||||
|
||||
public
|
||||
function BeginSection(const AName: String): Boolean; 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 ReadFloat(const AName: String; out AValue: Extended): Boolean; override;
|
||||
function ReadString(const AName: String; out AValue: String): 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 WriteFloat(const AName: String; AValue: Extended): Boolean; override;
|
||||
function WriteString(const AName, AValue: String): 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;
|
||||
public
|
||||
constructor Create();
|
||||
constructor Create(AIsReader: Boolean; ARootKey: HKEY; const AKey: String);
|
||||
destructor Destroy(); override;
|
||||
|
||||
property Key: String read FKey write FKey;
|
||||
property RootKey: HKEY read FRootKey write FRootKey;
|
||||
end;
|
||||
|
||||
|
||||
@ -100,37 +121,43 @@ end;
|
||||
constructor TX2UtPersistRegistry.Create();
|
||||
begin
|
||||
inherited;
|
||||
|
||||
|
||||
FRootKey := HKEY_CURRENT_USER;
|
||||
end;
|
||||
|
||||
|
||||
destructor TX2UtPersistRegistry.Destroy();
|
||||
function TX2UtPersistRegistry.CreateFiler(AIsReader: Boolean): IX2PersistFiler;
|
||||
begin
|
||||
inherited;
|
||||
Result := TX2UtPersistRegistryFiler.Create(AIsReader, Self.RootKey, Self.Key);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtPersistRegistry.InitRegistry(AReading: Boolean);
|
||||
{ TX2UtPersistRegistry }
|
||||
constructor TX2UtPersistRegistryFiler.Create(AIsReader: Boolean; ARootKey: HKEY; const AKey: String);
|
||||
begin
|
||||
FReading := AReading;
|
||||
inherited Create(AIsReader);
|
||||
|
||||
if AReading then
|
||||
if AIsReader then
|
||||
FRegistry := TRegistry.Create(KEY_READ)
|
||||
else
|
||||
FRegistry := TRegistry.Create();
|
||||
|
||||
FRegistry.RootKey := Self.RootKey;
|
||||
FRegistry.RootKey := ARootKey;
|
||||
FKey := AKey;
|
||||
|
||||
OpenKey('');
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtPersistRegistry.FinalizeRegistry();
|
||||
destructor TX2UtPersistRegistryFiler.Destroy();
|
||||
begin
|
||||
FreeAndNil(FRegistry);
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistRegistry.OpenKey(const ANewKey: String): Boolean;
|
||||
function TX2UtPersistRegistryFiler.OpenKey(const ANewKey: String): Boolean;
|
||||
var
|
||||
keyName: String;
|
||||
sectionIndex: Integer;
|
||||
@ -150,7 +177,7 @@ begin
|
||||
|
||||
if Length(keyName) > 0 then
|
||||
begin
|
||||
if FReading then
|
||||
if IsReader then
|
||||
Result := FRegistry.OpenKeyReadOnly(keyName)
|
||||
else
|
||||
Result := FRegistry.OpenKey(keyName, True);
|
||||
@ -159,31 +186,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistRegistry.DoRead(AObject: TObject): 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;
|
||||
function TX2UtPersistRegistryFiler.BeginSection(const AName: String): Boolean;
|
||||
begin
|
||||
Result := OpenKey(AName);
|
||||
|
||||
@ -192,7 +195,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtPersistRegistry.EndSection();
|
||||
procedure TX2UtPersistRegistryFiler.EndSection();
|
||||
begin
|
||||
inherited;
|
||||
|
||||
@ -201,84 +204,149 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistRegistry.ReadInteger(const AName: String; out AValue: Integer): Boolean;
|
||||
procedure TX2UtPersistRegistryFiler.GetKeys(const ADest: TStrings);
|
||||
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);
|
||||
if Result then
|
||||
AValue := Registry.ReadInteger(AName);
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistRegistry.ReadFloat(const AName: String; out AValue: Extended): Boolean;
|
||||
function TX2UtPersistRegistryFiler.ReadFloat(const AName: String; out AValue: Extended): Boolean;
|
||||
begin
|
||||
AValue := 0;
|
||||
Result := Registry.ValueExists(AName);
|
||||
if Result then
|
||||
AValue := Registry.ReadFloat(AName);
|
||||
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
|
||||
Result := Registry.ValueExists(AName);
|
||||
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;
|
||||
|
||||
|
||||
function TX2UtPersistRegistry.ReadInt64(const AName: String; out AValue: Int64): Boolean;
|
||||
function TX2UtPersistRegistryFiler.ReadString(const AName: String; out AValue: String): Boolean;
|
||||
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));
|
||||
if Result then
|
||||
Registry.ReadBinaryData(AName, AValue, SizeOf(AValue));
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistRegistry.WriteInteger(const AName: String; AValue: Integer): Boolean;
|
||||
function TX2UtPersistRegistryFiler.WriteInteger(const AName: String; AValue: Integer): Boolean;
|
||||
begin
|
||||
Registry.WriteInteger(AName, AValue);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistRegistry.WriteFloat(const AName: String; AValue: Extended): Boolean;
|
||||
function TX2UtPersistRegistryFiler.WriteFloat(const AName: String; AValue: Extended): Boolean;
|
||||
begin
|
||||
Registry.WriteFloat(AName, AValue);
|
||||
Result := True;
|
||||
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
|
||||
Registry.WriteString(AName, AValue);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
function TX2UtPersistRegistry.WriteInt64(const AName: String; AValue: Int64): Boolean;
|
||||
function TX2UtPersistRegistryFiler.WriteInt64(const AName: String; AValue: Int64): Boolean;
|
||||
begin
|
||||
Registry.WriteBinaryData(AName, AValue, SizeOf(AValue));
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2UtPersistRegistry.ClearCollection();
|
||||
var
|
||||
keyNames: TStringList;
|
||||
keyIndex: Integer;
|
||||
|
||||
procedure TX2UtPersistRegistryFiler.DeleteKey(const AName: string);
|
||||
begin
|
||||
inherited;
|
||||
Registry.DeleteValue(AName);
|
||||
end;
|
||||
|
||||
keyNames := TStringList.Create();
|
||||
try
|
||||
Registry.GetKeyNames(keyNames);
|
||||
|
||||
for keyIndex := 0 to Pred(keyNames.Count) do
|
||||
if SameTextS(keyNames[keyIndex], CollectionItemNamePrefix) then
|
||||
Registry.DeleteKey(keyNames[keyIndex]);
|
||||
finally
|
||||
FreeAndNil(keyNames);
|
||||
end;
|
||||
procedure TX2UtPersistRegistryFiler.DeleteSection(const AName: string);
|
||||
begin
|
||||
Registry.DeleteKey(AName);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
92
X2UtPersistVirtualTree.pas
Normal file
92
X2UtPersistVirtualTree.pas
Normal 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.
|
||||
@ -51,6 +51,7 @@ type
|
||||
|
||||
procedure DeleteSection(); override;
|
||||
procedure DeleteValue(const AName: String); override;
|
||||
// procedure RenameSection(const ANewName: String)
|
||||
public
|
||||
constructor CreateInit(const AFactory: TX2SettingsFactory;
|
||||
const AKey, ASection: String;
|
||||
|
||||
184
X2UtStreams.pas
Normal file
184
X2UtStreams.pas
Normal 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.
|
||||
Loading…
Reference in New Issue
Block a user