powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Редактирование png
63 сообщений из 63, показаны все 3 страниц
Редактирование png
    #40049937
Фотография _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.
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
Редактирование png
    #40049962
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот такой код
Код: 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
Редактирование png
    #40049967
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А что, у TPngImage нет Canvas-а?
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Редактирование png
    #40050010
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
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
Редактирование png
    #40050013
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Попробуй вообще без Png2. Загрузил в Png1, на нём же нарисовал что-нибудь (хотя бы линию)
и тут же сохранил под другим именем.

Есть подозрение, что унутре этот Canvas использует таки TBitmap, а тот не поддерживает
RGBA от слова "совсем". Если это правда - придётся лезть напрямую в AplhaLines.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Редактирование png
    #40050018
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
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
Редактирование png
    #40050090
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кажется я уразумел. Header.ColorType = COLOR_PALETTE. Это значит, что в цветах записаны не сами цвета, а индексы в палитре.

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

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

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

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

Код: 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
Редактирование png
    #40050375
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

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

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

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

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

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

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

Ушел изучать GDI+
Я помнится какой-то гибрид выкладывал 22250785
...
Рейтинг: 0 / 0
Редактирование png
    #40050499
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_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
Редактирование png
    #40050639
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

Это ты молодец. А теперь подставь картинку из аттача в первом сообщении. В картинке индексированная палитра
...
Рейтинг: 0 / 0
Редактирование png
    #40050646
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Все у меня получилось за исключением одного момента
Код: 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
Редактирование png
    #40050693
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
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
Редактирование png
    #40050723
DHDD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
_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
Редактирование png
    #40050724
Соколинский Борис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_
Что нужно подкрутить?
Проверь, может там альфа канал отдельным битом кодируется и его нужно складывать с PixelFormat8bppIndexed.
Если нет, то исходники GDI+
В стандарте PNG точно есть 8бит+альфа
...
Рейтинг: 0 / 0
Редактирование png
    #40050741
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
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
Редактирование png
    #40050752
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Пробую готовый битмап сконвертировать в нужный мне формат
Код: 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
Редактирование png
    #40050764
DHDD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
image1.Picture.LoadFromFile(CFileName);

не показывает чёрный квадрат.
тоже конвертит? (хотел потестить визуально...)
...
Рейтинг: 0 / 0
Редактирование png
    #40050778
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_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
Редактирование png
    #40050779
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
DHDD
не показывает чёрный квадрат.
Само собой. Я об этом писал 22288765
DHDD
тоже конвертит?
Кто куда конвертит?
...
Рейтинг: 0 / 0
Редактирование png
    #40050789
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_
А теперь подставь картинку из аттача в первом сообщении. В картинке индексированная палитра

Можно и с палитрой:
Код: 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.
procedure TForm1.Button2Click(Sender: TObject);
const
 FieldSize = 32;
 FrameSize = 3;
begin
 var png := TPngImage.Create;
 png.LoadFromFile('square.png');
 var trns := TChunktRNS(png.Chunks.FindChunk(TChunktRNS));

 // find transparent color index
 var tci := 0;
 for var i := 0 to trns.DataSize - 1 do
  if trns.PaletteValues[i] = 0 then
   begin
    tci := i;
    break;
   end;

 var npng := TPngImage.Create;
 npng.Assign(png);
 npng.Resize(png.Width + FieldSize * 2, png.Height + FieldSize * 2);

 // make transparent
 for var y := 0 to npng.Height - 1 do
  FillChar(npng.Scanline[y]^, npng.Width, tci);

 // frame: left, top, right, bottom
 npng.Canvas.Brush.Color := clRed;
 npng.Canvas.FillRect(Rect(0, 0, FrameSize, npng.Height));
 npng.Canvas.FillRect(Rect(0, 0, npng.Width, FrameSize));
 npng.Canvas.FillRect(Rect(npng.Width - FrameSize, 0, npng.Width, npng.Height));
 npng.Canvas.FillRect(Rect(0, npng.Height - FrameSize, npng.Width, npng.Height));

 // image
 for var y := 0 to png.Height - 1 do
  for var x := 0 to png.Width - 1 do
   begin
    var p := PByteArray(png.Scanline[y])[x];
    if  p <> tci then
     PByteArray(npng.Scanline[y + FieldSize])[x + fieldSize] := p;
   end;

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


...
Рейтинг: 0 / 0
Редактирование png
    #40050805
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey
Можно и с палитрой:
И рамка должна быть зеленой :)
...
Рейтинг: 0 / 0
Редактирование png
    #40050825
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_
И рамка должна быть зеленой :)

С этим сам разберёшся ;)
...
Рейтинг: 0 / 0
Редактирование png
    #40050827
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey
С этим сам разберёшся ;)
А ты сам попробуй. Черной она рисуется из-за отсутствия зеленого цвета в палитре
...
Рейтинг: 0 / 0
Редактирование png
    #40050831
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

Ну так добавь цвет в палитру...
...
Рейтинг: 0 / 0
Редактирование png
    #40050848
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey
Ну так добавь цвет в палитру...
Это я делал два дня нозад. Предварительно проанализировав, а нет ли его уже там. Но и это не все. Потом будет вызвана процедура сохранения, а там такой код
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
function TChunkPLTE.SaveToStream(Stream: TStream): Boolean;
var
  J: Integer;
  DataPtr: pByte;
  BitmapInfo: TMAXBITMAPINFO;
  palEntries: TMaxLogPalette;
begin
  {Adjust size to hold all the palette items}
  if fCount = 0 then fCount := Header.BitmapInfo.bmiHeader.biClrUsed;
  ResizeData(fCount * 3);

Для созданных объектов через CreateBlank fCount будет равен 0 и отлично пересчитается. Но если ты вызвал LoadFromString или Assign, то там будет предыдущее значение. И добавление нового цвета в палитру при сохранении тупо проигнорируется.

А ведь есть еще код установки прозрачности
Код: 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.
procedure TChunktRNS.SetTransparentColor(const Value: ColorRef);
var
  i: Byte;
  LookColor: TRGBQuad;
begin
  {Clears the palette values}
  Fillchar(PaletteValues, SizeOf(PaletteValues), #0);
  ........
  {Depends on the color type}
  with Header do
    case ColorType of
      ...........
      COLOR_PALETTE:
      begin
        {Creates a RGBQuad to search for the color}
        LookColor.rgbRed := GetRValue(Value);
        LookColor.rgbGreen := GetGValue(Value);
        LookColor.rgbBlue := GetBValue(Value);
        {Look in the table for the entry}
        for i := 0 to BitmapInfo.bmiHeader.biClrUsed - 1 do
          if CompareMem(@BitmapInfo.bmiColors[i], @LookColor, 3) then
            Break;
        {Fill the transparency table}
        Fillchar(PaletteValues, i, 255);  // Чему равно i если цикл завершился?
        Self.ResizeData(i + 1)
      end
    end {case / with};
end;

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

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

Я не спорю, что можно добавить пару хаков и допилить твой код, но это уже костылестроение высшего порядка.

Я на GDI+, которого до этого не знал вообще, написал работающий код за день
...
Рейтинг: 0 / 0
Редактирование png
    #40050880
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

Код: 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.
type
 TOpenedPngImage = class(TPngImage);
 TOpenedPLTEChunk = class(TChunkPLTE);
procedure TForm1.Button2Click(Sender: TObject);
const
 FieldSize = 32;
 FrameSize = 3;
begin
 var png := TPngImage.Create;
 png.LoadFromFile('square.png');
 var trns := TChunktRNS(png.Chunks.FindChunk(TChunktRNS));

 // find transparent color index
 var tci := 0;
 for var i := 0 to trns.DataSize - 1 do
  if trns.PaletteValues[i] = 0 then
   begin
    tci := i;
    break;
   end;

 var npng := TPngImage.Create;
 npng.Assign(png);
 npng.Resize(png.Width + FieldSize * 2, png.Height + FieldSize * 2);

 // palette
 var nplte := TChunkPLTE(npng.Chunks.FindChunk(TChunkPLTE));
 TOpenedPLTEChunk(nplte).fCount := nplte.Count + 1;
 var pal := TOpenedPngImage(npng).GetPalette;
 var palent : TPaletteEntry;
 palent.peRed   := 0;
 palent.peGreen := 255;
 palent.peBlue  := 0;
 ResizePalette(pal, nplte.count);
 SetPaletteEntries(pal, nplte.Count - 1, 1, palent);
 RealizePalette(npng.Canvas.Handle);

 // frame color
 for var y := 0 to npng.Height - 1 do
  FillChar(npng.Scanline[y]^, npng.Width, nplte.count - 1);

 // make transparent
 for var y := FrameSize to npng.Height - 1 - FrameSize do
  FillChar(PByteArray(npng.Scanline[y])[FrameSize], npng.Width - FrameSize * 2, tci);

 // image
 for var y := 0 to png.Height - 1 do
  for var x := 0 to png.Width - 1 do
   begin
    var p := PByteArray(png.Scanline[y])[x];
    if  p <> tci then
     PByteArray(npng.Scanline[y + FieldSize])[x + fieldSize] := p;
   end;

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


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

Ну о чем я и говорил: пара хак-классов, немножко кода, еще немножко кода (т.к. этот код заточенный под один определенный формат) и задача решается "стандартным" классом
...
Рейтинг: 0 / 0
Редактирование png
    #40050999
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

На самом деле TOpenedPngImage не нужен, свойство Palette публичное. Ну и цветовой индекс можно получать более гуманным способом:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
 // palette
 var nplte := TChunkPLTE(npng.Chunks.FindChunk(TChunkPLTE));
 Inc(TOpenedPLTEChunk(nplte).fCount);
 var palent : TPaletteEntry;
 palent.peRed   := 0;
 palent.peGreen := 255;
 palent.peBlue  := 0;
 ResizePalette(npng.Palette, nplte.Count);
 SetPaletteEntries(npng.Palette, nplte.Count - 1, 1, palent);
 var FrameColor := GetNearestPaletteIndex(npng.Palette, ColorToRGB(clLime));

 // frame color
 for var y := 0 to npng.Height - 1 do
  FillChar(npng.Scanline[y]^, npng.Width, FrameColor);


Чтобы решить задачу не в лоб, как у меня, а по-нормальному, стоило бы унаследоваться от палитрового чанка и рализовать всю "магию" там. Это нормальный подход. Классы спроектированы хорошо.
...
Рейтинг: 0 / 0
Редактирование png
    #40051025
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_
Kazantsev Alexey,

Ну о чем я и говорил: пара хак-классов, немножко кода, еще немножко кода (т.к. этот код заточенный под один определенный формат) и задача решается "стандартным" классом
Это если в VCL. Без напильника - в fmx
...
Рейтинг: 0 / 0
Редактирование png
    #40051049
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2
Это если в VCL. Без напильника - в fmx

Покажешь сохранение png с палитрой в FMX без напильника?
...
Рейтинг: 0 / 0
Редактирование png
    #40051061
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey
asutp2
Это если в VCL. Без напильника - в fmx

Покажешь сохранение png с палитрой в FMX без напильника?
Не сегодня, сегодня лениво)))
...
Рейтинг: 0 / 0
Редактирование png
    #40051853
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2,

Уж полночь близится, а Германа всё нет...
...
Рейтинг: 0 / 0
Редактирование png
    #40051856
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
09.03.2021 12:28, Kazantsev Alexey пишет:
> asutp2,
> Уж полночь близится, а Германа всё нет...


а ты злопамятный!
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Редактирование png
    #40051862
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Мимопроходящий,

Назвался груздем - полезай в кузов!
...
Рейтинг: 0 / 0
Редактирование png
    #40051869
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

а смысл? пощекотать свой ЧСВ?))) лениво)
...
Рейтинг: 0 / 0
Редактирование png
    #40051873
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2,

Зато мир-дверь-мячить не лениво было. Дважды.
...
Рейтинг: 0 / 0
Редактирование png
    #40051875
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2
Kazantsev Alexey,

а смысл? пощекотать свой ЧСВ?))) лениво)
...
Рейтинг: 0 / 0
Редактирование png
    #40051903
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey
asutp2,

Зато мир-дверь-мячить не лениво было. Дважды.
Каво? Поясни, друг)))
Мимопроходящий
asutp2
Kazantsev Alexey,

а смысл? пощекотать свой ЧСВ?))) лениво)
)))))))
...
Рейтинг: 0 / 0
Редактирование png
    #40054313
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Пример решения задачи на FMX:
Код: 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.
procedure TForm185.Button1Click(Sender: TObject);
var
  LBitmap: TBitmap;
  LRect: TRectF;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile('square.png');

    LRect := TRectF.Create(0, 0, LBitmap.Width, LBitmap.Height);
    LBitmap.Canvas.BeginScene;
    try
      LBitmap.Canvas.Stroke.Color := TAlphaColorRec.Green;
      LBitmap.Canvas.Stroke.Thickness := 4;
      LBitmap.Canvas.DrawRectSides(LRect, 0, 0, AllCorners, 100, AllSides, TCornerType.Bevel);
    finally
      LBitmap.Canvas.EndScene;
    end;

    LBitmap.SaveToFile('square_new.png');
  finally
    LBitmap.Free;
  end;
end;
...
Рейтинг: 0 / 0
Редактирование png
    #40054315
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2
Пример решения задачи на FMX:
Задача была
1. Увеличить картинку
2. Нарисовать рамку

А не нарисовать рамку поверх текущей картинки
...
Рейтинг: 0 / 0
Редактирование png
    #40054318
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

22288532 Так где речь об увеличении картинки? Рамку зеленого цвета нарисована, потери прозрачности нет.
Хочешь увеличить картинку? Тоже не вопрос, используй второй битмап нужного размера и рисуй там.
...
Рейтинг: 0 / 0
Редактирование png
    #40054319
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2
22288532 Так где речь об увеличении картинки?
_Vasilisk_
добавить ему прозрачные поля,
_Vasilisk_
Код: pascal
1.
LBmp2.SetSize(LBmp1.Width + CDelta, LBmp1.Height + CDelta);

...
Рейтинг: 0 / 0
Редактирование png
    #40054321
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
выставляй цвет отрисовки линий в TAlphaColorRec.Null и рисуй где надо свои поля ))))
...
Рейтинг: 0 / 0
Редактирование png
    #40054325
asviridenkov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2,

есть интересная проблемка, так просто что-то нарисовать нулевой прозрачностью (то есть сбросить альфу а ноль) в FMX не получится.
...
Рейтинг: 0 / 0
Редактирование png
    #40054332
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2
выставляй цвет отрисовки линий в TAlphaColorRec.Null и рисуй где надо свои поля ))))
Код будет? Я то задачу давно решил на GDI+, но был высказан тезис
asutp2
в нашей горячо любимой огненной обезьянке твоя задача решается на раз, и всё из коробки ;-)
вот вторую неделю все ждут подтверждения этих слов
...
Рейтинг: 0 / 0
Редактирование png
    #40054334
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asviridenkov,

через манипуляцию с пикселями сброс в прозрачность работает, через drawxxx да, установленные пиксели не сбросятся
а в рамках данной задачи достаточно использовать второй битмап измененного размера, в него уже скопировать исходный в нужную зону со смещением и нарисовать границы.

оставляем это ТС, он эксперт , разберется)
...
Рейтинг: 0 / 0
Редактирование png
    #40054337
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_
asutp2
выставляй цвет отрисовки линий в TAlphaColorRec.Null и рисуй где надо свои поля ))))
Код будет? Я то задачу давно решил на GDI+, но был высказан тезис
asutp2
в нашей горячо любимой огненной обезьянке твоя задача решается на раз, и всё из коробки ;-)
вот вторую неделю все ждут подтверждения этих слов
Как иронично, когда я у тебя спрашиваю код, ты просто посылаешь в принципе. А тебе я должен предоставить полноценные исходники? Хмм))
...
Рейтинг: 0 / 0
Редактирование png
    #40054341
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
del
...
Рейтинг: 0 / 0
Редактирование png
    #40054343
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2
Пример решения задачи на FMX

ТС'у нужно не просто рамку нарисовать, но и сохранить картинку с палитрой:
https://www.sql.ru/forum/actualutils.aspx?action=gotomsg&tid=1333957&msg=22289723А мне нужно его сохранить как 8-битный с палитрой.
...
Рейтинг: 0 / 0
Редактирование png
    #40054346
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

FMX позволяет управлять глубиной палитры
...
Рейтинг: 0 / 0
Редактирование png
    #40054349
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2,

Ну так код-то будет?
...
Рейтинг: 0 / 0
Редактирование png
    #40054351
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2
А тебе я должен предоставить полноценные исходники?
Еще раз повторяю
_Vasilisk_
Я то задачу давно решил на GDI+, но был высказан тезис
asutp2
в нашей горячо любимой огненной обезьянке твоя задача решается на раз, и всё из коробки ;-)
вот вторую неделю все ждут подтверждения этих слов
Ну на нет у суда нет
...
Рейтинг: 0 / 0
Редактирование png
    #40054357
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey
asutp2,

Ну так код-то будет?
когда автор этой темы соизволит предоставить мне кошерный код работы с сервисами. А то как то в одного неинтересно - я понимаешь должен предоставить полноценный код, а ТС сделать тоже самое себя обязанным не считает.
...
Рейтинг: 0 / 0
Редактирование png
    #40054373
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2
когда автор этой темы соизволит предоставить мне кошерный код работы с сервисами.
Уже давно 22295883
...
Рейтинг: 0 / 0
Редактирование png
    #40054405
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: 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.
procedure TForm185.Button1Click(Sender: TObject);
const
 FieldSize = 32;
 FrameSize = 3;
var
  LBitmap: TBitmap;
  LDest: TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile('square.png');

    LDest := TBitmap.Create;
    try
      LDest.SetSize(LBitmap.Width + FieldSize * 2, LBitmap.Height + FieldSize * 2);

      LDest.Canvas.BeginScene;
      try
        LDest.CopyFromBitmap(LBitmap, TRect.Create(0, 0, Round(LBitmap.Width), Round(LBitmap.Height)), FieldSize, FieldSize);

        LDest.Canvas.Stroke.Color := TAlphaColorRec.Limegreen;
        LDest.Canvas.Stroke.Thickness := FrameSize;
        LDest.Canvas.DrawRectSides(TRectF.Create(0, 0, LDest.Width, LDest.Height), 0, 0, AllCorners, 100, AllSides, TCornerType.Bevel);
      finally
        LDest.Canvas.EndScene;
      end;

      LDest.SaveToFile('square_new.png');
    finally
      LDest.Free;
    end;
  finally
    LBitmap.Free;
  end;
end;
...
Рейтинг: 0 / 0
Редактирование png
    #40054451
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
asutp2,

Ещё раз:
ТС'у нужно не просто рамку нарисовать, но и сохранить картинку с палитрой
з.ы. Рисуя рамку, нужно уменьшать её на половину FrameSize.
...
Рейтинг: 0 / 0
Редактирование png
    #40054475
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

я показал принципиальную возможность реализации задачи на fmx, причем с возможностями из коробки и с меньшими усилиями относительно vcl, изначальная задача решена. А ведь еще в FMX есть TBitmapSurface, что еще больше расширяет возможности по манипуляции с изображениями, включая установку количества бит на пиксель и т.д.
...
Рейтинг: 0 / 0
63 сообщений из 63, показаны все 3 страниц
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Редактирование png
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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