Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Редактирование png / 25 сообщений из 63, страница 1 из 3
02.03.2021, 17:24
    #40049937
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Задача: открыть png с прозрачностью, добавить ему прозрачные поля, рамку по периметру и сохранить обратно в файл не потеряв прозрачность. Как это сделать?

Вот такой код
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
procedure TForm1.FormCreate(Sender: TObject);
const
  CFileName = 'Square.png';
  CFileNameNew = 'SquareNew.png';
  CDelta = 20;
var
  LPicture: TPicture;
  LBmp1: TBitmap;
  LBmp2: TBitmap;
  LPng: TPngImage;
begin
  LPicture := TPicture.Create;
  try
    LPicture.LoadFromFile(CFileName);
    LBmp1 := TBitmap.Create;
    try
      LBmp1.Assign(LPicture.Graphic);
      LBmp2 := TBitmap.Create;
      try
        LBmp2.SetSize(LBmp1.Width + CDelta, LBmp1.Height + CDelta);
        LBmp2.TransparentColor := LBmp1.TransparentColor;
        LBmp2.Transparent := LBmp1.Transparent;
        LBmp2.Canvas.Brush.Color := LBmp2.TransparentColor;
        LBmp2.Canvas.Brush.Style := bsSolid;
        LBmp2.Canvas.FillRect(Rect(0, 0, LBmp2.Width, LBmp2.Height));
        Win32Check(StretchBlt(
          LBmp2.Canvas.Handle,
          CDelta div 2,
          CDelta div 2,
          LBmp1.Width,
          LBmp1.Height,
          LBmp1.Canvas.Handle,
          0,
          0,
          LBmp1.Width,
          LBmp1.Height,
          SRCCOPY
        ));
        LBmp2.Canvas.Pen.Color := clGreen;
        LBmp2.Canvas.Pen.Width := 2;
        LBmp2.Canvas.Brush.Style := bsClear;
        LBmp2.Canvas.Rectangle(0, 0, LBmp2.Width, LBmp2.Height);
        LPng := TPngImage.Create;
        try
          LPng.Assign(LBmp2);
          LPng.SaveToFile(CFileNameNew);
        finally
          LPng.Free;
        end;
      finally
        LBmp2.Free;
      end;
    finally
      LBmp1.Free;
    end;
  finally
    LPicture.Free;
  end;
end;

почти работает. За исключением того, что черный цвет в исходном файле становится прозрачным

Даже такой код
Код: pascal
1.
 Image1.Picture.LoadFromFile(CFileName);

уже отображает картинку без черного цвета

Файл для тренировки в аттаче

С уважением, Vasilisk
...
Рейтинг: 0 / 0
02.03.2021, 18:33
    #40049962
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Вот такой код
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
procedure TForm1.Button1Click(Sender: TObject);
var
  LPng1: TPngImage;
  LPng2: TPngImage;
  LBmp: TBitmap;
begin
  LPng1 := TPngImage.Create;
  try
    LPng1.LoadFromFile(CFileName);
    LBmp := TBitmap.Create;
    try
      LBmp.Assign(LPng1);
      LPng2 := TPngImage.Create;
      try
        LPng2.Assign(LBmp);
        LPng2.SaveToFile(CFileNameNew);
      finally
        LPng2.Free;
      end;
    finally
      LBmp.Free;
    end;
  finally
    LPng1.Free;
  end;
end;

тоже убивает черный цвет.

Танцы с TBitmap нужны, потому что я не понимаю как еще можно отредактировать png
...
Рейтинг: 0 / 0
02.03.2021, 18:40
    #40049967
Dimitry Sibiryakov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
А что, у TPngImage нет Canvas-а?
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
02.03.2021, 20:01
    #40050010
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Dimitry Sibiryakov
А что, у TPngImage нет Canvas-а?
Мне показалось, что он только для чтения.

Но эффект тот же. Черный цвет пропадает
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
procedure TForm1.Button2Click(Sender: TObject);
var
  LPng1: TPngImage;
  LPng2: TPngImage;
begin
  LPng1 := TPngImage.Create;
  try
    LPng1.LoadFromFile(CFileName);
    LPng2 := TPngImage.CreateBlank(
      LPng1.Header.ColorType,
      LPng1.Header.BitDepth,
      LPng1.Width + CDelta,
      LPng1.Height + CDelta
    );
    try
      LPng2.Canvas.Brush.Color := LPng2.TransparentColor;
      LPng2.Canvas.Brush.Style := bsSolid;
      LPng2.Canvas.FillRect(Rect(0, 0, LPng2.Width, LPng2.Height));
      Win32Check(StretchBlt(
        LPng2.Canvas.Handle,
        CDelta div 2,
        CDelta div 2,
        LPng1.Width,
        LPng1.Height,
        LPng1.Canvas.Handle,
        0,
        0,
        LPng1.Width,
        LPng1.Height,
        SRCCOPY
      ));
      LPng2.Canvas.Pen.Color := clGreen;
      LPng2.Canvas.Pen.Width := 2;
      LPng2.Canvas.Brush.Style := bsClear;
      LPng2.Canvas.Rectangle(0, 0, LPng2.Width, LPng2.Height);
    finally
      LPng2.Free;
    end;
  finally
    LPng1.Free;
  end;
end;

...
Рейтинг: 0 / 0
02.03.2021, 20:14
    #40050013
Dimitry Sibiryakov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Попробуй вообще без Png2. Загрузил в Png1, на нём же нарисовал что-нибудь (хотя бы линию)
и тут же сохранил под другим именем.

Есть подозрение, что унутре этот Canvas использует таки TBitmap, а тот не поддерживает
RGBA от слова "совсем". Если это правда - придётся лезть напрямую в AplhaLines.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
02.03.2021, 20:28
    #40050018
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Dimitry Sibiryakov
и тут же сохранил под другим именем.
Так работает.

Сейчас проблема увеличить изображение и сдвинуть его к центру.

Пробую так
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
procedure CopyChunk(APngSrc, APngDst: TPngImage; AChunkClass: TChunkClass);
var
  LChunkSrc: TChunk;
  LChunkDst: TChunk;
begin
  LChunkSrc := APngSrc.Chunks.ItemFromClass(AChunkClass);
  if LChunkSrc <> nil then begin
    LChunkDst := APngDst.Chunks.ItemFromClass(AChunkClass);
    if LChunkDst = nil then
      LChunkDst := APngDst.Chunks.Add(AChunkClass);
    LChunkDst.Assign(LChunkSrc);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  LPng1: TPngImage;
  LPng2: TPngImage;
  LTRNSSrc: TChunk;
  LTRNSDst: TChunk;
begin
  LPng1 := TPngImage.Create;
  try
    LPng1.LoadFromFile(CFileName);
    LPng2 := TPngImage.CreateBlank(
      LPng1.Header.ColorType,
      LPng1.Header.BitDepth,
      LPng1.Width + CDelta,
      LPng1.Height + CDelta
    );
    try
      CopyChunk(LPng1, LPng2, TChunktRNS);
      CopyChunk(LPng1, LPng2, TChunkPLTE);
      CopyChunk(LPng1, LPng2, TChunkgAMA);

      Win32Check(StretchBlt(
        LPng2.Canvas.Handle,
        CDelta div 2,
        CDelta div 2,
        LPng1.Width,
        LPng1.Height,
        LPng1.Canvas.Handle,
        0,
        0,
        LPng1.Width,
        LPng1.Height,
        SRCCOPY
      ));
      LPng2.SaveToFile(CFileNameNew);
    finally
      LPng2.Free;
    end;
  finally
    LPng1.Free;
  end;
end;

изображение переносится. Даже с прозрачностью. Но искажаются цвета
...
Рейтинг: 0 / 0
03.03.2021, 01:00
    #40050090
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Кажется я уразумел. Header.ColorType = COLOR_PALETTE. Это значит, что в цветах записаны не сами цвета, а индексы в палитре.

В палитре записаны три цвета [Red, Black, Black]. А потом говорится, что третий цвет - это прозрачный цвет.

Но TPngImage делает преобразование из индекса в цвет, а потому начинает считать, что прозрачный цвет не третий, а черный. И соответственно прозрачным оказывается и второй цвет.
...
Рейтинг: 0 / 0
03.03.2021, 08:50
    #40050119
kealon(Ruslan)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
_Vasilisk_,

тебе в любом случае сначала нужно получить битмап (в плане растерное изображение), потом нарисовать на нём и уже это сохранять (т.е. преобразовать растр в png)

судя по сложности твоей графики адекватно это сделать можно только с помощью GDI+ (GDI те где нить прозрачность убьёт)
вот его и смотри, там есть и рисование, и загрузка png, и сохранение.
...
Рейтинг: 0 / 0
03.03.2021, 09:20
    #40050123
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
kealon(Ruslan),
+ за GDI+
С VCL в части растровых графических форматов я бы вообще не связывался, явно не самая удачная часть
...
Рейтинг: 0 / 0
03.03.2021, 14:21
    #40050319
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Напрямую изменил палитру у исходного файла и все заработало

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
function ChangePalette(APalette: HPalette; AIndex: Integer; AColor: TColor): HPALETTE;
var
  LColor: TColorRec absolute AColor;
  Li: Integer;
  LEntries: TMaxLogPalette;
  LEntry: PPaletteEntry;
begin
  FillChar(LEntries, SizeOf(LEntries), 0);
  LEntries.palVersion := $300;
  LEntries.palNumEntries := GetPaletteEntries(APalette, 0, 256, LEntries.palPalEntry[0]);
  LEntry := @LEntries.palPalEntry[AIndex];
  LEntry^.peRed := LColor.R;
  LEntry^.peGreen := LColor.G;
  LEntry^.peBlue := LColor.B;
  LEntry^.peFlags := 0;
  Result := CreatePalette(@LEntries);
end;

LPng1.Palette := ChangePalette(LPng1.Palette, 2, clMaroon);


Теперь все это нужно причесать и довести до ума
...
Рейтинг: 0 / 0
03.03.2021, 15:54
    #40050375
asutp2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
_Vasilisk_,

в нашей горячо любимой огненной обезьянке твоя задача решается на раз, и всё из коробки ;-)
...
Рейтинг: 0 / 0
03.03.2021, 21:27
    #40050469
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Всё! Бобик сдох!

Я не знаю какой индус писал TPngImage, но редактировать картинку им невозможно в принципе. Читает он более-менее, а модифицировать это полный аллес.

Ушел изучать GDI+
...
Рейтинг: 0 / 0
03.03.2021, 21:56
    #40050478
defecator
Модератор форума
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
asutp2
_Vasilisk_,

в нашей горячо любимой огненной обезьянке твоя задача решается на раз, и всё из коробки ;-)

в вашей бесконечно глючной огненной обезьянке - возможно, что и да
...
Рейтинг: 0 / 0
03.03.2021, 22:21
    #40050483
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
_Vasilisk_
Всё! Бобик сдох!

Я не знаю какой индус писал TPngImage, но редактировать картинку им невозможно в принципе. Читает он более-менее, а модифицировать это полный аллес.

Ушел изучать GDI+
Я помнится какой-то гибрид выкладывал 22250785
...
Рейтинг: 0 / 0
03.03.2021, 23:56
    #40050499
Kazantsev Alexey
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
_Vasilisk_
Я не знаю какой индус писал TPngImage, но редактировать картинку им невозможно в принципе.

Хм...
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
uses
 Vcl.Imaging.pngimage;
procedure TForm1.Button1Click(Sender: TObject);
const
 FieldSize = 32;
 FrameSize = 3;
begin
 var png := TPngImage.Create;
 png.LoadFromFile('firebird.png');
 var npng := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, png.Width + FieldSize * 2, png.Height + FieldSize * 2);

 // frame color
 npng.Canvas.Brush.Color := clRed;
 npng.Canvas.FillRect(npng.Canvas.ClipRect);
 npng.Canvas.Brush.Color := clBlack;
 npng.Canvas.FillRect(Rect(FrameSize, FrameSize, npng.Width - FrameSize, npng.Height - FrameSize));

 // left, right frame alpha
 for var y := 0 to npng.Height - 1 do
  for var x := 0 to FrameSize - 1 do
   begin
    npng.AlphaScanline[y][x] := 255;
    npng.AlphaScanline[y][npng.Width - 1 - x] := 255;
   end;

 // top, bottom frame alpha
 for var y := 0 to FrameSize - 1 do
  begin
   FillChar(npng.AlphaScanline[y][0], npng.Width, 255);
   FillChar(npng.AlphaScanline[npng.Height - 1 - y][0], npng.Width, 255);
  end;

 // image
 npng.Canvas.Draw(FieldSize, FieldSize, png);

 // image alpha
 for var y := 0 to png.Height - 1 do
  Move(png.AlphaScanline[y]^, npng.AlphaScanline[y + FieldSize][FieldSize], png.Width);

 npng.SaveToFile('firebird_new.png');
 npng.Free;
 png.Free;
end;


...
Рейтинг: 0 / 0
04.03.2021, 13:57
    #40050639
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Kazantsev Alexey,

Это ты молодец. А теперь подставь картинку из аттача в первом сообщении. В картинке индексированная палитра
...
Рейтинг: 0 / 0
04.03.2021, 14:04
    #40050646
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Все у меня получилось за исключением одного момента
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
function GetGDIpEncoder(AMimeType: PWideChar): TGUID;
var
  LEncCnt, LEncSize: Cardinal;
  LCodecs: PImageCodecInfo;
  LCurCodec: PImageCodecInfo;
  Li: Cardinal;
begin
  GPCheck(GdipGetImageEncodersSize(LEncCnt, LEncSize));
  GetMem(LCodecs, LEncSize);
  try
    GPCheck(GdipGetImageEncoders(LEncCnt, LEncSize, LCodecs));
    LCurCodec := LCodecs;
    for Li := 1 to LEncCnt do begin
      if StrIComp(LCurCodec^.MimeType, AMimeType) = 0 then
        Exit(LCurCodec^.Clsid);
      Inc(LCurCodec);
    end;
  finally
    FreeMem(LCodecs);
  end;
  Result := TGUID.Empty;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  LToken: Cardinal;
  LStartup: TGdiplusStartupInput;
  LSrcImg: GpImage;
  LDstBmp: GpBitmap;
  LGraphics: GpGraphics;
  LPen: GpPen;
  LWidth, LHeight: Cardinal;
  LPixelFormat: TPixelFormat;
  LPngEncoder: TGUID;
begin
  FillChar(LStartup, SizeOf(LStartup), 0);
  LStartup.GdiplusVersion := 1;
  GPCheck(GdiplusStartup(LToken, @LStartup, nil));
  try
    GPCheck(GdipLoadImageFromFile(CFileName, LSrcImg));
    try
      GPCheck(GdipGetImageWidth(LSrcImg, LWidth));
      GPCheck(GdipGetImageHeight(LSrcImg, LHeight));
      GPCheck(GdipGetImagePixelFormat(LSrcImg, LPixelFormat));  // LPixelFormat = PixelFormat32bppARGB
      GPCheck(GdipCreateBitmapFromScan0(
        LWidth + CDelta,
        LHeight + CDelta,
        0,
        LPixelFormat,
        nil,
        LDstBmp
      ));
      try
        GPCheck(GdipGetImageGraphicsContext(LDstBmp, LGraphics));
        try
          GPCheck(GdipDrawImageI(LGraphics, LSrcImg, CDelta div 2, CDelta div 2));
          GPCheck(GdipCreatePen1(ALPHA_MASK or clGreen, 5, UnitPixel, LPen));
          try
            GPCheck(GdipDrawRectangleI(LGraphics, LPen, 0, 0, LWidth + CDelta, LHeight + CDelta));
          finally
            GPCheck(GdipDeletePen(LPen));
          end;
        finally
          GPCheck(GdipDeleteGraphics(LGraphics));
        end;
        LPngEncoder := GetGDIpEncoder('image/png');
        GPCheck(GdipSaveImageToFile(LDstBmp, CFileNameNew, @LPngEncoder, nil));
      finally
        GPCheck(GdipDisposeImage(LDstBmp));
      end;
    finally
      GPCheck(GdipDisposeImage(LSrcImg));
    end;
  finally
    GdiplusShutdown(LToken);
  end;
end;


Исходная картинка у меня имеет глубину цвета 8 бит. И в этом же формате мне нужно ее сохранить. При загрузке она перекодируется в PixelFormat32bppARGB и, соответственно сохраняется она с глубиной цвета 32 бита, . Если для целевого битмапа принудительно задать формат PixelFormat8bppIndexed, то тогда вместо прозрачного цвета я получаю черную заливку. Что нужно подкрутить?
...
Рейтинг: 0 / 0
04.03.2021, 15:19
    #40050693
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Graphics::Graphics(Image) method This constructor also fails if the image uses one of the following pixel formats:
  • PixelFormatUndefined
  • PixelFormatDontCare
  • PixelFormat1bppIndexed
  • PixelFormat4bppIndexed
  • PixelFormat8bppIndexed
  • PixelFormat16bppGrayScale
  • PixelFormat16bppARGB1555
А как тогда? Мне нужен на выходе файл с глубиной цвета строго 8 или 16 бит
...
Рейтинг: 0 / 0
04.03.2021, 15:53
    #40050723
DHDD
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
_Vasilisk_,

procedure SmoothResize(apng:tpngImage; NuWidth,NuHeight:integer);

этим вариантом пробовал?

procedure SmoothResize
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
procedure SmoothResize(apng:tpngImage; NuWidth,NuHeight:integer);
var
  xscale, yscale         : Single;
  sfrom_y, sfrom_x       : Single;
  ifrom_y, ifrom_x       : Integer;
  to_y, to_x             : Integer;
  weight_x, weight_y     : array[0..1] of Single;
  weight                 : Single;
  new_red, new_green     : Integer;
  new_blue, new_alpha    : Integer;
  new_colortype          : Integer;
  total_red, total_green : Single;
  total_blue, total_alpha: Single;
  IsAlpha                : Boolean;
  ix, iy                 : Integer;
  bTmp : TPNGImage;
  sli, slo : pRGBLine;
  ali, alo: pbytearray;
begin
  if not (apng.Header.ColorType in [COLOR_RGBALPHA, COLOR_RGB]) then
    raise Exception.Create('Only COLOR_RGBALPHA and COLOR_RGB formats' +
    ' are supported');
  IsAlpha := apng.Header.ColorType in [COLOR_RGBALPHA];
  if IsAlpha then new_colortype := COLOR_RGBALPHA else
    new_colortype := COLOR_RGB;
  bTmp := TpngImage.CreateBlank(new_colortype, 8, NuWidth, NuHeight);
  xscale := bTmp.Width / (apng.Width-1);
  yscale := bTmp.Height / (apng.Height-1);
  for to_y := 0 to bTmp.Height-1 do begin
    sfrom_y := to_y / yscale;
    ifrom_y := Trunc(sfrom_y);
    weight_y[1] := sfrom_y - ifrom_y;
    weight_y[0] := 1 - weight_y[1];
    for to_x := 0 to bTmp.Width-1 do begin
      sfrom_x := to_x / xscale;
      ifrom_x := Trunc(sfrom_x);
      weight_x[1] := sfrom_x - ifrom_x;
      weight_x[0] := 1 - weight_x[1];

      total_red   := 0.0;
      total_green := 0.0;
      total_blue  := 0.0;
      total_alpha  := 0.0;
      for ix := 0 to 1 do begin
        for iy := 0 to 1 do begin
          sli := apng.Scanline[ifrom_y + iy];

          new_red := sli[ifrom_x + ix].rgbtRed;
          new_green := sli[ifrom_x + ix].rgbtGreen;
          new_blue := sli[ifrom_x + ix].rgbtBlue;

          weight := weight_x[ix] * weight_y[iy];
          total_red   := total_red   + new_red   * weight;
          total_green := total_green + new_green * weight;
          total_blue  := total_blue  + new_blue  * weight;

          if IsAlpha then begin
              ali := apng.AlphaScanline[ifrom_y + iy];
              new_alpha := ali[ifrom_x + ix];
              total_alpha  := total_alpha  + new_alpha  * weight;
          end;
        end;
      end;
      slo := bTmp.ScanLine[to_y];
      slo[to_x].rgbtRed := Round(total_red);
      slo[to_x].rgbtGreen := Round(total_green);
      slo[to_x].rgbtBlue := Round(total_blue);
      if IsAlpha then begin
         alo := bTmp.AlphaScanLine[to_y];
         alo[to_x] := Round(total_alpha);
      end;
    end;
  end;
  apng.Assign(bTmp);
  bTmp.Free;
end;

...
Рейтинг: 0 / 0
04.03.2021, 15:53
    #40050724
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
_Vasilisk_
Что нужно подкрутить?
Проверь, может там альфа канал отдельным битом кодируется и его нужно складывать с PixelFormat8bppIndexed.
Если нет, то исходники GDI+
В стандарте PNG точно есть 8бит+альфа
...
Рейтинг: 0 / 0
04.03.2021, 16:08
    #40050741
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
DHDD
этим вариантом пробовал?
Он не сработает
DHDD
Код: pascal
1.
2.
3.
if not (apng.Header.ColorType in [COLOR_RGBALPHA, COLOR_RGB]) then
    raise Exception.Create('Only COLOR_RGBALPHA and COLOR_RGB formats' +
    ' are supported');

У меня apng.Header.ColorType = COLOR_PALETTE
Соколинский Борис
Проверь, может там альфа канал отдельным битом кодируется и его нужно складывать
Я уже говорил, в моем PNG есть чанк PLTE где записаны 3 трипплета [Red, Black, Black] и чанк TRNS где сказано, что третий цвет (второй черный) воспринимать как прозрачный

GDI+ мой файл читает и на лету конвертирует в 32-х битный с альфа-каналом. А мне нужно его сохранить как 8-битный с палитрой.

При этом, если создать таки такой битмап
Код: pascal
1.
2.
GPCheck(GdipCreateBitmapFromScan0(Width, Height, 0,
  PixelFormat8bppIndexed, nil, LDstBmp));

то я не знаю какую палитру формировать. А создание Graphics с таким объектом (или с форматом PixelFormat16bppARGB1555) обламывается с ошибкой OutOfMemory, потому что Graphics все что меньше 24 бит - не поддерживает
...
Рейтинг: 0 / 0
04.03.2021, 16:24
    #40050752
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
Пробую готовый битмап сконвертировать в нужный мне формат
Код: pascal
1.
GPCheck(GdipCloneBitmapAreaI(0, 0, LWidth, LHeight, PixelFormat16bppARGB1555, LTmpBmp, LDstBmp));

Конечный файл получается 32 битным
Код: pascal
1.
GPCheck(GdipCloneBitmapAreaI(0, 0, LWidth, LHeight, PixelFormat8bppIndexed, LTmpBmp, LDstBmp));

Конечный файл получается 8 битным, но с черной заливкой вместо прозрачности
...
Рейтинг: 0 / 0
04.03.2021, 16:42
    #40050764
DHDD
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
image1.Picture.LoadFromFile(CFileName);

не показывает чёрный квадрат.
тоже конвертит? (хотел потестить визуально...)
...
Рейтинг: 0 / 0
04.03.2021, 17:06
    #40050778
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
_Vasilisk_
Код: pascal
1.
GPCheck(GdipCloneBitmapAreaI(0, 0, LWidth, LHeight, PixelFormat16bppARGB1555, LTmpBmp, LDstBmp));


Конечный файл получается 32 битным
Отбой. Виндовый эксплорер обманул. Реально получается 8 битный (почему восьмибитный - отдельный вопрос) с ColorType = COLOR_RGBALPHA

Более того, исходный код тоже сохраняет 8 бит COLOR_RGBALPHA, хотя PixelFormat у объекта PixelFormat32bppARGB.

Т.е. задача решается кодом 22289601 , но с форматами я ничего не понял
...
Рейтинг: 0 / 0
04.03.2021, 17:08
    #40050779
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Редактирование png
DHDD
не показывает чёрный квадрат.
Само собой. Я об этом писал 22288765
DHDD
тоже конвертит?
Кто куда конвертит?
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Редактирование png / 25 сообщений из 63, страница 1 из 3
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]