Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Звук, графика и видео > Изменить размер PNG


Автор: Akella 1.8.2012, 13:02
Не могу найти нормально работающего примера, чтобы качественно увеличить PNG с alpha-каналом.
Delphi XE2

На сайте абракадабры (EDN>>CodeCentral) есть примеры работы с PNG: http://cc.embarcadero.com/Item/25631, в том числе и есть пример процедуры SmoothResize.

Там есть такой кусок кода:

Код

  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 равный 3, а именно COLOR_PALETTE
Код

unit Vcl.Imaging.pngimage
...
...

{Avaliable color modes for PNG}
COLOR_GRAYSCALE = 0;
COLOR_RGB = 2;
COLOR_PALETTE = 3;
COLOR_GRAYSCALEALPHA = 4;
COLOR_RGBALPHA = 6;



поэтому вываливается Exception


Я с изображениями вообще не работал.
Поэтому нужна процедура изменения размера PNG. Или как "конвертировать" существующее изображение, чтобы эта процедура схавала мой png и не подавилась?
Может можно как сконвертировать изображение из COLOR_PALETTE в COLOR_RGBALPHA или в COLOR_RGB? 

Автор: Illusion Dolphin 1.8.2012, 16:29
Вот как перегнать из PNG с COLOR_PALETTE в TBitmap:

Код


procedure LoadPNGImagePalette(PNG: TPNGImage; Bitmap: TBitmap);
var
  I, J, P: Integer;
  DeltaS, DeltaD: Integer;
  AddrLineS, AddrLineD: NativeInt;
  AddrS, AddrD: NativeInt;
  TC: TColor;
  Chunk: TChunkPLTE;
begin
  if PNG.Transparent then
    Bitmap.PixelFormat := pf32bit
  else
    Bitmap.PixelFormat := pf24bit;

  Bitmap.SetSize(PNG.Width, PNG.Height);

  AddrLineS := NativeInt(PNG.ScanLine[0]);
  AddrLineD := NativeInt(Bitmap.ScanLine[0]);
  DeltaS := 0;
  DeltaD := 0;
  if PNG.Height > 1 then
  begin
    DeltaS := NativeInt(PNG.ScanLine[1]) - AddrLineS;
    DeltaD := NativeInt(Bitmap.ScanLine[1])- AddrLineD;
  end;

  Chunk := TChunkPLTE(PNG.Chunks.ItemFromClass(TChunkPLTE));
  if not PNG.Transparent then
  begin
    for I := 0 to PNG.Height - 1 do
    begin
      AddrS := AddrLineS;
      AddrD := AddrLineD;
      for J := 0 to PNG.Width - 1 do
      begin
        P := PByte(AddrS)^;
        with Chunk.Item[P] do
        begin
          PRGB(AddrD)^.R := PNG.GammaTable[rgbRed];
          PRGB(AddrD)^.G := PNG.GammaTable[rgbGreen];
          PRGB(AddrD)^.B := PNG.GammaTable[rgbBlue];
        end;

        Inc(AddrS, 1);
        Inc(AddrD, 3);
      end;
      Inc(AddrLineS, DeltaS);
      Inc(AddrLineD, DeltaD);
    end;
  end else
  begin
    TC := ColorToRGB(PNG.TransparentColor) and $00FFFFFF;

    for I := 0 to PNG.Height - 1 do
    begin
      AddrS := AddrLineS;
      AddrD := AddrLineD;
      for J := 0 to PNG.Width - 1 do
      begin
        P := PByte(AddrS)^;
        with Chunk.Item[P] do
        begin
          PRGB32(AddrD)^.R := PNG.GammaTable[rgbRed];
          PRGB32(AddrD)^.G := PNG.GammaTable[rgbGreen];
          PRGB32(AddrD)^.B := PNG.GammaTable[rgbBlue];

          if PRGB32(AddrD)^.R + PRGB32(AddrD)^.G shl 8 + PRGB32(AddrD)^.B shl 16 = TC then
            PRGB32(AddrD)^.L := 0
          else
            PRGB32(AddrD)^.L := 255;
        end;

        Inc(AddrS, 1);
        Inc(AddrD, 4);
      end;
      Inc(AddrLineS, DeltaS);
      Inc(AddrLineD, DeltaD);
    end;
  end;
end;




Замем если получилось 24 bit каритинка то просто PNGImage.Assign делаешь, если же 32 бита получилось, то:

Код


procedure SavePNGImageTransparent(PNG: TPNGImage; Bitmap: TBitmap);
var
  I, J: Integer;
  DeltaS, DeltaSA, DeltaD: Integer;
  AddrLineS, AddrLineSA, AddrLineD: NativeInt;
  AddrS, AddrSA, AddrD: NativeInt;
begin
  PNG.Chunks.Free;
  PNG.Canvas.Free;
  PNG.CreateBlank(COLOR_RGBALPHA, 8, Bitmap.Width, Bitmap.Height);

  AddrLineS := NativeInt(PNG.ScanLine[0]);
  AddrLineSA := NativeInt(PNG.AlphaScanline[0]);
  AddrLineD := NativeInt(Bitmap.ScanLine[0]);
  DeltaS := 0;
  DeltaSA := 0;
  DeltaD := 0;
  if PNG.Height > 1 then
  begin
    DeltaS := NativeInt(PNG.ScanLine[1]) - AddrLineS;
    DeltaSA := NativeInt(PNG.AlphaScanline[1]) - AddrLineSA;
    DeltaD := NativeInt(Bitmap.ScanLine[1])- AddrLineD;
  end;

  for I := 0 to PNG.Height - 1 do
  begin
    AddrS := AddrLineS;
    AddrSA := AddrLineSA;
    AddrD := AddrLineD;
    for J := 0 to PNG.Width - 1 do
    begin
      PRGB(AddrS)^ := PRGB(AddrD)^;
      Inc(AddrS, 3);
      Inc(AddrD, 3);
      PByte(AddrSA)^ := PByte(AddrD)^;
      Inc(AddrD, 1);
      Inc(AddrSA, 1);
    end;
    Inc(AddrLineS, DeltaS);
    Inc(AddrLineSA, DeltaSA);
    Inc(AddrLineD, DeltaD);
  end;
end;


Работает 32\64 бита. Быстрее только ассемблер наверное.
А дальше - функция SmoothResize smile

Автор: Akella 1.8.2012, 16:46
ОК, спасибо, попобую завтра  smile

Добавлено через 50 секунд
Я пробовал этот пример с GDI+
http://kachkarvv.org.ua/faq/src-delphi/delphi-jpg-gdi-rsz.php, вроде работает, но приходится через промежуточный файл.

Автор: Illusion Dolphin 1.8.2012, 17:01
Цитата

Я пробовал этот пример с GDI+
http://kachkarvv.org.ua/faq/src-delphi/del...jpg-gdi-rsz.php, вроде работает, но приходится через промежуточный файл. 


GDI+ может работать через стримы (GdipLoadImageFromStream/GdipSaveImageToStream) так что можно без файлов обойтись и работать со стримами бещ лишних файлов. Но я не уверен что будет работать в случает прозрачной картинки (COLOR_PALETTE с прозрачностью).

Автор: Akella 2.8.2012, 10:33
Цитата(Illusion Dolphin @  1.8.2012,  16:29 Найти цитируемый пост)
Вот как перегнать из PNG с COLOR_PALETTE в TBitmap:

мне кажется, что потеряется альфа-канал и картинка в итоге будет искажённой, а там цифры, которые мне нужно ещё распознать в текст :(

Добавлено через 2 минуты и 51 секунду
А как можно убрать альфа-канал, заменив прозрачность, например, на красный или синий цвет?
Там прозрачные цифры, и мне их нужно распознать в текст.

Автор: x128 2.8.2012, 11:02
Не знаю как в Delphi XE2 обстоят дела с alpha-каналом для палитровых PNG, но в оригинальном компоненте который стал донором доступ осуществлялся напрямую через соответствующие чанки. Для палитры это TChunkPLTE, для прозрачности TChunktRNS.
Код

var
  PNG: TPNGObject;
  PLTE: TChunkPLTE;
  tRNS: TChunktRNS;
...
  PLTE:=PNG.Chunks.ItemFromClass(TChunkPLTE) as TChunkPLTE;
  tRNS:=PNG.Chunks.ItemFromClass(TChunktRNS) as TChunktRNS;

для tRNS.PaletteValues[i] индексы i соответствуют индексам палитры и содержат значения альфа-прозрачности для каждого цвета в палитре.

Автор: Illusion Dolphin 2.8.2012, 13:12
Цитата

мне кажется, что потеряется альфа-канал и картинка в итоге будет искажённой, а там цифры, которые мне нужно ещё распознать в текст :(

А там разве зря 2 ветки - для прозначного и непрозрачного PNG? smile

Цитата

А как можно убрать альфа-канал, заменив прозрачность, например, на красный или синий цвет?


Код

          if PRGB32(AddrD)^.R + PRGB32(AddrD)^.G shl 8 + PRGB32(AddrD)^.B shl 16 = TC then
          begin
            PRGB32(AddrD)^.R := SomeR;
            PRGB32(AddrD)^.G := SomeG;
            PRGB32(AddrD)^.B := SomeB;
         end;


Если не получается - можешь скинуть картинку для примера я посмотрю.


Как сказал x128, возможно правильнее смотреть прозрачность через TChunktRNS чанк, но я не видел png, который бы неправильно отобразился в коде который дал я (если такой png есть просьба показать его smile )

Автор: Akella 2.8.2012, 13:25
Пока не пробовал. Но картнку на всяк случай приложил

Автор: Akella 2.8.2012, 13:28
Цитата(Illusion Dolphin @  1.8.2012,  16:29 Найти цитируемый пост)
PRGB(AddrD)^.R := PNG.GammaTable[rgbRed];


Что за PRGB, где это объявлено?

Автор: Akella 2.8.2012, 13:32
И PRGB32?

Автор: Akella 2.8.2012, 13:36
Я правильно объявил?

Код

type
  pRGB = ^TRGB;
  TRGB = record
    R: Integer;
    G: Integer;
    B: Integer;
  end;


PRGB32 = ^TRGB32;
  TRGB32 = packed record
    R, G, B: Cardinal;
  end;

Автор: Akella 2.8.2012, 14:51
Цитата(Illusion Dolphin @  1.8.2012,  16:29 Найти цитируемый пост)
procedure LoadPNGImagePalette(PNG: TPNGImage; Bitmap: TBitmap);


в этой процедуре на итерации, когда I = 7, ошибка, AV

Цитата
Project raised exception class EPngError with message 'There is no such palette entry.'


во "второй" части процедуры, после  end else begin

Автор: Illusion Dolphin 2.8.2012, 20:23
Цитата

5PRkW.png 0,40 Kb

Ох, тут придётся модифицировать код, т.к. он только для 8 бит, а тут 4....

Автор: x128 2.8.2012, 21:27
Прикрепил пример. В примере любой PNG приводится к единому формату RGBA и результат ресайзится.

Автор: x128 2.8.2012, 21:50
Хм... Заметил странную особенность, StretchBlt в режиме HALFTONE не сглаживает приложенную картинку при увеличении... Но это мелочи. Меня больше интересует, зачем нужно эту картинку обрабатывать с прозрачностью и зачем работать с PNG напрямую? Я так полагаю, что будет какая-то обработка и скорее всего распознавание и в таком случае достаточно получить битмап и без прозрачности.
Код

var
  bmp: TBitmap;
  png: TPNGObject;
...
  bmp:=TBitmap.Create;
  bmp.PixelFormat:=pf24bit;
  bmp.SetSize(png.Width, png.Height);
  with bmp.Canvas do  
    Brush.Color:=clWhite;
    FillRect(ClipRect);
    Draw(0,0,png);
  end;

Автор: Illusion Dolphin 2.8.2012, 22:02
А вот и обновление, проверил со всеми вроде бы возможными форматами для COLOR_PALETTE:
Код


procedure LoadPNGImagePalette(PNG: TPNGImage; Bitmap: TBitmap);
var
  I, J: Integer;
  P: Byte;
  DeltaS, DeltaD: Integer;
  AddrLineS, AddrLineD: NativeInt;
  AddrS, AddrD: NativeInt;
  Chunk: TChunkPLTE;
  TRNS: TChunktRNS;
  BitDepth, BitDepthD8,
  Rotater, ColorMask: Byte;
begin
  if PNG.Transparent then
    Bitmap.PixelFormat := pf32bit
  else
    Bitmap.PixelFormat := pf24bit;

  Bitmap.SetSize(PNG.Width, PNG.Height);

  AddrLineS := NativeInt(PNG.ScanLine[0]);
  AddrLineD := NativeInt(Bitmap.ScanLine[0]);
  DeltaS := 0;
  DeltaD := 0;
  if PNG.Height > 1 then
  begin
    DeltaS := NativeInt(PNG.ScanLine[1]) - AddrLineS;
    DeltaD := NativeInt(Bitmap.ScanLine[1])- AddrLineD;
  end;

  BitDepth := PNG.Header.BitDepth; //1,2,4,8 only, 16 not supported by PNG specification

  //{2 bits for each pixel is not supported by windows bitmap} -> see PNG implementation
  if BitDepth = 2 then
    BitDepth := 4;

  BitDepthD8 := 8 - BitDepth;
  ColorMask := (255 shl BitDepthD8) and 255;

  Chunk := TChunkPLTE(PNG.Chunks.ItemFromClass(TChunkPLTE));
  if not PNG.Transparent then
  begin
    for I := 0 to PNG.Height - 1 do
    begin
      AddrS := AddrLineS;
      AddrD := AddrLineD;
      Rotater := 0;
      for J := 0 to PNG.Width - 1 do
      begin
        Rotater := J * BitDepth mod 8;

        P := ((PByte(AddrS + (J * BitDepth) div 8)^ shl Rotater) and ColorMask) shr BitDepthD8;

        with Chunk.Item[P] do
        begin
          PRGB(AddrD)^.R := PNG.GammaTable[rgbRed];
          PRGB(AddrD)^.G := PNG.GammaTable[rgbGreen];
          PRGB(AddrD)^.B := PNG.GammaTable[rgbBlue];
        end;

        Inc(AddrD, 3);
      end;
      Inc(AddrLineS, DeltaS);
      Inc(AddrLineD, DeltaD);
    end;
  end else
  begin
    TRNS := PNG.Chunks.ItemFromClass(TChunktRNS) as TChunktRNS;
    for I := 0 to PNG.Height - 1 do
    begin
      AddrS := AddrLineS;
      AddrD := AddrLineD;
      Rotater := 0;
      for J := 0 to PNG.Width - 1 do
      begin
        Rotater := J * BitDepth mod 8;

        P := ((PByte(AddrS + (J * BitDepth) div 8)^ shl Rotater) and ColorMask) shr BitDepthD8;

        with Chunk.Item[P] do
        begin
          PRGB32(AddrD)^.R := PNG.GammaTable[rgbRed];
          PRGB32(AddrD)^.G := PNG.GammaTable[rgbGreen];
          PRGB32(AddrD)^.B := PNG.GammaTable[rgbBlue];
          PRGB32(AddrD)^.L := TRNS.PaletteValues[P]; //set directly to 255 to disable transparency
        end;

        Inc(AddrD, 4);
      end;
      Inc(AddrLineS, DeltaS);
      Inc(AddrLineD, DeltaD);
    end;
  end;
end;


Добавлено @ 22:10
x128, В твоём коде есть пара моментов:
1) Не thread-safe (если, конечно, это не требуется). В моём случае это поддерживается.
2) Не работает с некоторыми изображениями (если это важно - в аттаче пример).

Автор: x128 2.8.2012, 23:39
Цитата(Illusion Dolphin @  2.8.2012,  22:02 Найти цитируемый пост)
Не работает с некоторыми изображениями (если это важно - в аттаче пример).

Действительно, что-то я с COLOR_GRAYSCALE тормознул...

Автор: Akella 3.8.2012, 09:05
Цитата(x128 @ 2.8.2012,  21:50)
Хм... Заметил странную особенность, StretchBlt в режиме HALFTONE не сглаживает приложенную картинку при увеличении... Но это мелочи. Меня больше интересует, зачем нужно эту картинку обрабатывать с прозрачностью и зачем работать с PNG напрямую? Я так полагаю, что будет какая-то обработка и скорее всего распознавание и в таком случае достаточно получить битмап и без прозрачности.
Код

var
  bmp: TBitmap;
  png: TPNGObject;
...
  bmp:=TBitmap.Create;
  bmp.PixelFormat:=pf24bit;
  bmp.SetSize(png.Width, png.Height);
  with bmp.Canvas do  
    Brush.Color:=clWhite;
    FillRect(ClipRect);
    Draw(0,0,png);
  end;

Да, имеено bitmap я в итоге и хочу получить!! Нормальный, читабельный bitmap.
Теми простыми способами через <TImage>.Picture.Graphic с пересохранением, получается плохо. Компонента распознавания видиц цифры, но плохо распознает. А когда я исходный png конвертирую в bitmap с помощью ACDSee, то компонента распознавания прекрасно распознает, почти на 100%. Автор компоненты,которую я купил (winsoае ocr) молчит, никаких рекомендаций не даёт.

Автор: Akella 3.8.2012, 09:36
Illusion Dolphin, ты так и не ответил, что за prgb и prgb32

Автор: Akella 3.8.2012, 09:58
Цитата(x128 @ 2.8.2012,  23:39)
Цитата(Illusion Dolphin @  2.8.2012,  22:02 Найти цитируемый пост)
Не работает с некоторыми изображениями (если это важно - в аттаче пример).

Действительно, что-то я с COLOR_GRAYSCALE тормознул...

x128, почему на этой строке  src принимает значение nil
Код
src:=png.AlphaScanline[y];


вызываю так:
Код

      png.LoadFromStream(img_stream);
      ResizePNG(png, png.Width * 2, png.Height * 2, true);

Автор: x128 3.8.2012, 11:14
Цитата(Akella @  3.8.2012,  09:58 Найти цитируемый пост)
 почему на этой строке  src принимает значение nil

Скорее всего, изображение не имеет альфа-канала. Перед вызовом ResizePNG, нужно преобразовать PNG через ConvertToRGBA. И еще, ResizePNG в это функция которая возвращает новый PNG, эсли ты не переделывал, то вызов должен быть другим.
Код

      var
         tmp: TPNGObject;
...
      png.LoadFromStream(img_stream);
      ConvertToRGBA(png);
      tmp:=ResizePNG(png, png.Width * 2, png.Height * 2, true);

Автор: Akella 3.8.2012, 11:31
Цитата(x128 @  3.8.2012,  11:14 Найти цитируемый пост)
Скорее всего, изображение не имеет альфа-канала. Перед вызовом ResizePNG, нужно преобразовать PNG через ConvertToRGBA


но там тоже есть код:

Код

        src:=png.Scanline[y];
...
...
            8: i:=src[x];

Автор: x128 3.8.2012, 11:55
Цитата(Akella @  3.8.2012,  11:31 Найти цитируемый пост)
но там тоже есть код:

Scanline и AlphaScanline немного разные вещи. Процедура ConvertToRGBA преобразовывает png в COLOR_RGBALPHA, а функция ResizePNG работает исключительно с этим форматом. Переписать можно как нужно или удобно, я просто хотел наглядно показать что и как.

Автор: Akella 3.8.2012, 12:10
ага понял, спасибо

Добавлено через 1 минуту и 30 секунд
Теперь вопрос по преобразованию в BMP.

Вот мой код

Код

      png.LoadFromStream(img_stream);
      ConvertToRGBA(png);
      SmoothResize(png, png.Width * 3, png.Height * 3);
      png.SetSize(png.Width + 2, png.Height + 2);
      png.SaveToFile('d:\png.png');
      Ocr1.Picture.Bitmap.PixelFormat := pf24bit;
      Ocr1.Picture.Bitmap.Assign(png);
      Ocr1.Picture.Bitmap.SaveToFile('d:\bmp.bmp');


в итоге картинка bmp выглядит не совсем читабельно: 

user posted image

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

Автор: x128 3.8.2012, 14:10
как-то так:
Код

      png.LoadFromStream(img_stream);
      ConvertToRGBA(png);
      SmoothResize(png, png.Width * 3, png.Height * 3);
      png.SetSize(png.Width + 2, png.Height + 2);
      png.SaveToFile('d:\png.png');
      with Ocr1.Picture.Bitmap do begin
        PixelFormat := pf24bit;
        SetSize(png.Width, png.Height);
        with Canvas do begin
          Brush.Color:=clWhite;
          FillRect(ClipRect);
          Draw(0,0,png);
        end;
        SaveToFile('d:\bmp.bmp');
      end;

Автор: Akella 3.8.2012, 15:30
Да вы просто шайтаны  smile  smile  smile 

Автор: Illusion Dolphin 4.8.2012, 15:38
Вроде уже что надо было получили, но раз вопрос есть отвечу smile
Цитата

ты так и не ответил, что за prgb и prgb32 

Это описание пиксела для 24 и 32 битных битмапов, вот описание полное:
Код

type
  TRGB = record
    B, G, R : Byte;
  end;

  ARGB = array [0..32677] of TRGB;
  PARGB = ^ARGB;
  PRGB = ^TRGB;
  PARGBArray = array of PARGB;

  TRGB32 = record
    B, G, R, L : byte;
  end;

  ARGB32 = array [0..32677] of TRGB32;
  PARGB32 = ^ARGB32;
  PRGB32 = ^TRGB32;
  PARGB32Array = array of PARGB32;


Я смотрю тут автоматизатор капчи делается, не знаю какое их количество, но если много или они не из главного потока обрабатываются то код с канвой будет раз на 10 случаев (приблизительно) выдавать пустой результат.  

Цитата

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


Применимо к моему коду там есть коментарий - "//set directly to 255 to disable transparency" - вот если проверить тут прозрачность то можно делать фон любого цвета устанавливая другие значения и если надо через прозрачность:
Код

PRGB(AddrD)^.R := (PNG.GammaTable[rgbRed] * (255 - TRNS.PaletteValues[P]) + 255 * TRNS.PaletteValues[P] + $7F) div $FF;

Автор: Akella 6.8.2012, 09:21
Цитата(Illusion Dolphin @  4.8.2012,  15:38 Найти цитируемый пост)
Я смотрю тут автоматизатор капчи делается

нет, распознавать на картинках нужно номера телефонов smile

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)