如何在数组的自定义类对象中使用 DefineProperties - Delphi [英] How to use DefineProperties in a custom Class Object for Arrays - Delphi
问题描述
我正在尝试创建自己的类对象并使用它来为我的应用程序存储各种数据类型，这在使用 Published Properties 时一切正常，我可以毫无问题地将这些流式传输到磁盘并返回.但我还需要流式传输一些整数和字符串数据类型的数组.
I'm trying to create my own class object and use it to store various data types for my application, this all works fine when using Published Properties, I can stream these to disk and back with no problems. But I need to stream some Arrays of both integer and strings data types as well.
我知道数组和其他数据类型不能发布属性，因为 Delphi 不知道如何流式传输它们，我被引导相信您需要使用 DefineProperties 来完成此操作，我创建了一个测试数组作为公共属性的字符串，我可以很好地读取和写入它，但是我需要将它流式传输到磁盘，以便我可以保存它以备将来使用.
I understand that Arrays, amongst other data types can't be published properties because Delphi doesn't know how to stream them, I was led to believe you need to use DefineProperties to accomplish this, I've created a test Array of String as a Public property, I can read and write to it just fine, however I need to stream it to disk so i can save it for future use.
我能找到的关于这个主题的唯一内容是:
The only thing i can find that touches on this subject is here:
我试图复制此代码并对其进行操作以存档我需要的内容，但我无法保存它，我似乎遗漏了一些明显的东西，我正在使用的测试代码如下，我没有收到任何错误这段代码，将属性流发布到磁盘可以，但我的私有阵列没有.任何帮助将不胜感激.
I've attempted to copy this code and manipulate it to archive what I need but I cannot get it to save, I'm seemingly missing something obvious, my test code I'm using is below, I get no errors with this code, published properties stream to disk ok but my private array does not. Any help would be greatly appreciated.
谢谢.
unit UnitDataSet;
//------------------------------------------------------------------------------
interface
uses System.Classes;
{$M+}
//------------------------------------------------------------------------------
type
TDataStrings = Array [1..50] of String;
TDataSet = class(TComponent)
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader: TReader);
procedure WriteArray(Writer: TWriter);
private
FArrayToSave : TDataStrings;
FPStr : String;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
property Items[I: Integer]: String read GetItem write SetItem;
published
property StringItem : String read FPStr write FPStr;
end;
//------------------------------------------------------------------------------
var
DataSet: TDataSet;
implementation
uses TypInfo, Sysutils;
{ TDataSet }
//------------------------------------------------------------------------------
procedure TDataSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
destructor TDataSet.Destroy;
begin
inherited;
end;
//------------------------------------------------------------------------------
function TDataSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > 0) and (I < Length(FArrayToSave)) then
Result := FArrayToSave[I];
end;
//------------------------------------------------------------------------------
procedure TDataSet.SetItem(I: Integer; Value: string);
begin
if (I > 0) and (I < Length(FArrayToSave)) then
FArrayToSave[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromStream(const Stream: TStream);
var
Reader: TReader;
PropName, PropValue: string;
begin
Reader := TReader.Create(Stream, $FFF);
Stream.Position := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do
begin
PropName := Reader.ReadString;
PropValue := Reader.ReadString;
SetPropValue(Self, PropName, PropValue);
end;
FreeAndNil(Reader);
end;
//------------------------------------------------------------------------------
procedure TDataSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.SaveToStream(const Stream: TStream);
var
PropName, PropValue: string;
cnt: Integer;
lPropInfo: PPropInfo;
lPropCount: Integer;
lPropList: PPropList;
lPropType: PPTypeInfo;
Writer: TWriter;
begin
lPropCount := GetPropList(PTypeInfo(ClassInfo), lPropList);
Writer := TWriter.Create(Stream, $FFF);
Stream.Size := 0;
Writer.WriteListBegin;
for cnt := 0 to lPropCount - 1 do
begin
lPropInfo := lPropList^[cnt];
lPropType := lPropInfo^.PropType;
if lPropType^.Kind = tkMethod then Continue;
PropName := lPropInfo.Name;
PropValue := GetPropValue(Self, lPropInfo);
Writer.WriteString(PropName);
Writer.WriteString(PropValue);
end;
Writer.WriteListEnd;
FreeAndNil(Writer);
end;
//------------------------------------------------------------------------------
constructor TDataSet.Create(aOwner: TComponent);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TDataSet.ReadArray(Reader: TReader);
var
N: Integer;
begin
N := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do begin
Reader.ReadListBegin;
FArrayToSave[N] := Reader.ReadString;
Reader.ReadListEnd;
Inc(N);
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := 1 to High(FArrayToSave) do begin
Writer.WriteListBegin;
Writer.WriteString(FArrayToSave[I]);
Writer.WriteListEnd;
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
DataSet := TDataSet.Create(Nil);
finalization
FreeAndNil(DataSet);
end.
//------------------------------------------------------------------------------
这是我用 Arioch 建议的代码修改从下面重写的 Class 代码:
Here is my Class code re-written with Arioch's suggested code modifications from below:
unit UnitCharSett;
interface
//------------------------------------------------------------------------------
uses System.Classes;
//------------------------------------------------------------------------------
type
TCustomDatSetA = Array [0..99] of String;
TCustomCharSet = class(TComponent)
public
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
end;
TZCharSet = class(TCustomCharSet)
private
FFullArray : TCustomDatSetA;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader:TReader);
procedure WriteArray(Writer:TWriter);
public
property Items[Index: Integer]: string read GetItem write SetItem;
published
end;
//------------------------------------------------------------------------------
implementation
uses
System.TypInfo, System.SysUtils;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(Self);
end;
//------------------------------------------------------------------------------
{ TZCharSett }
//------------------------------------------------------------------------------
procedure TZCharSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
function TZCharSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > -1) and (I < Length(FFullArray)) then
Result := FFullArray[I];
end;
//------------------------------------------------------------------------------
procedure TZCharSet.ReadArray(Reader: TReader);
var
N: Integer;
S: String;
begin
for N := Low(FFullArray) to High(FFullArray) do begin
FFullArray[N] := '';
end;
Reader.ReadListBegin;
N := Reader.ReadInteger;
if N = Length(FFullArray) then
begin
N := Low(FFullArray);
while not Reader.EndOfList do
begin
S := Reader.ReadString;
if N <= High(FFullArray) then
FFullArray[N] := S;
Inc(N);
end;
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.SetItem(I: Integer; Value: string);
begin
if (I > -1) and (I < Length(FFullArray)) then
FFullArray[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
Writer.WriteInteger(Length(FFullArray));
for I := Low(FFullArray) to High(FFullArray) do begin
Writer.WriteString(FFullArray[I]);
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
RegisterClasses([TZCharSet]);
//------------------------------------------------------------------------------
end.
推荐答案
您实际上是如何尝试读写它的?我认为您正在尝试制作复杂的不兼容的东西，而不是使用标准方法.
HOW do you actually try to read and write it ? I think you're trying to make complex incompatible things when there instead of using standard methods.
为什么不使用标准的 VCL 流程序?
Why not to use standard VCL streaming procedures?
procedure TMyDataSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(self);
end;
procedure TMyDataSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(self);
end;
<小时>
但是，如果不使用 TFiler 和标准 VCL 流媒体，而是使用 RTTI (GetPropList) 制作自定义代码 - 那么它不会将这些虚拟属性 APi 自定义为 TFiler 并且只会显示真实属性.
However if instead of using TFiler and standard VCL streamer you make your custom code using RTTI (GetPropList) - then it would not call those virtual properties APi custom to TFiler and would only show real properties.
所以我的建议是使用如上所示的标准方法并简化和强化代码.
So my advice is just to use standard emthods like shown above and to streamline and harden the code.
而且由于 RegisterClass 按类名工作，因此您最好选择另一个名称，不要与库存数据库单元中的真实 TDataSet 冲突.
And since RegisterClass works by the classname you'd better choose another name, not clashing with a real TDataSet from stock DB unit.
修复名称并注册类，以便 VCL 流媒体可以通过名称找到它！例如:
Fix the name and do register the class, so VCL streamer could find it by name! For example:
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
S := Reader.ReadString; // even if we would not save it - we should remove it from the input
if N <= High(FArrayToSave) then
FArrayToSave[N] := S;
Inc(N);
end;
Reader.ReadListEnd;
end;
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
Writer.WriteString(FArrayToSave[I]);
end;
Writer.WriteListEnd;
end;
initialization
DataSet := TMyDataSet.Create(Nil);
RegisterClasses([TMyDataSet]);
finalization
DataSet.Free;
end.
<小时>
此外，我认为您最好 - 为了将来的可扩展性 - 将数组长度保存在 DFM 中.
Additionally, i think you'd better - for future extensibility - save the array length in DFM.
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteInteger(Length(FArrayToSave));
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
....
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
for N := Low(FArrayToSave) to High(FArrayToSave) do begin
FArrayToSave := ''; // in case DFM would have less elements than 50
N := Reader.ReadInteger;
if N <> Length(FArrayToSave) then... recovery from unexpected DFM version error
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
PS.你不需要 {$M+} 因为 TComponent 已经派生自 TPersistent
PS. you do not need {$M+} there since TComponent already is derived from TPersistent
PPS.想对问题中的更新发表评论，但手机拒绝这样做(太长了?)所以把它放在这里.
PPS. Wanted to comment upon update in the question, but the phone refuses to do (too long?) so putting it here.
1:由于我们不再使用 RTTI，因此不再需要使用 Typinfo 单元.2:if N = Length(FFullArray) then 缺少 ELSE 路径.好的，现在我们了解到 DFM 已损坏或不兼容，然后呢?我认为我们最好提出一些错误.或者尝试删除 N 个字符串的列表，以便可以读取下一个属性.甚至删除任何类型/数量的元素列表，直到列表结束.永远不会保证未来兼容，但至少可以进行一些尝试，即使只是显式地因错误而停止.跳过阅读并默默地将阅读器留在属性中间，所以下一个属性会变得疯狂，我认为不是这样做的方法.
1: since we moved away from using RTTI, the Typinfo unit no more needed in uses. 2: if N = Length(FFullArray) then lacks ELSE path. Okay, now we learned that DFM is broken or incompatible, what then? I think we better raise some error. Or try to remove list of N strings, so next property could be read. Or even remove the list of elements of any type/quantity until list end. Future compatibly is never warranted, but at least some attempt can be done, even just to explicitly halt with error. Skipping reading and silently leaving the reader inside middle of property, so next properties would get crazy, I think is not the way to do it.
通常，David 关于忽略 setter 和 getter 中不正确的索引是正确的.除非您有意通过设置或获取免费"未绑定"索引(两者都没有代码)来从稀疏数组中的默认模板创建一些不寻常的隐式项目模式，否则至少在 Delphi 中更好的方法是失败"早期的".这就是您班级的用户默认情况下所期望的.有点像
And generally David is correct about ignoring incorrect indices in the setter and getter. Unless you would intentionally come with some unusual pattern of implicit item creation from default template in sparse array by setting or getting with "free" "unbound" index (which is no code for either) the better approach at least in Delphi would be "fail early". That is what users of your class would expect by default. So kinda
Procedure class.CheckArrayIdx(const i: integer);
Var mx, mn : integer;
Begin
Mn := low(myarray) ; Mx := high(myarray);
If (i <= mx) and (I >= mn) then exit;
Raise ERangeError.CreateFmt('%s.Items index should be %d <= %d <= %d', [
Self.ClassName, mn, I, mx]) ;
End;
这个过程在setter和getter中都可以作为第一行调用.然后你可以使用肯定正确的索引值.
This procedure can be called as 1st line in both setter and getter. Then you can just work with surely correct index value.
这篇关于如何在数组的自定义类对象中使用 DefineProperties - Delphi的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
