Decorating TImageCollection images with code

Question

For testing purposes, in my Delphi 10.3 application, I'd like to decorate images in a TImageCollection with the dimensions of each image. For bitmaps, it's no problem but for PNG files, I can't paint to that canvas, neither can I assign from a BMP to a PNG in TWICImage because of a runtime exception "cannot assign a TPngImage to a TWICImage".

procedure DecorateImageCollection(imcMainMisc: TImageCollection);
var
  i, j: Integer;
  bmp:Graphics.TBitmap;
  item:TImageCollectionItem;
  img:TImageCollectionSourceItem;
begin
  for i := 0 to imcMainMisc.Count - 1 do
    begin
      item:=imcMainMisc.Images.Items[i];

      for j := 0 to item.SourceImages.Count - 1 do
        begin
          img:=item.SourceImages.Items[j];

          case img.Image.ImageFormat of
            wifBmp:
              ;

            wifPng:
              begin
                bmp:=Graphics.TBitmap.Create;
                try
                  bmp.Assign(img.Image);
                  bmp.Canvas.Font.Name:='Small Fonts';
                  bmp.Canvas.Font.Size:=6;
                  bmp.Canvas.Font.Color:=clRed;
                  bmp.Canvas.Brush.Style:=bsClear;
                  bmp.Canvas.Pen.Style:=psSolid;
                  bmp.Canvas.TextOut(0, 0, IntToStr(bmp.Height));
                  // *cannot assign a TPngImage to a TWICImage*
                  img.Image.Assign(bmp);
                finally
                  bmp.Free;
                end;
              end;

            wifJpeg:
              ;

            wifGif:
              ;

            wifTiff:
              ;

            wifWMPhoto:
              ;

            wifOther:
              ;
          end;
        end;
    end;
end;

I expect such an operation should be simple but I haven't yet found out how.

Thank you!

Answer 1

The solution I ended up using was deleting the PNG source item, adding a new source item and using LoadFromStream( ).

procedure DecorateImageCollection(imc: TImageCollection);
var
  i, j, x, y: Integer;
  r:TRect;
  rSize:TSize;
  sTag:string;
  bmp:TBitmap;
  png:TPngImage;
  item:TImageCollectionItem;
  str:TMemoryStream;
  img, icsiNew:TImageCollectionSourceItem;
  Alpha: PByte;
begin
  for i := 0 to imc.Count - 1 do
    begin
      item:=imc.Images.Items[i];

      for j := item.SourceImages.Count - 1 downto 0 do
        begin
          img:=item.SourceImages.Items[j];

          case img.Image.ImageFormat of
            wifBmp:
              begin
                bmp:=TBitmap.Create;
                try
                  bmp.Assign(img.Image);

                  sTag:=IntToStr(bmp.Height);

                  bmp.Canvas.Font.Name:='Small Fonts';
                  bmp.Canvas.Font.Size:=6;
                  rSize:=bmp.Canvas.TextExtent(sTag);

                  r.Top:=0; 
                  r.Left:=0;
                  r.Width:=rSize.Width;
                  r.Height:=rSize.Height;

                  bmp.Canvas.Brush.Color:=clWhite;
                  bmp.Canvas.Brush.Style:=bsSolid;
                  bmp.Canvas.Font.Color:=clRed;
                  bmp.Canvas.Pen.Style:=psSolid;
                  bmp.Canvas.TextOut(r.Left, r.Top, sTag);

                  img.Image.Assign(bmp);
                finally
                  bmp.Free;
                end;
              end;

            wifPng:
              begin
                png:=TPngImage.Create;
                str:=TMemoryStream.Create;
                try
                  img.Image.SaveToStream(str);

                  str.Position:=0;

                  png.LoadFromStream(str);

                  sTag:=IntToStr(png.Height);

                  png.Canvas.Font.Name:='Small Fonts';
                  png.Canvas.Font.Size:=6;
                  rSize:=png.Canvas.TextExtent(sTag);

                  r.Top:=0;
                  r.Left:=0;
                  r.Width:=rSize.Width;
                  r.Height:=rSize.Height;

                  // knock out transparency in that area
                  for Y := r.Top to r.Bottom - 1 do
                    for X := r.Left to r.Right - 1 do
                    begin
                      Alpha := @png.AlphaScanline[Y]^[X];
                      Alpha^ := 255;  // opaque
                    end;

                  png.Canvas.Brush.Color:=clWhite;
                  png.Canvas.Brush.Style:=bsSolid;
                  png.Canvas.Font.Color:=clRed;
                  png.Canvas.Pen.Style:=psSolid;
                  png.Canvas.TextOut(r.Left, r.Top, sTag);

                  str.Clear;

                  png.SaveToStream(str);

                  item.SourceImages.Delete(j);

                  icsiNew:=item.SourceImages.Add;
                  str.Position:=0;
                  icsiNew.Image.LoadFromStream(str);
                finally
                  png.Free;
                  str.Free;
                end;
              end;

            wifJpeg:
              ;

            wifGif:
              ;

            wifTiff:
              ;

            wifWMPhoto:
              ;

            wifOther:
              ;
          end;
        end;
    end; 
end;