Декорирование изображений TImageCollection с помощью кода - PullRequest
Новая
       34

Декорирование изображений TImageCollection с помощью кода

0 голосов
/ 30 января 2020

В целях тестирования в моем приложении Delphi 10.3 я хотел бы декорировать изображения в TImageCollection с размерами каждого изображения. Для растровых изображений это не проблема, но для файлов PNG я не могу рисовать на этом холсте, и при этом я не могу назначить из BMP PNG в TWICImage из-за исключения времени выполнения "не могу назначить TPngImage для 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;

Я ожидаю, что такая операция должна быть простой, но я еще не выяснил, как.

Спасибо!

1 Ответ

0 голосов
/ 04 февраля 2020

Решением, которое я использовал в итоге, было удаление исходного элемента 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;
...