delphi – 删除Graphics32图层时崩溃

2023年6月16日 206次阅读

尝试使用Graphics32删除图层时遇到了问题.似乎除非您以相反的顺序删除图层(从最后添加到第一个图层),否则会抛出异常.我创建了最简单的应用程序来测试它,每次都可以重复.

我创建了一个带有TImgView32组件的简单表单(默认情况下都是属性)然后是一个执行以下操作的按钮：

procedure TMainForm.btnDeleteTestClick(Sender: TObject);
var
  Layer1: TCustomLayer;
  Layer2: TCustomLayer;
begin
  Layer1 := TCustomLayer.Create(ImageView.Layers);
  Layer2 := TCustomLayer.Create(ImageView.Layers);

  Layer1.Free;
  Layer2.Free;
end;

如果我颠倒顺序(Layer2.Free然后Layer1.Free)它工作正常,但这种方式每次崩溃它崩溃.无论我使用TCustomLayer,TPositionedLayer,TBitmapLayer还是其他什么,它也是一样的.

我已经错过了错误,故障似乎源于此：

function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
begin 
  with FBuckets[BucketIndex] do begin 
    Result := Items[ItemIndex].Data; 
    if FCount = 0 then Exit; 
    Dec(Count); 
    if Count = 0 then SetLength(Items, 0) 
    else if (ItemIndex < Count) then 
      Move(Items[ItemIndex + 1], Items[ItemIndex], (Count - ItemIndex - 1) * SizeOf(TPointerBucketItem)); 
  end; 
  Dec(FCount); 
end;

知道是什么导致这个或者我做错了吗？顺便说一句,我正在运行Delphi XE.

最佳答案 这是TCustomLayer.Destroy的代码

destructor TCustomLayer.Destroy;
var
  I: Integer;
begin
  if Assigned(FFreeNotifies) then
  begin
    for I := FFreeNotifies.Count - 1 downto 0 do
    begin
      TCustomLayer(FFreeNotifies[I]).Notification(Self);
      if FFreeNotifies = nil then Break;
    end;
    FFreeNotifies.Free;
    FFreeNotifies := nil;
  end;
  SetLayerCollection(nil);  <<-- bug, see below.
  inherited;  <<---- See note below.
end;

请注意,SetLayerCollection中存在错误.

越野车代码

procedure TCustomLayer.SetLayerCollection(Value: TLayerCollection);
begin
  if FLayerCollection <> Value then begin
    if Assigned(FLayerCollection) then begin
      if FLayerCollection.MouseListener = Self then
        FLayerCollection.MouseListener := nil;
      FLayerCollection.RemoveItem(Self);
    end;
    if Assigned(Value) then Value.InsertItem(Self);
  end;
  /// FLayerCollection is never set!
end;

行SetLayerCollection(nil);实际上并没有设置LayerCollection！
内部FLayerCollection可能会在免费状态之后使用,这可能是您发生的事情.

像这样更改SetLayerCollection的代码：

错误修复

procedure TCustomLayer.SetLayerCollection(Value: TLayerCollection);
begin
  if FLayerCollection <> Value then begin
    if Assigned(FLayerCollection) then begin
      if FLayerCollection.MouseListener = Self then begin
        FLayerCollection.MouseListener := nil;
      end;
      FLayerCollection.RemoveItem(Self);
    end;
    if Assigned(Value) then begin
      Value.InsertItem(Self)
    end;
    FLayerCollection:= Value;  // add this line.
  end;
end;

注意
我的假设是以下片段导致错误：

  SetLayerCollection(nil);
  inherited;

SetLayerCollection(值);留下FLayerCollection不变.
继承的析构函数以某种方式调用与LayerCollection有关的东西.

如果这样可以解决错误,请告诉我.

我提交了一个新问题：https://github.com/graphics32/graphics32/issues/13

更新：TPointerMap.Delete中的一个错误导致问题解决
实际问题在这里：
https://github.com/graphics32/graphics32/issues/14

TPointerMap.Delete的代码不正确：

function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
begin
  with FBuckets[BucketIndex] do
  begin
    Result := Items[ItemIndex].Data;

    if FCount = 0 then Exit;   <<-- error: how can result be valid if count = 0?

    Dec(Count);
    if Count = 0 then
      SetLength(Items, 0)
    else
    if (ItemIndex < Count) then
       //Oops off by 1 error!  ---------------------------------------VVVVV
      Move(Items[ItemIndex + 1], Items[ItemIndex], (Count - ItemIndex - 1) * SizeOf(TPointerBucketItem));
  end;
  Dec(FCount); <<-- The use of with makes this statement confusing.
end;

代码应更改如下：

function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
var
  Bucket: TPointerBucket ;
begin
    if FCount = 0 then Exit(nil);
    //Perhaps add some code to validate BucketIndex & ItemIndex?
    Assert(BucketIndex < Length(FBuckets));
    Bucket:= FBuckets[BucketIndex];
    if ItemIndex >= Bucket.
    Assert(ItemIndex < Length(Bucket.Items));
    Result := Bucket.Items[ItemIndex].Data;
    Dec(Bucket.Count);
    if Bucket.Count = 0 then
      SetLength(Bucket.Items, 0)
    else
     /// assume array like so: 0 1 2 3 4  , itemindex = 0
    /// result should be 1 2 3 4
    /// move(1,0,4) (because 4 items should be moved.
    /// Thus move (itemindex+1, intemindex, count-itemindex)
    if (ItemIndex < Bucket.Count) then
      Move(Items[ItemIndex + 1], Items[ItemIndex], (Bucket.Count - ItemIndex) * SizeOf(TPointerBucketItem));
  end;
  Dec(FCount);
end;
点赞