Getting bitmap from an ImageList source

[Serge_G 87]

Hi

I am trying to split an Image stored in a first TImageList into a second TImageList

 

all my attempts to access a multiresbitmap contained in a TImagelist show an error on program exit

  TImageListHelper = class helper for TImageList
    function Add(aBitmap: TBitmap): integer;
  end;

var
  Form18: TForm18;

implementation

{$R *.fmx}

uses FMX.MultiResBitmap;

procedure TForm18.Button1Click(Sender: TObject);
var
  sbitmap, pBitmap: TBitmap;
  vSource: TCustomSourceItem;
  vBitmapItem: TCustomBitmapItem;
  vDest: TCustomDestinationItem;

begin
  Images.ClearCache;
  Images.BeginUpdate;
  if Images.Destination.Count > 0 then
    Images.Destination.Clear;
  vSource := ImageList1.Source.Items[1];
  vBitmapItem := vSource.MultiResBitmap.ItemByScale(1, True, True);
  sbitmap := vBitmapItem.Bitmap;
  pBitmap := TBitmap.Create(100, 100);
  try
    for var l := 0 to 3 do
      for var c := 0 to 3 do
      begin
        var
          r: TRect := TRect.Create(pBitmap.Width * c, pBitmap.Height * l,
            pBitmap.Width * c + pBitmap.Width, pBitmap.Height * l +
            pBitmap.Height);
        pBitmap.CopyFromBitmap(sbitmap, r, 0, 0);
        Images.Add(pBitmap);
      end;
  finally
    pBitmap := nil;  // if not an EAccessViolation exception raised when program close
    pBitmap.Free;
  end;
  Images.EndUpdate;

end;


{ TImageListHelper }

function TImageListHelper.Add(aBitmap: TBitmap): integer;
const
  SCALE = 1;
var
  vSource: TCustomSourceItem;
  vBitmapItem: TCustomBitmapItem;
  vDest: TCustomDestinationItem;
  vLayer: TLayer;
begin
  result := -1;
  if (aBitmap.Width = 0) or (aBitmap.Height = 0) then
    exit;

  // add source bitmap
  vSource := Source.Add;
  vSource.MultiResBitmap.TransparentColor := TColorRec.Fuchsia;
  vSource.MultiResBitmap.SizeKind := TSizeKind.Source;
  vSource.MultiResBitmap.Width := Round(aBitmap.Width / SCALE);
  vSource.MultiResBitmap.Height := Round(aBitmap.Height / SCALE);
  vBitmapItem := vSource.MultiResBitmap.ItemByScale(SCALE, True, True);
  if vBitmapItem = nil then
  begin
    vBitmapItem := vSource.MultiResBitmap.Add;
    vBitmapItem.SCALE := SCALE;
  end;
  vBitmapItem.Bitmap.Assign(aBitmap);

  vDest := Destination.Add;
  vLayer := vDest.Layers.Add;
  vLayer.SourceRect.Rect := TRectF.Create(TPoint.Zero,
    vSource.MultiResBitmap.Width, vSource.MultiResBitmap.Height);
  vLayer.Name := vSource.Name;
  result := vDest.Index;
end;

AccessViolation if pbitmap:=nil is omitted

>>EAccessViolation exception in module taKinFMX.exe in 00008338

>>Violation of access to the address 00408338 in the module 'taKinFMX.exe'. Reading of the address FFFFFFFC.

...
>> The instruction at 0x0000000000408338 uses the memory address 0x00000000FFFFFFFC. Memory state cannot be read.

 

 

and cause Unexpected Memory Leaks
An unexpected memory leak has occurred. The unexpected small block leaks are:

 

29 - 36 bytes: TD2DBitmapHandle x 1, TBitmapImage x 1

45 - 52 bytes: TBitmap x 1

61 - 68 bytes: Unknown x 1

 

Where does I go wrong ?

Is there another way to split (like during design time) an image ?

[Vandrovnik 214]

In design time: could you just copy whole imagelist and then delete unneeded images from it?

[Serge_G 87]

45 minutes ago, Vandrovnik said:

In design time: could you just copy whole imagelist and then delete unneeded images from it?

Take in mind that in the another imagelist (let say the source one)  I have various images and the goal is to have the destination list filled with only one of these. 

I found the problem deeply looking in the code used in the helper. (helper I merged) 

uses FMX.MultiResBitmap;

procedure TForm18.Button1Click(Sender: TObject);
const
  SCALE = 1;
var
  pBitmap : TBitmap;
  sbitmap : TCustomBitmapItem;
  vSource: TCustomSourceItem;
  vBitmapItem: TCustomBitmapItem;
  vDest: TCustomDestinationItem;
  vLayer: TLayer;
begin
  Images.ClearCache;
  Images.BeginUpdate;
  if Images.Destination.Count > 0 then
    Images.Destination.Clear;
  vSource := ImageList1.Source.Items[0];
  sbitmap := vSource.MultiResBitmap.ItemByScale(SCALE, True, True);
  pbitmap:=TBitmap.Create(100,100);
  try
    for var l := 0 to 3 do
      for var c := 0 to 3 do
      begin
        var
          r: TRect := TRect.Create(100*c,100* l,
                                   100*c+100,100*l+100);
          pBitmap.CopyFromBitmap(sbitmap.Bitmap, r, 0, 0);

         // add source bitmap
          vSource := Images.Source.Add;
          vSource.MultiResBitmap.TransparentColor := TColorRec.Fuchsia;
          vSource.MultiResBitmap.SizeKind := TSizeKind.Source;
          vSource.MultiResBitmap.Width := Round(pBitmap.Width / SCALE);
          vSource.MultiResBitmap.Height := Round(pBitmap.Height / SCALE);
          vBitmapItem := vSource.MultiResBitmap.ItemByScale(SCALE, True, True);
          if vBitmapItem = nil then
          begin
            vBitmapItem := vSource.MultiResBitmap.Add;
            vBitmapItem.SCALE := SCALE;
          end;
          vBitmapItem.Bitmap.Assign(pBitmap);

          vDest := Images.Destination.Add;
          vLayer := vDest.Layers.Add;
          vLayer.SourceRect.Rect := TRectF.Create(TPoint.Zero,
            vSource.MultiResBitmap.Width, vSource.MultiResBitmap.Height);
          vLayer.Name := vSource.Name;
      end;
  finally
    pBitmap.Free;
  end;
  Images.EndUpdate;
end;

And now I can play