TPngImage: глюк масштабирования и как это исправить

Обнаружил удивительную вещь — при масштабировании TPngImage картинка смещается относительно такой же картинки в TBitmap. Захотелось разобраться в причинах столь загадочного поведения.

Содержание скрыть

Как это выглядит

Предварительный анализ

Причина казуса

На конкретном примере

Решение

Делаем правильные коэффициенты

Билинейный фильтр

AlphaBlend

Окончательное решение: TBitmap

Аргумент раз: Bitmap внутри PNG

Аргумент два: Bitmap из PNG сделать просто

Аргумент три: Кесарю — кесарево

Напоследок

TPngImage из TBitmap

Сохранить TBitmap как PNG

Скачать

Как это выглядит

У нас есть некий PNG с альфой. Сделаем из него 32-разрядный Bitmap. Далее, кинем два TImage на форму, назначим в один PNG, в другой — BMP, и по переключателю будем менять видимость. Чтобы не моргало, выставим форме:

DoubleBuffered := True;

1	DoubleBuffered := True;

Для TImage выставим параметры масштабирования по умолчанию: Center, Proportional, Stretch := True.

Битмап делаем сами из PNG:

    bmp := TBitmap.Create;
    bmp.Assign(png);

1 2	bmp := TBitmap.Create; bmp.Assign(png);

В этом случае перенесётся и альфа, и правильно выставится AlphaFormat.

Переключаем просмотр с PNG на BMP и видим, что картинки смещены относительно друг друга. Кто-то из них глючит, и вряд ли это TBitmap.

Предварительный анализ

Три параметра, влияющих на масштаб при отрисовке, выведены в интерфейс. Немного поэкспериментировав, выясняем, что без масштаба оба формата рисуются пиксель-в-пиксель.

Сделаем ещё один PNG, с рамкой по краям, шириной в 3 пикселя, и посмотрим, как себя поведут PNG и BMP при масштабировании:

Замечаем, что при отрисовке масштабированного PNG рамка справа и снизу «съедается», а при отрисовке BMP такого не наблюдается.

Вывод: Баг в отрисовке PNG действительно есть.

Причина казуса

Идём в исходники PNG и видим, что при масштабировании TPngImage не использует WinApI, а самостоятельно пересчитывает координаты пикселей:

      FOR j := 1 TO H DO
      begin
        {Process all the pixels in this line}

        FOR i := 0 TO W - 1 DO
        begin
          if Stretch then i2 := trunc(i / FactorX) else i2 := i;
          // Вычисление цвета с учётом альфы
        end;  

        if Stretch then j2 := trunc(j / FactorY) else j2 := j;
      end;

FOR j := 1 TO H DO

begin

{Process all the pixels in this line}

FOR i := 0 TO W - 1 DO

begin

if Stretch then i2 := trunc(i / FactorX) else i2 := i;

// Вычисление цвета с учётом альфы

end;

if Stretch then j2 := trunc(j / FactorY) else j2 := j;

end;

Понятно, что это нужно для самостоятельного вычисления цвета с учётом альфа-канала, но индексация нарушается. Trunc при нецелых коэффициентах систематически округляет вниз. Каждый целевой пиксель берёт исходный, который расположен чуть левее и выше правильного. В результате контент как бы «не дотягивается» до правого и нижнего края и рамка справа и снизу обрезается, а изображение растягивается на «недопрочитанную» величину.

На конкретном примере

У нас картинка 800 x 625. Прямоугольник, в котором происходит отрисовка: 436 x 341. Коэффициенты масштаба получаются такими:

// TPngImage: расчёт коэффициентов
if Stretch then FactorX := W/Header.Width else FactorX := 1;
if Stretch then FactorY := H/Header.Height else FactorY := 1;

// Вычисляем индексы для нашего случая
FactorX = W / Header.Width = 436 / 800 = 0.545
FactorY = H / Header.Height = 341 / 625 = 0.5456

// TPngImage: расчёт коэффициентов

if Stretch then FactorX := W/Header.Width else FactorX := 1;

if Stretch then FactorY := H/Header.Height else FactorY := 1;

// Вычисляем индексы для нашего случая

FactorX = W / Header.Width = 436 / 800 = 0.545

FactorY = H / Header.Height = 341 / 625 = 0.5456

Рамка справа находится в пикселях с индексами по X = 797, 798, 799:

i2 := trunc(i / FactorX)
Для последнего пикселя в строке
i2 := trunc(435 / 0.545) = Trunc(798.165) = 798  - ещё есть рамка
Для предпоследнего пикселя в строке
i2 := trunc(434 / 0.545) = Trunc(796.330) = 796  - уже нет

i2 := trunc(i / FactorX)

Для последнего пикселя в строке

i2 := trunc(435 / 0.545) = Trunc(798.165) = 798 - ещё есть рамка

Для предпоследнего пикселя в строке

i2 := trunc(434 / 0.545) = Trunc(796.330) = 796 - уже нет

Рамка снизу находится в пикселях с индексами по Y = 622, 623, 624:

j2 := trunc(j / FactorY)
Для последней обработанной строки
j2 := trunc(340 / 0.5456) = Trunc(623.167) = 623 - ещё есть рамка
Для предпоследней обработанной строки
j2 := trunc(339 / 0.5456) = Trunc(621.334) = 621 - уже нет

j2 := trunc(j / FactorY)

Для последней обработанной строки

j2 := trunc(340 / 0.5456) = Trunc(623.167) = 623 - ещё есть рамка

Для предпоследней обработанной строки

j2 := trunc(339 / 0.5456) = Trunc(621.334) = 621 - уже нет

Ну это же масштабирование, скажете вы. Было три пикселя, стал один — это нормально. Согласен, но посмотрим как себя ведёт округление на старте скан-линии:

0 / 0.545 = 0
1 / 0.545 = 1.84 = 1
2 / 0.545 = 3.67 = 3

0 / 0.545 = 0

1 / 0.545 = 1.84 = 1

2 / 0.545 = 3.67 = 3

Как минимум два пикселя рамки ухватили. Так, незаметно, ближе к концу картинка чуть-чуть вытягивается. И, таким образом, вся картинка немного деформируется вправо и вниз. Может что-то с коэффициентами не то?

Давайте представим себе, как должен вычисляться индекс, чтобы не терять пиксели:

i2 := trunc(i * (Header.Width - 1) / (W - 1));

1	i2 := trunc(i * (Header.Width - 1) / (W - 1));

Откуда это следует: при правильном маппинге первый целевой пиксель (i=0) должен соответствовать первому исходному (i2=0), а последний целевой (i=W-1) — последнему исходному (i2=Header.Width-1). Из этого граничного условия и следует формула.

Как вычисляются коэффициенты в TPngImage указано выше. Если индекс по X вычисляется так:

i2 := trunc(i / FactorX)

1	i2 := trunc(i / FactorX)

то, подставив формулу для коэффициента, получаем

i2 := trunc(i * Header.Width / W);

1	i2 := trunc(i * Header.Width / W);

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

А для TBitmap.Draw этой проблемы нет, масштабирование выполняет WinApI (StretchBlt или AlphaBlend). Поэтому и существует разница в отображении TPngImage и TBitmap.

Решение

Проблему и её причины мы определили. Давайте попробуем её решить.

Спойлер: окончательное решение — просто конвертировать PNG в TBitmap. Но путь к нему был интересным. Если путь самурая не интересует, можно переходить к окончательному решению.

Возможное решение — небольшая модификация исходника Vcl.Imaging.pngimage. Чтобы наши модификации возымели действие, копируем модуль в каталог проекта и меняем уже его.

Лютый хак. Так делать не надо

Чтобы видеть, как себя ведёт штатный TPngImage и видоизменённый, я переобозвал модуль Vcl.Imaging.pngimage, который лежит рядом с проектом в Vcl.Imaging.pngimage.Test. В предложении uses расположил модули в последовательности: Vcl.Imaging.pngimage.Test, Vcl.Imaging.pngimage. Родной Vcl.Imaging.pngimage идёт последним, чтобы IDE и компилятору было понятно, что TPngImage — это тот, что в Vcl.Imaging.pngimage.

Далее, в секции implementation задал новый тип для видоизменённого TPngImage:

type
  TPngImageTest = class(Vcl.Imaging.pngimage.Test.TPngImage);

1 2	type TPngImageTest = class(Vcl.Imaging.pngimage.Test.TPngImage);

Это сделано, чтобы можно было работать с разными классами TPngImage в одном приложении. Если модуль не переименовывать, то будет подхватываться именно тот, что рядом с проектом. То есть тот, в котором живёт модифицированный TPngImage.

Создаю экземпляр этого нового класса TPngImageTest (который на самом деле слегка изменённый TPngImage) следующим образом:

// Конвертировать TBitmap в TPNGImageTest с переносом альфа-канала
function BitmapToPNG(ABitmap: TBitmap): TPNGImageTest;
var 
  V: PByte; 
  P: PRGBQuad; 
  X, Y, W, H: Integer;
  SavedAF: TAlphaFormat;
begin
  if ABitmap = nil then
    exit(nil);
  W := ABitmap.Width;
  H := ABitmap.Height;
  Result := TPNGImageTest.Create;
  SavedAF := ABitmap.AlphaFormat;
  try
    ABitmap.PixelFormat := pf32Bit;
    ABitmap.AlphaFormat := afIgnored;
    try
      Result.Assign(ABitmap);
      Result.CreateAlpha;
      P := ABitmap.Scanline[ABitmap.Height-1];

      for Y := H-1 downto 0 do
      begin
        V := @Result.AlphaScanline[Y]^[0];
        for X := 0 to W-1 do
        begin
          V^ := P^.rgbReserved;
          Inc(P);
          Inc(V);
        end;
      end;
    finally
      ABitmap.AlphaFormat := SavedAF;
    end;
  except
    FreeAndNil(Result);
  end;
end;

// Конвертировать TBitmap в TPNGImageTest с переносом альфа-канала

function BitmapToPNG(ABitmap: TBitmap): TPNGImageTest;

var

V: PByte;

P: PRGBQuad;

X, Y, W, H: Integer;

SavedAF: TAlphaFormat;

begin

if ABitmap = nil then

exit(nil);

W := ABitmap.Width;

H := ABitmap.Height;

Result := TPNGImageTest.Create;

SavedAF := ABitmap.AlphaFormat;

try

ABitmap.PixelFormat := pf32Bit;

ABitmap.AlphaFormat := afIgnored;

try

Result.Assign(ABitmap);

Result.CreateAlpha;

P := ABitmap.Scanline[ABitmap.Height-1];

for Y := H-1 downto 0 do

begin

V := @Result.AlphaScanline[Y]^[0];

for X := 0 to W-1 do

begin

V^ := P^.rgbReserved;

Inc(P);

Inc(V);

end;

finally

ABitmap.AlphaFormat := SavedAF;

end;

except

FreeAndNil(Result);

end;

Сразу скажу, я против таких хаков без веской причины!

[свернуть]

Делаем правильные коэффициенты

В процедуре

procedure TPngImage.DrawPartialTrans(DC: HDC; Rect: TRect);

1	procedure TPngImage.DrawPartialTrans(DC: HDC; Rect: TRect);

находим строки, вычисляющие коэффициенты масштаба:

  if Stretch then FactorX := W/Header.Width else FactorX := 1;
  if Stretch then FactorY := H/Header.Height else FactorY := 1;

1 2	if Stretch then FactorX := W/Header.Width else FactorX := 1; if Stretch then FactorY := H/Header.Height else FactorY := 1;

и меняем их на:

  if Stretch and (Header.Width>1) then
    FactorX := (W-1)/(Header.Width-1)
  else
    FactorX := 1;

  if Stretch and (Header.Height>1) then
    FactorY := (H-1)/(Header.Height-1)
  else
    FactorY := 1;

if Stretch and (Header.Width>1) then

FactorX := (W-1)/(Header.Width-1)

else

FactorX := 1;

if Stretch and (Header.Height>1) then

FactorY := (H-1)/(Header.Height-1)

else

FactorY := 1;

Так распределение пикселов станет более ровным.

Сдвиг исчез. Рамка показывается как надо, без обрезки, но мы видим какую-то малозаметную деформацию картинки. Возможно, целочисленные индексы не дают нам того масштабирования, которого хотелось бы. Тут бы можно было и остановиться, но, возможно, нам поможет билинейный фильтр?

Билинейный фильтр

Что такое билинейная интерполяция — заслуживает отдельного разговора. И, возможно, когда-нибудь поговорим. Тема интересная, но случаев, когда её надо делать руками, не так уж много. А пока сходим в статью про перспективную трансформацию и похитим оттуда функцию билинейного фильтра. Немного переделаем под наш случай:

Билинейный фильтр для TPngImage

function GetBilinearColor(ASrc: PByte; AlphaSrc: PByte;
  u, v: Single; W, H: Integer): TRGBQuad;
const
  C = 3;
var
  x, y: Integer;
  fx, fy: Integer;          // дробная часть 0..256
  w1, w2, w3, w4: Integer;  // веса в fixed-point
  r, g, b, a: Integer;
  row0, row1: PByte;        // указатели на строки RGB
  arow0, arow1: PByte;      // указатели на строки Alpha
  p1, p2, p3, p4: PRGBTriple;
  stride: Integer;
begin
  if (W < 2) or (H < 2) then
  begin
    Result.rgbBlue := 255;
    Result.rgbGreen := 255;
    Result.rgbRed := 255;
    Result.rgbReserved := 255;
    exit;
  end;

  x := Trunc(u);
  y := Trunc(v);

  // Fixed-point дробная часть: 0..256
  fx := Round((u - x) * 256);
  fy := Round((v - y) * 256);

  // Clamp
  if x < 0 then begin x := 0; fx := 0; end
  else if x >= W - 1 then begin x := W - 2; fx := 256; end;
  if y < 0 then begin y := 0; fy := 0; end
  else if y >= H - 1 then begin y := H - 2; fy := 256; end;

  // Веса (сумма = 256*256 = 65536)
  w1 := (256 - fx) * (256 - fy);
  w2 := fx * (256 - fy);
  w3 := (256 - fx) * fy;
  w4 := fx * fy;

  stride := (((24 * W) + 31) and not 31) div 8; // Как в PNG
  // stride := BytesPerScanline(W, 24, 32); // Vcl.Graphics
  row0 := ASrc - y * stride;
  row1 := row0 - stride;

  p1 := PRGBTriple(row0 + x * C);
  p2 := PRGBTriple(row0 + (x + 1) * C);
  p3 := PRGBTriple(row1 + x * C);
  p4 := PRGBTriple(row1 + (x + 1) * C);

  r := p1^.rgbtRed * w1 + p2^.rgbtRed * w2 +
       p3^.rgbtRed * w3 + p4^.rgbtRed * w4;
  g := p1^.rgbtGreen * w1 + p2^.rgbtGreen * w2 +
       p3^.rgbtGreen * w3 + p4^.rgbtGreen * w4;
  b := p1^.rgbtBlue * w1 + p2^.rgbtBlue * w2 +
       p3^.rgbtBlue * w3 + p4^.rgbtBlue * w4;

  arow0 := AlphaSrc + y * W;
  arow1 := arow0 + W;

  a := arow0[x] * w1 + arow0[x + 1] * w2 +
       arow1[x] * w3 + arow1[x + 1] * w4;

  // Сдвиг на 16 (= деление на 65536) с округлением
  Result.rgbRed   := (r + 32768) shr 16;
  Result.rgbGreen := (g + 32768) shr 16;
  Result.rgbBlue  := (b + 32768) shr 16;
  Result.rgbReserved := (a + 32768) shr 16;
end;

function GetBilinearColor(ASrc: PByte; AlphaSrc: PByte;

u, v: Single; W, H: Integer): TRGBQuad;

const

C = 3;

var

x, y: Integer;

fx, fy: Integer; // дробная часть 0..256

w1, w2, w3, w4: Integer; // веса в fixed-point

r, g, b, a: Integer;

row0, row1: PByte; // указатели на строки RGB

arow0, arow1: PByte; // указатели на строки Alpha

p1, p2, p3, p4: PRGBTriple;

stride: Integer;

begin

if (W < 2) or (H < 2) then

begin

Result.rgbBlue := 255;

Result.rgbGreen := 255;

Result.rgbRed := 255;

Result.rgbReserved := 255;

exit;

end;

x := Trunc(u);

y := Trunc(v);

// Fixed-point дробная часть: 0..256

fx := Round((u - x) * 256);

fy := Round((v - y) * 256);

// Clamp

if x < 0 then begin x := 0; fx := 0; end

else if x >= W - 1 then begin x := W - 2; fx := 256; end;

if y < 0 then begin y := 0; fy := 0; end

else if y >= H - 1 then begin y := H - 2; fy := 256; end;

// Веса (сумма = 256*256 = 65536)

w1 := (256 - fx) * (256 - fy);

w2 := fx * (256 - fy);

w3 := (256 - fx) * fy;

w4 := fx * fy;

stride := (((24 * W) + 31) and not 31) div 8; // Как в PNG

// stride := BytesPerScanline(W, 24, 32); // Vcl.Graphics

row0 := ASrc - y * stride;

row1 := row0 - stride;

p1 := PRGBTriple(row0 + x * C);

p2 := PRGBTriple(row0 + (x + 1) * C);

p3 := PRGBTriple(row1 + x * C);

p4 := PRGBTriple(row1 + (x + 1) * C);

r := p1^.rgbtRed * w1 + p2^.rgbtRed * w2 +

p3^.rgbtRed * w3 + p4^.rgbtRed * w4;

g := p1^.rgbtGreen * w1 + p2^.rgbtGreen * w2 +

p3^.rgbtGreen * w3 + p4^.rgbtGreen * w4;

b := p1^.rgbtBlue * w1 + p2^.rgbtBlue * w2 +

p3^.rgbtBlue * w3 + p4^.rgbtBlue * w4;

arow0 := AlphaSrc + y * W;

arow1 := arow0 + W;

a := arow0[x] * w1 + arow0[x + 1] * w2 +

arow1[x] * w3 + arow1[x + 1] * w4;

// Сдвиг на 16 (= деление на 65536) с округлением

Result.rgbRed := (r + 32768) shr 16;

Result.rgbGreen := (g + 32768) shr 16;

Result.rgbBlue := (b + 32768) shr 16;

Result.rgbReserved := (a + 32768) shr 16;

end;

[свернуть]

Суть переделки в том, что вещественные расчёты заменены целочисленной арифметикой. Также учли тот факт, что PNG хранит цвет и альфу в отдельных массивах. Причём цвет 24-битный, TRGBTriple.

Теперь разберёмся, как рисует прозрачность TPngImage. Когда его просят отрисовать себя на указанном холсте DC в заданном прямоугольнике Rect, он создаёт внутри себя временный битмап и рисует в него содержимое холста из этого прямоугольника:

  // Selects new bitmap and release old bitmap
  OldBitmap := SelectObject(BufferDC, BufferBitmap);
  // Draws the background on the buffer image
  BitBlt(BufferDC, 0, 0, W, H, DC, Rect.Left, Rect.Top, SRCCOPY);

// Selects new bitmap and release old bitmap

OldBitmap := SelectObject(BufferDC, BufferBitmap);

// Draws the background on the buffer image

BitBlt(BufferDC, 0, 0, W, H, DC, Rect.Left, Rect.Top, SRCCOPY);

Делается это затем, чтобы потом смешивать пиксель изображения с пикселем фона, согласно формуле:

DestColor := (SourceColor * A + DestColor * (255-A) + 127) div 255;

1 2	DestColor := (SourceColor * A + DestColor * (255-A) + 127) div 255;

Далее происходит цикл по строкам и внутренний цикл по пикселам в строке, в котором происходит расчёт цвета пикселя с учётом прозрачности. Для того, чтобы найти исходный пиксель, используются коэффициенты масштаба FactorX, FactorY, которые мы теперь считаем более правильно. На основании этих коэффициентов находятся индексы пикселя источника [i2, j2]. Конечный цвет пикселя формируется так:

     with ImageData[i] do
     begin
       rgbRed := ($7F + ImageSource[2+i2*3] * AlphaSource[i2] + 
           rgbRed * (not AlphaSource[i2])) div $FF;
       rgbGreen := ($7F + ImageSource[1+i2*3] * AlphaSource[i2] +
           rgbGreen * (not AlphaSource[i2])) div $FF;
       rgbBlue := ($7F + ImageSource[i2*3] * AlphaSource[i2] + 
           rgbBlue * (not AlphaSource[i2])) div $FF;
       rgbReserved := not (($7F + (not rgbReserved) * 
           (not AlphaSource[i2])) div $FF);
     end;

with ImageData[i] do

begin

rgbRed := ($7F + ImageSource[2+i2*3] * AlphaSource[i2] +

rgbRed * (not AlphaSource[i2])) div $FF;

rgbGreen := ($7F + ImageSource[1+i2*3] * AlphaSource[i2] +

rgbGreen * (not AlphaSource[i2])) div $FF;

rgbBlue := ($7F + ImageSource[i2*3] * AlphaSource[i2] +

rgbBlue * (not AlphaSource[i2])) div $FF;

rgbReserved := not (($7F + (not rgbReserved) *

(not AlphaSource[i2])) div $FF);

end;

За приёмник отвечает ImageData, за исходные данные ImageSource и AlphaSource. Далее, полученный битмап рисуется на холсте и уничтожается:

  {Draws the new bitmap on the foreground}
  BitBlt(DC, Rect.Left, Rect.Top, W, H, BufferDC, 0, 0, SRCCOPY);

  {Free bitmap}
  SelectObject(BufferDC, OldBitmap);
  DeleteObject(BufferBitmap);
  DeleteDC(BufferDC);

{Draws the new bitmap on the foreground}

BitBlt(DC, Rect.Left, Rect.Top, W, H, BufferDC, 0, 0, SRCCOPY);

{Free bitmap}

SelectObject(BufferDC, OldBitmap);

DeleteObject(BufferBitmap);

DeleteDC(BufferDC);

Что нам не нравится. Нам не нравится, что целочисленные индексы дают какую-то непонятную деформацию. И вот бы здорово как-то задействовать вещественные индексы. Ну так давайте задействуем:

var 
  // Добавим переменные
  Temp: TRGBQuad; // Цвет по билинейному фильтру
  i2s, j2s: Single; // Вещественные индексы
begin
  ...
  24:
    FOR j := 1 TO H DO
    begin
      {Process all the pixels in this line}
      FOR i := 0 TO W - 1 DO
        begin
          if Stretch then i2 := trunc(i / FactorX) else i2 := i;
          if Stretch then i2s := i / FactorX else i2s := i; // тут
          ...
        end; 
      ...
      if Stretch then j2s := j / FactorY else j2s := j; // и тут
      ... 
    end;

var

// Добавим переменные

Temp: TRGBQuad; // Цвет по билинейному фильтру

i2s, j2s: Single; // Вещественные индексы

begin

...

24:

FOR j := 1 TO H DO

begin

{Process all the pixels in this line}

FOR i := 0 TO W - 1 DO

begin

if Stretch then i2 := trunc(i / FactorX) else i2 := i;

if Stretch then i2s := i / FactorX else i2s := i; // тут

...

end;

...

if Stretch then j2s := j / FactorY else j2s := j; // и тут

...

end;

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

    Temp := GetBilinearColor(
      PByte(ImageSourceOrg), // Источник
      PByte(Header.ImageAlpha), // Источник альфы
      i2s, // i / FactorX
      j2s, // j / FactorY
      Header.Width, Header.Height); // Ширина x Высота источника

Temp := GetBilinearColor(

PByte(ImageSourceOrg), // Источник

PByte(Header.ImageAlpha), // Источник альфы

i2s, // i / FactorX

j2s, // j / FactorY

Header.Width, Header.Height); // Ширина x Высота источника

И установим цвет уже с учётом рассчитанного цвета:

   with ImageData[i] do
   begin
     rgbRed := ($7F + Temp.rgbRed * Temp.rgbReserved +
       rgbRed * (not Temp.rgbReserved)) div $FF;
     rgbGreen := ($7F + Temp.rgbGreen * Temp.rgbReserved +
       rgbGreen * (not Temp.rgbReserved)) div $FF;
     rgbBlue := ($7F + Temp.rgbBlue * Temp.rgbReserved +
       rgbBlue * (not Temp.rgbReserved)) div $FF;
     rgbReserved := not (($7F + (not rgbReserved) *
       (not Temp.rgbReserved)) div $FF);
   end;

with ImageData[i] do

begin

rgbRed := ($7F + Temp.rgbRed * Temp.rgbReserved +

rgbRed * (not Temp.rgbReserved)) div $FF;

rgbGreen := ($7F + Temp.rgbGreen * Temp.rgbReserved +

rgbGreen * (not Temp.rgbReserved)) div $FF;

rgbBlue := ($7F + Temp.rgbBlue * Temp.rgbReserved +

rgbBlue * (not Temp.rgbReserved)) div $FF;

rgbReserved := not (($7F + (not rgbReserved) *

(not Temp.rgbReserved)) div $FF);

end;

Результат безусловно лучше, но всё равно видна небольшая деформация внутри изображения.

Билинейная интерполяция безусловно помогла, сдвига больше нет. Но, сделанная руками, без использования SSE, она… медленная. Может быть попробуем AlphaBlend? Она ж для этого и создавалась в своё время.

AlphaBlend

AlphaBlend — WinApi функция, которая отображает растровые изображения, содержащие прозрачные или полупрозрачные пиксели.

Для чего мы хотим её использовать. Во-первых, AlphaBlend умеет рисовать битовый образ с альфа-каналом, во-вторых, умеет масштабировать. Мы хотим уйти от правильной, но медленной билинейной интерполяции, но при этом не потерять прозрачность.

Очевидно, что надо писать дополнительный метод отрисовки. Мы не собираемся формировать прозрачность каждого пикселя. Вместо этого, мы должны подготовить правильный битовый образ для AlphaBlend.

Для того, чтобы функция учитывала альфу каждого пикселя, мы должны использовать формат AC_SRC_ALPHA:

  BF.AlphaFormat := AC_SRC_ALPHA;

1	BF.AlphaFormat := AC_SRC_ALPHA;

Функция AlphaBlend с флагом AC_SRC_ALPHA требует, чтобы исходные данные были в формате premultiplied alpha — то есть каждый цветовой компонент должен быть предварительно умножен на альфу:

R_premul = R * A / 255
G_premul = G * A / 255
B_premul = B * A / 255

R_premul = R * A / 255

G_premul = G * A / 255

B_premul = B * A / 255

Напишем пару перегруженных inline-функций для этого:

function GetPremultiplyQuad(const V: TRGBTriple; A: Byte): TRGBQuad; 
  overload; inline;
begin
  Result.rgbBlue := (V.rgbtBlue * A + 127) div 255;
  Result.rgbGreen := (V.rgbtGreen * A + 127) div 255;
  Result.rgbRed := (V.rgbtRed * A + 127) div 255;
  Result.rgbReserved := A;
end;

function GetPremultiplyQuad(const V: TRGBQuad): TRGBQuad; 
  overload; inline;
begin
  Result.rgbBlue := (V.rgbBlue * V.rgbReserved + 127) div 255;
  Result.rgbGreen := (V.rgbGreen * V.rgbReserved + 127) div 255;
  Result.rgbRed := (V.rgbRed * V.rgbReserved + 127) div 255;
  Result.rgbReserved := V.rgbReserved;
end;

function GetPremultiplyQuad(const V: TRGBTriple; A: Byte): TRGBQuad;

overload; inline;

begin

Result.rgbBlue := (V.rgbtBlue * A + 127) div 255;

Result.rgbGreen := (V.rgbtGreen * A + 127) div 255;

Result.rgbRed := (V.rgbtRed * A + 127) div 255;

Result.rgbReserved := A;

end;

function GetPremultiplyQuad(const V: TRGBQuad): TRGBQuad;

overload; inline;

begin

Result.rgbBlue := (V.rgbBlue * V.rgbReserved + 127) div 255;

Result.rgbGreen := (V.rgbGreen * V.rgbReserved + 127) div 255;

Result.rgbRed := (V.rgbRed * V.rgbReserved + 127) div 255;

Result.rgbReserved := V.rgbReserved;

end;

Для экономии тактов, GetPremultiplyQuad(const V: TRGBQuad) не вызывает GetPremultiplyQuad(const V: TRGBTriple; A: Byte), а выполняет все вычисления внутри себя.

Цикл для формирования битового образа для AlphaBlend уменьшается до простого перебора и сильно напоминает код из предыдущей статьи TBitmap.ScanLine:

  for j := 0 to Header.Height-1 do
  begin
    PByte(ImageSource) := PByte(ImageSourceOrg) -
      BytesPerRowSrc * j;
    PByte(AlphaSource) := PByte(Header.ImageAlpha) +
      BytesPerRowAlpha * j;
    for i := 0 to Header.Width-1 do
    begin
      ImageData^ := GetPremultiplyQuad(ImageSource^,
        AlphaSource[i]);
      Inc(ImageSource);
      Inc(ImageData);
    end;
  end;

for j := 0 to Header.Height-1 do

begin

PByte(ImageSource) := PByte(ImageSourceOrg) -

BytesPerRowSrc * j;

PByte(AlphaSource) := PByte(Header.ImageAlpha) +

BytesPerRowAlpha * j;

for i := 0 to Header.Width-1 do

begin

ImageData^ := GetPremultiplyQuad(ImageSource^,

AlphaSource[i]);

Inc(ImageSource);

Inc(ImageData);

end;

Делаем метод класса TPngImage, который на основании 24-битных данных заголовка и массива альфы формирует 32-битный Bitmap и отрисовывает его в заданном прямоугольнике, используя возможности масштабирования функции AlphaBlend. Делаем всё на голом WinApi, как это принято в этом модуле:

Метод отрисовки PNG с использованием AlphaBlend

procedure TPngImage.DrawPartialTransAlpha(DC: HDC; Rect: TRect);
const
  // Structure used to create the bitmap
  BitmapInfoHeader: TBitmapInfoHeader =
    (biSize: sizeof(TBitmapInfoHeader);
     biWidth: 100;
     biHeight: 100;
     biPlanes: 1;
     biBitCount: 32;
     biCompression: BI_RGB;
     biSizeImage: 0;
     biXPelsPerMeter: 0;
     biYPelsPerMeter: 0;
     biClrUsed: 0;
     biClrImportant: 0);
var
  // Buffer bitmap creation
  BitmapInfo  : TBitmapInfo;
  BufferDC    : HDC;
  BufferBits  : Pointer;
  OldBitmap,
  BufferBitmap: HBitmap;
  Header: TChunkIHDR;

  // Buffer bitmap modification
  BytesPerRowSrc, BytesPerRowAlpha: Integer;
  ImageSource, ImageSourceOrg: PRGBTriple;
  AlphaSource : pByteArray;
  ImageData: PRGBQuad;
  i, j: Integer;
  BF: TBlendFunction;
begin
  if (Rect.Right = Rect.Left) or (Rect.Bottom = Rect.Top) then
    exit;
  Header := Self.Header; // Fast access to header

  // Prepare to create the bitmap
  Fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
  BitmapInfoHeader.biWidth := Header.Width;
  BitmapInfoHeader.biHeight := -Integer(Header.Height);
  BitmapInfo.bmiHeader := BitmapInfoHeader;

  // Create the bitmap which will receive the background, the applied
  // alpha blending and then will be painted on the background
  BufferDC := CreateCompatibleDC(0);
  // In case BufferDC could not be created
  if (BufferDC = 0) then RaiseError(EPNGOutMemory, EPNGOutMemoryText);
  BufferBitmap := CreateDIBSection(BufferDC, BitmapInfo, DIB_RGB_COLORS,
    BufferBits, 0, 0);
  // In case buffer bitmap could not be created
  if (BufferBitmap = 0) or (BufferBits = Nil) then
  begin
    if BufferBitmap <> 0 then DeleteObject(BufferBitmap);
    DeleteDC(BufferDC);
    RaiseError(EPNGOutMemory, EPNGOutMemoryText);
  end;

  // Selects new bitmap and release old bitmap
  OldBitmap := SelectObject(BufferDC, BufferBitmap);

  // Obtain number of bytes for each row
  BytesPerRowAlpha := Header.Width;
  BytesPerRowSrc := (((Header.BitmapInfo.bmiHeader.biBitCount * Header.Width) +
    31) and not 31) div 8; // Number of bytes for each image row in source

  // Obtains image pointers
  ImageData := BufferBits;
  PByte(ImageSourceOrg) := PByte(Header.ImageData) +
    Header.BytesPerRow * Longint(Header.Height - 1);

  for j := 0 to Header.Height-1 do
  begin
    PByte(ImageSource) := PByte(ImageSourceOrg) -
      BytesPerRowSrc * j;
    PByte(AlphaSource) := PByte(Header.ImageAlpha) +
      BytesPerRowAlpha * j;
    for i := 0 to Header.Width-1 do
    begin
      ImageData^ := GetPremultiplyQuad(ImageSource^,
        AlphaSource[i]);
      Inc(ImageSource);
      Inc(ImageData);
    end;
  end;

  BF.BlendOp := AC_SRC_OVER;
  BF.BlendFlags := 0;
  BF.SourceConstantAlpha := 255;
  BF.AlphaFormat := AC_SRC_ALPHA;
  Winapi.Windows.AlphaBlend(DC, Rect.Left, Rect.Top, Rect.Width, Rect.Height,
    BufferDC, 0, 0, Header.Width, Header.Height, BF);

  // Free bitmap
  SelectObject(BufferDC, OldBitmap);
  DeleteObject(BufferBitmap);
  DeleteDC(BufferDC);
end;

procedure TPngImage.DrawPartialTransAlpha(DC: HDC; Rect: TRect);

const

// Structure used to create the bitmap

BitmapInfoHeader: TBitmapInfoHeader =

(biSize: sizeof(TBitmapInfoHeader);

biWidth: 100;

biHeight: 100;

biPlanes: 1;

biBitCount: 32;

biCompression: BI_RGB;

biSizeImage: 0;

biXPelsPerMeter: 0;

biYPelsPerMeter: 0;

biClrUsed: 0;

biClrImportant: 0);

var

// Buffer bitmap creation

BitmapInfo : TBitmapInfo;

BufferDC : HDC;

BufferBits : Pointer;

OldBitmap,

BufferBitmap: HBitmap;

Header: TChunkIHDR;

// Buffer bitmap modification

BytesPerRowSrc, BytesPerRowAlpha: Integer;

ImageSource, ImageSourceOrg: PRGBTriple;

AlphaSource : pByteArray;

ImageData: PRGBQuad;

i, j: Integer;

BF: TBlendFunction;

begin

if (Rect.Right = Rect.Left) or (Rect.Bottom = Rect.Top) then

exit;

Header := Self.Header; // Fast access to header

// Prepare to create the bitmap

Fillchar(BitmapInfo, sizeof(BitmapInfo), #0);

BitmapInfoHeader.biWidth := Header.Width;

BitmapInfoHeader.biHeight := -Integer(Header.Height);

BitmapInfo.bmiHeader := BitmapInfoHeader;

// Create the bitmap which will receive the background, the applied

// alpha blending and then will be painted on the background

BufferDC := CreateCompatibleDC(0);

// In case BufferDC could not be created

if (BufferDC = 0) then RaiseError(EPNGOutMemory, EPNGOutMemoryText);

BufferBitmap := CreateDIBSection(BufferDC, BitmapInfo, DIB_RGB_COLORS,

BufferBits, 0, 0);

// In case buffer bitmap could not be created

if (BufferBitmap = 0) or (BufferBits = Nil) then

begin

if BufferBitmap <> 0 then DeleteObject(BufferBitmap);

DeleteDC(BufferDC);

RaiseError(EPNGOutMemory, EPNGOutMemoryText);

end;

// Selects new bitmap and release old bitmap

OldBitmap := SelectObject(BufferDC, BufferBitmap);

// Obtain number of bytes for each row

BytesPerRowAlpha := Header.Width;

BytesPerRowSrc := (((Header.BitmapInfo.bmiHeader.biBitCount * Header.Width) +

31) and not 31) div 8; // Number of bytes for each image row in source

// Obtains image pointers

ImageData := BufferBits;

PByte(ImageSourceOrg) := PByte(Header.ImageData) +

Header.BytesPerRow * Longint(Header.Height - 1);

for j := 0 to Header.Height-1 do

begin

PByte(ImageSource) := PByte(ImageSourceOrg) -

BytesPerRowSrc * j;

PByte(AlphaSource) := PByte(Header.ImageAlpha) +

BytesPerRowAlpha * j;

for i := 0 to Header.Width-1 do

begin

ImageData^ := GetPremultiplyQuad(ImageSource^,

AlphaSource[i]);

Inc(ImageSource);

Inc(ImageData);

end;

BF.BlendOp := AC_SRC_OVER;

BF.BlendFlags := 0;

BF.SourceConstantAlpha := 255;

BF.AlphaFormat := AC_SRC_ALPHA;

Winapi.Windows.AlphaBlend(DC, Rect.Left, Rect.Top, Rect.Width, Rect.Height,

BufferDC, 0, 0, Header.Width, Header.Height, BF);

// Free bitmap

SelectObject(BufferDC, OldBitmap);

DeleteObject(BufferBitmap);

DeleteDC(BufferDC);

end;

[свернуть]

Данный метод предполагается использовать только для 24-битных PNG с альфа-каналом, для других форматов используется штатный DrawPartialTrans.

Вызывать метод будем из TPngImage.Draw:

{Draws the image into a canvas}
procedure TPngImage.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  Header: TChunkIHDR;
begin
  {Quit in case there is no header, otherwise obtain it}
  if Empty then Exit;
  Header := Chunks.GetItem(0) as TChunkIHDR;

  {Copy the data to the canvas}
  case Self.TransparencyMode of
  {$IFDEF PartialTransparentDraw}
    ptmPartial:
      if not UseFullAlphaBlend or (Header.BitmapInfo.bmiHeader.biBitCount<>24) then
        DrawPartialTrans(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect)
      else // Тут
        DrawPartialTransAlpha(ACanvas.Handle, Rect);
  {$ENDIF}
  ...
  end {case}
end;

{Draws the image into a canvas}

procedure TPngImage.Draw(ACanvas: TCanvas; const Rect: TRect);

var

Header: TChunkIHDR;

begin

{Quit in case there is no header, otherwise obtain it}

if Empty then Exit;

Header := Chunks.GetItem(0) as TChunkIHDR;

{Copy the data to the canvas}

case Self.TransparencyMode of

{$IFDEF PartialTransparentDraw}

ptmPartial:

if not UseFullAlphaBlend or (Header.BitmapInfo.bmiHeader.biBitCount<>24) then

DrawPartialTrans(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect)

else // Тут

DrawPartialTransAlpha(ACanvas.Handle, Rect);

{$ENDIF}

...

end {case}

end;

Получилось идеально. Быстро. Качественно. Но возникает ощущение, что всё то же самое делает битмап. Если посмотреть в исходники TBitmap, то убедимся, что мы, по сути, просто продублировали его функционал при PixelFormat = pf32Bit и AlphaFormat > afIgnored.

Окончательное решение: TBitmap

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

При TBitmap.Assign вызывается внутренний TPngImage.AssignTo, который корректно создаёт 32-битный TBitmap с AlphaFormat := afDefined. При этом альфа-канал сохраняется, а масштабирование берёт на себя WinApI.

Аргумент раз: Bitmap внутри PNG

Вся работа по отрисовке PNG происходит через создание битмапов. WinApi не умеет рисовать PNG, WinApi заточен под HBitmap. Никакого особого PNG-шного чуда тут нет. Более того, формирование битмапа у TPngImage сделано немного косячно, как мы выше убедились. Раз уж TPngImage всё равно делает битмап и руками его собирает перед каждой отрисовкой, не быстрее ли будет создать битмап один раз и у себя?

Аргумент два: Bitmap из PNG сделать просто

Битмап из PNG делается в две строки:

    bmp := TBitmap.Create;
    bmp.Assign(png);

1 2	bmp := TBitmap.Create; bmp.Assign(png);

Аргумент три: Кесарю — кесарево

В этом случае не надо вносить никаких изменений в штатный TPngImage. Нет трудностей с коллективным проектом и недоумением новичков. Плюс к тому, билинейный фильтр, сделанный руками, медленный. Его можно разогнать, но зачем, если всё может сделать AlphaBlend, которая вызывается в недрах TBitmap в случае 32-разрядной альфы.

Напоследок

В последней версии Delphi 13.0 Florence, на момент написания статьи, баг не исправлен.

TPngImage из TBitmap

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

function BitmapToPNG(ABitmap: TBitmap): TPNGImage;
var
  V: PByte;
  P: PRGBQuad;
  X, Y, W, H: Integer;
  SavedAF: TAlphaFormat;
begin
  if ABitmap = nil then
    exit(nil);
  W := ABitmap.Width;
  H := ABitmap.Height;
  Result := TPNGImage.Create;
  SavedAF := ABitmap.AlphaFormat;
  try
    ABitmap.PixelFormat := pf32Bit;
    ABitmap.AlphaFormat := afIgnored;
    try
      Result.Assign(ABitmap);
      Result.CreateAlpha;
      P := ABitmap.Scanline[ABitmap.Height-1];

      for Y := H-1 downto 0 do
      begin
        V := @Result.AlphaScanline[Y]^[0];
        for X := 0 to W-1 do
        begin
          V^ := P^.rgbReserved;
          Inc(P);
          Inc(V);
        end;
      end;
    finally
      ABitmap.AlphaFormat := SavedAF;
    end;
  except
    FreeAndNil(Result);
  end;
end;

function BitmapToPNG(ABitmap: TBitmap): TPNGImage;

var

V: PByte;

P: PRGBQuad;

X, Y, W, H: Integer;

SavedAF: TAlphaFormat;

begin

if ABitmap = nil then

exit(nil);

W := ABitmap.Width;

H := ABitmap.Height;

Result := TPNGImage.Create;

SavedAF := ABitmap.AlphaFormat;

try

ABitmap.PixelFormat := pf32Bit;

ABitmap.AlphaFormat := afIgnored;

try

Result.Assign(ABitmap);

Result.CreateAlpha;

P := ABitmap.Scanline[ABitmap.Height-1];

for Y := H-1 downto 0 do

begin

V := @Result.AlphaScanline[Y]^[0];

for X := 0 to W-1 do

begin

V^ := P^.rgbReserved;

Inc(P);

Inc(V);

end;

finally

ABitmap.AlphaFormat := SavedAF;

end;

except

FreeAndNil(Result);

end;

Сохранить TBitmap как PNG

Если понадобится сохранить TBitmap как PNG, то можем воспользоваться очень простой процедурой (публикация в телеге):

procedure SaveBitmapAs(Bitmap: TBitmap; const FileName: string);
var WIC: TWICImage; S: string;
begin
  WIC := TWICImage.Create;
  try
    WIC.Assign(Bitmap);
    S := ExtractFileExt(FileName).ToLower;
    if S='.png' then
      WIC.ImageFormat := wifPng
    else if (S='.jpg') or (S='.jpeg') then
      WIC.ImageFormat := wifJpeg
    else if S='.gif' then
      WIC.ImageFormat := wifGif
    else 
      WIC.ImageFormat := wifBmp;
    WIC.SaveToFile(FileName);
  finally
    WIC.Free;
  end;
end;

procedure SaveBitmapAs(Bitmap: TBitmap; const FileName: string);

var WIC: TWICImage; S: string;

begin

WIC := TWICImage.Create;

try

WIC.Assign(Bitmap);

S := ExtractFileExt(FileName).ToLower;

if S='.png' then

WIC.ImageFormat := wifPng

else if (S='.jpg') or (S='.jpeg') then

WIC.ImageFormat := wifJpeg

else if S='.gif' then

WIC.ImageFormat := wifGif

else

WIC.ImageFormat := wifBmp;

WIC.SaveToFile(FileName);

finally

WIC.Free;

end;

Скачать

Друзья, спасибо за внимание!

Исходник (zip) 1.19 Мб. Delphi XE 7

Исполняемый файл (zip) 1.87 Мб.

5 1 голос

Рейтинг статьи

0 комментариев

Старые

Новые Популярные

Межтекстовые Отзывы

Посмотреть все комментарии