为什么‘Assign’出错?(200分)

  • 主题发起人 主题发起人 auther
  • 开始时间 开始时间
A

auther

Unregistered / Unconfirmed
GUEST, unregistred user!
程序得部分代码如下:
TDataPoint = class(TObject)
X: Byte

end

TDataList = class(TStringList)
private
{ private declarations }
public
{ public declarations }
destructor Destroy
override

function AddDataPoint(Point: TDataPoint): integer

function GetDataPoint(index: integer): TDataPoint

end


destructor TDataList.Destroy

var
Temp: TObject

begin
while Count <> 0 do
begin
{ make Temp := first Item }
Temp := Objects[0]

{ free it }
Temp.Free

{ delete it }
Delete(0)

end

{ call inherited }
inherited Destroy

end

function TDataList.AddDataPoint(Point: TDataPoint): integer

begin
Result := AddObject('', Point)

end

function TDataList.GetDataPoint(index: integer): TDataPoint

begin
Result := Objects[index] as TDataPoint

end


....

....
..
DataList1:=TDataList.create

DataList2:=TDataList.Create


for i:=1 to 100 do
begin
{ create data object }
P := TDataPoint.Create

P.X := random(1000)

{ add it to the list }
DataList1.AddDataPoint(p)

end


[red]datalist2.Assign(DataList1)
[/red]

最后一句编译时说Access Violation。
请问该如何修改亚。
 
你需要自己override assign这个方法
 
我測過以上程式, 在Assign那一行並沒有你所說的問題
但是會有另一個問題是在DataList1, DataList2釋放的時候,
因為透過assign時, DataList1與DataList2的Objects所保留的
TDataPoint實例都是相同的, TDataList在釋放時, 又會釋放所保留的
TDataPoint, 所以釋放DataList1後再釋放dataList2時就會出錯,
最好的方法, 是改寫AssignTo, 將Tdatapoint實例也複製一份
以下是我已寫的Code, 另外加一些我覺得可以讓類更完善的功能
type
TDataPoint = class(TObject)
X: Byte;
end;

TDataList = class(TStringList)
private
{ private declarations }
procedure FreeAllObjects;
protected
procedure PutObject(Index: Integer
AObject: TObject)
override;
public
{ public declarations }
destructor Destroy
override;
procedure Assign(Source: TPersistent)
override;
function AddDataPoint(Point: TDataPoint): integer;
function GetDataPoint(index: integer): TDataPoint;
procedure Delete(Index: Integer)
override;
procedure Clear
override;
end;

destructor TDataList.Destroy;
begin
FreeAllObjects;
{ call inherited }
inherited Destroy;
end;

function TDataList.AddDataPoint(Point: TDataPoint): integer;
begin
Result := AddObject('', Point);
end;

function TDataList.GetDataPoint(index: integer): TDataPoint;
begin
Result := Objects[index] as TDataPoint;
end;

procedure TDataList.Clear;
begin
FreeAllObjects;
end;

procedure TDataList.FreeAllObjects;
var
I: integer;
begin
if Count > 0 then
begin
BeginUpdate;
try
for I := Count - 1 downto 0 do
Delete(I);
finally
EndUpdate;
end;
end;
end;

procedure TDataList.PutObject(Index: Integer
AObject: TObject);
var OldObj: TObject;
begin
if not (AObject is TDataPoint) then raise Exception.Create('Error object class!');
OldObj := Objects[Index];
inherited;
OldObj.Free;
end;

procedure TDataList.Delete(Index: Integer);
var OldObj: TObject;
begin
OldObj := Objects[Index];
inherited;
OldObj.Free;
end;

procedure TDataList.Assign(Source: TPersistent);
var
Point: TDataPoint;
I: integer;
begin
if Source is TDataList then
with TDataList(Source) do
begin
Self.BeginUpdate;
try
Self.Clear;
for I := 0 to Count - 1 do
begin
Point := TDataPoint.Create;
Point.X := GetDataPoint(I).X;
Self.AddObject('', Point);
end;
finally
Self.EndUpdate;
end;
end
else
raise Exception.Create('Error Class!');
end;
 
datalist2.Assign(DataList1)不会出错,
但是确实需要重载。
因为此时是TStrings.Assign()
 
to: lorderic
这样重载得方法,就相当于依次将原来得值取出,再赋给另外一个TDataList变量吧。
这样会不会很耗时间?尤其是datalist1很大得时候。
 
http://www.delphibbs.com/delphibbs/dispq.asp?lid=706176
 
多人接受答案了。
 
后退
顶部