powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Редактирование png
25 сообщений из 63, страница 2 из 3
Редактирование 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
25 сообщений из 63, страница 2 из 3
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Редактирование png
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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