From b44732c18f4ea48b780e133a4996652e5d70b293 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Fri, 10 Aug 2007 12:48:00 +0000 Subject: [PATCH] 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 --- UnitTests/Units/PersistTest.pas | 148 ++++++--- UnitTests/X2UtUnitTests.dpr | 2 +- X2UtMisc.pas | 72 ++++- X2UtPersist.pas | 530 ++++++++++++++++++++++++++------ X2UtPersistForm.pas | 160 ++++++++++ X2UtPersistIntf.pas | 88 ++++++ X2UtPersistRegistry.pas | 220 ++++++++----- X2UtPersistVirtualTree.pas | 92 ++++++ X2UtSettingsRegistry.pas | 1 + X2UtStreams.pas | 184 +++++++++++ 10 files changed, 1293 insertions(+), 204 deletions(-) create mode 100644 X2UtPersistForm.pas create mode 100644 X2UtPersistIntf.pas create mode 100644 X2UtPersistVirtualTree.pas create mode 100644 X2UtStreams.pas diff --git a/UnitTests/Units/PersistTest.pas b/UnitTests/Units/PersistTest.pas index c1b5fec..87baa8e 100644 --- a/UnitTests/Units/PersistTest.pas +++ b/UnitTests/Units/PersistTest.pas @@ -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); diff --git a/UnitTests/X2UtUnitTests.dpr b/UnitTests/X2UtUnitTests.dpr index 9a8ce43..9bffaa8 100644 --- a/UnitTests/X2UtUnitTests.dpr +++ b/UnitTests/X2UtUnitTests.dpr @@ -13,7 +13,7 @@ uses //IniParserTest in 'Units\IniParserTest.pas'; begin -// MemChk(); + ReportMemoryLeaksOnShutdown := True; RunRegisteredTests(); end. diff --git a/X2UtMisc.pas b/X2UtMisc.pas index 76c0944..c11ceef 100644 --- a/X2UtMisc.pas +++ b/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. diff --git a/X2UtPersist.pas b/X2UtPersist.pas index 117eede..fbbe7e6 100644 --- a/X2UtPersist.pas +++ b/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. diff --git a/X2UtPersistForm.pas b/X2UtPersistForm.pas new file mode 100644 index 0000000..ae25225 --- /dev/null +++ b/X2UtPersistForm.pas @@ -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. diff --git a/X2UtPersistIntf.pas b/X2UtPersistIntf.pas new file mode 100644 index 0000000..fd9991e --- /dev/null +++ b/X2UtPersistIntf.pas @@ -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. diff --git a/X2UtPersistRegistry.pas b/X2UtPersistRegistry.pas index c00362f..64225c4 100644 --- a/X2UtPersistRegistry.pas +++ b/X2UtPersistRegistry.pas @@ -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. diff --git a/X2UtPersistVirtualTree.pas b/X2UtPersistVirtualTree.pas new file mode 100644 index 0000000..4c7d789 --- /dev/null +++ b/X2UtPersistVirtualTree.pas @@ -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. diff --git a/X2UtSettingsRegistry.pas b/X2UtSettingsRegistry.pas index f0417c1..68f9fbf 100644 --- a/X2UtSettingsRegistry.pas +++ b/X2UtSettingsRegistry.pas @@ -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; diff --git a/X2UtStreams.pas b/X2UtStreams.pas new file mode 100644 index 0000000..aed0887 --- /dev/null +++ b/X2UtStreams.pas @@ -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.