TImagelist dynamic.

[azrael_11 0]

Hello

To our new home and hope last longer

 

I have a question...

 

I am working on an FMX Program and try to create a TImageList Dynamic and add Images into the "List of Images" so i can call the image from the Tstringgrid cell with the number ...

Do you know how can i do this ?

Thank you.

 

 

[Rollo62 539]

I used something like this for testing purposes

// Adds a new Bitmapitem to the ImageList acc. to InsertPos
// iInsertPos = -1 = Append;  iInsertPos = Insert(iPos, ... insert before
// ASrcRect defines the CropRect of the SourceBmp, which is used in Destination
// Return the just added ImgList ID
function  ImgList_Bitmap_Add(      iInsertPos   : Integer;
                             const ADestImgList : TImageList;
                             const ADestRect    : TRectF;
                             const ASrcBmp      : TBitmap
                            ) : Integer;
var
  isi: TSourceItem;
  idi: TDestinationItem;
  lay: TLayer;
  sSrcName: string;
  bmi: TBitmapItem;
  ms: TMemoryStream;

begin
  Result := -1;

  if not Assigned(ADestImgList) or not Assigned(ASrcBmp) then
    Exit;

  if (ASrcBmp.Width = 0) or (ASrcBmp.Height = 0) then
    Exit;


  try
    // Create new Source entry
    if iInsertPos < 0 then
      isi := ADestImgList.Source.Add                as TSourceItem  // Append
    else
      isi := ADestImgList.Source.Insert(iInsertPos) as TSourceItem; // Insert before

    if not Assigned(isi) then
    begin
      Exit; // Somethings wrong
    end;

    // Create MultiResBitmap w/ LAyer
    if isi.MultiResBitmap.Count = 0 then
    begin
      bmi := isi.MultiResBitmap.Add as TBitmapItem;

      if not Assigned(bmi) then
      begin
        Exit; // Somethings wrong
      end;

      // Add the Bitmap via Stream, to allow Format settings
      ms := TMemoryStream.Create; // Copy Bmp via Stream, so that PNG-Format is possible

      try
        ASrcBmp.SaveToStream( ms );
        ms.Position := 0;

        bmi.Bitmap.CreateFromStream( ms );

      finally
        ms.Free;
      end;

    end;

    // Get the unique SourceItem Name
    sSrcName  := isi.Name;

    // Create new Destination entry
    if iInsertPos < 0 then
      idi := ADestImgList.Destination.Add                as TDestinationItem  // Append
    else
      idi := ADestImgList.Destination.Insert(iInsertPos) as TDestinationItem; // Insert before

    if not Assigned(idi) then
    begin
      Exit; // Somethings wrong
    end;

    // Add new Dest Layer, for output
    lay := idi.Layers.Add;
    if Assigned(lay) and (sSrcName <> '') then
    begin
      // Link the Layer with the Source, so that Output Bitmap is linked
      lay.Name := sSrcName;  // Setup the link the the Source Bitmap here
      lay.SourceRect.Rect   := ADestRect;  // Region which crops within the soure-Rect

      // Finally new Bitmap is in list, return the destination ID
      Result := idi.Index;
    end;

  finally

  end;

end;

 

[azrael_11 0]

1 hour ago, Rollo62 said:

I used something like this for testing purposes

// Adds a new Bitmapitem to the ImageList acc. to InsertPos
// iInsertPos = -1 = Append;  iInsertPos = Insert(iPos, ... insert before
// ASrcRect defines the CropRect of the SourceBmp, which is used in Destination
// Return the just added ImgList ID
function  ImgList_Bitmap_Add(      iInsertPos   : Integer;
                             const ADestImgList : TImageList;
                             const ADestRect    : TRectF;
                             const ASrcBmp      : TBitmap
                            ) : Integer;
var
  isi: TSourceItem;
  idi: TDestinationItem;
  lay: TLayer;
  sSrcName: string;
  bmi: TBitmapItem;
  ms: TMemoryStream;

begin
  Result := -1;

  if not Assigned(ADestImgList) or not Assigned(ASrcBmp) then
    Exit;

  if (ASrcBmp.Width = 0) or (ASrcBmp.Height = 0) then
    Exit;


  try
    // Create new Source entry
    if iInsertPos < 0 then
      isi := ADestImgList.Source.Add                as TSourceItem  // Append
    else
      isi := ADestImgList.Source.Insert(iInsertPos) as TSourceItem; // Insert before

    if not Assigned(isi) then
    begin
      Exit; // Somethings wrong
    end;

    // Create MultiResBitmap w/ LAyer
    if isi.MultiResBitmap.Count = 0 then
    begin
      bmi := isi.MultiResBitmap.Add as TBitmapItem;

      if not Assigned(bmi) then
      begin
        Exit; // Somethings wrong
      end;

      // Add the Bitmap via Stream, to allow Format settings
      ms := TMemoryStream.Create; // Copy Bmp via Stream, so that PNG-Format is possible

      try
        ASrcBmp.SaveToStream( ms );
        ms.Position := 0;

        bmi.Bitmap.CreateFromStream( ms );

      finally
        ms.Free;
      end;

    end;

    // Get the unique SourceItem Name
    sSrcName  := isi.Name;

    // Create new Destination entry
    if iInsertPos < 0 then
      idi := ADestImgList.Destination.Add                as TDestinationItem  // Append
    else
      idi := ADestImgList.Destination.Insert(iInsertPos) as TDestinationItem; // Insert before

    if not Assigned(idi) then
    begin
      Exit; // Somethings wrong
    end;

    // Add new Dest Layer, for output
    lay := idi.Layers.Add;
    if Assigned(lay) and (sSrcName <> '') then
    begin
      // Link the Layer with the Source, so that Output Bitmap is linked
      lay.Name := sSrcName;  // Setup the link the the Source Bitmap here
      lay.SourceRect.Rect   := ADestRect;  // Region which crops within the soure-Rect

      // Finally new Bitmap is in list, return the destination ID
      Result := idi.Index;
    end;

  finally

  end;

end;

 

Thank you i'll try this..

 

[azrael_11 0]

After a few search i found a helper for the Imagelist and it is work just fine.

 

Here the code below

type
  TImageListHelper = class Helper for TImageList
    function Add(const ABitmap: TBitmap): integer;
  end;

implementation

function TImageListHelper.Add(const 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;

 

Thank you for help