用代码装饰 TImageCollection 图像

Question

出于测试目的，在我的 Delphi 10.3 应用程序中，我想用每个图像的尺寸装饰 TImageCollection 中的图像。对于位图，这没问题，但对于 PNG 文件，我无法对其进行绘制 canvas，由于运行时异常 "cannot assign a TPngImage to a TWICImage".[=11，我也无法在 TWICImage 中将 BMP 分配给 TWICImage 中的 PNG =]

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;

我希望这样的操作应该很简单，但我还没有找到方法。

谢谢！

Answer 1

我最终使用的解决方案是删除 PNG 源项目，添加新的源项目并使用 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;

用代码装饰 TImageCollection 图像

Decorating TImageCollection images with code

delphi

vcl