delphi - 删除 Graphics32 图层时崩溃

Question

我在尝试使用 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。

Answer 1

这是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 可能会遇到 use after free 情况，这可能就是您遇到的情况。

更改 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(value); 保持 FLayerCollection 不变。
inherited 析构函数以某种方式调用与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;