Crash when deleting Graphics32 layers

Question

I hit the problem when trying to delete layers using Graphics32. It seems that if you do not delete the layers in the reverse order (from the last added to the first), an exception is thrown. I created the simplest application to test this, and it repeats every time.

I created a simple form with the TImgView32 component (all properties by default), then a button that performs the following actions:

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;

If I cancel the order (Layer2.Free then Layer1.Free), it works fine, but every time it spins. It is also the same if I use TCustomLayer, TPositionedLayer, TBitmapLayer or something else.

I missed the error and it seems to have an error:

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;

Any idea what causes this, or if I am doing something wrong? By the way, I am using 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;