Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Скопировать часть png 
V
    Опции темы
Poseidon
Дата 5.1.2015, 10:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133
Нужна функция, которая умеет копировать любой png (вне зависимости от наличия альфа-канала) по определенным координатам. Сейчас у меня есть вот что:

Код

function CopyPNG(const PNG: TPngImage; const R: TRect): TPngImage;
var
  i: Integer;
begin
  if not Assigned(PNG.AlphaScanline[0]) then
    PNG.CreateAlpha;

  Result := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, R.Width, R.Height);
  BitBlt(Result.Canvas.Handle, 0, 0, R.Width, R.Height, PNG.Canvas.Handle, R.Left, R.Top, SRCCOPY);

  for i := 0 to R.Height - 1 do
    begin
      if not Assigned(Result.AlphaScanline[i]) or not Assigned(PNG.AlphaScanline[i + R.Top]) then
        Break;

      CopyMemory(Result.AlphaScanline[i], PByte(Integer(PNG.AlphaScanline[i + R.Top]) + R.Left), R.Width);
    end;
end;


На некоторых картинках отрабатывает замечательно, но на некоторых не проходит условие (13 строка) и на выходе отдает "пустой" квадрат. Без этого условия 15я строка понятное дело выдает AV.

Прилаживаю картинку, с которой и возникают проблемы.

Вот набросал пример использования, что бы проще было:

Код

procedure GetImage;
var
  R: TRect;
  InPNG, OutPNG: TPngImage;
begin
  InPNG := TPngImage.Create;
  try
    InPNG.LoadFromFile('D:/aaa.png');
    R := TRect.Create(1, 53, 14, 66);

    OutPNG := CopyPNG(InPNG, R);
    try
      OutPNG.SaveToFile('D:/bbb.png');
    finally
      OutPNG.Free;
    end;
  finally
    InPNG.Free;
  end;
end;


С графикой я не очень, так что возможно тут не учтена какая-то мелочь. Но эта "мелочь" мне жизни не дает уже который день.

Присоединённый файл ( Кол-во скачиваний: 7 )
Присоединённый файл  aaa.png 5,89 Kb


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Illusion Dolphin
Дата 5.1.2015, 16:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63
Вариант PNG -> BMP -> COPY -> BMP -> PNG не подойдёт?

Добавлено через 1 минуту и 18 секунд
Ибо надо учитывать цветовые схемы:
Код

  COLOR_GRAYSCALE      = 0;
  COLOR_RGB            = 2;
  COLOR_PALETTE        = 3;
  COLOR_GRAYSCALEALPHA = 4;
  COLOR_RGBALPHA       = 6;




--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Poseidon
Дата 6.1.2015, 08:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133
Цитата(Illusion Dolphin @  5.1.2015,  16:11 Найти цитируемый пост)
Вариант PNG -> BMP -> COPY -> BMP -> PNG не подойдёт?
Этот вариант потеряет прозрачность. Хотелось бы ее оставлять. 

Цитата(Illusion Dolphin @  5.1.2015,  16:11 Найти цитируемый пост)
Ибо надо учитывать цветовые схемы:
Можно здесь по-подробнее?



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Illusion Dolphin
Дата 6.1.2015, 08:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63
Цитата

Можно здесь по-подробнее?

Вот код перевода из PNG в BMP, отсюда можно отковырять то, что надо:
Код

procedure AssignPNG(Dest: TBitmap; Src: TPngImage);
begin
  case Src.Header.ColorType of
    COLOR_GRAYSCALE:
      LoadPNGImage8BitWOTransparent(Src, Dest);
    COLOR_GRAYSCALEALPHA:
      LoadPNGImage8BitTransparent(Src, Dest);
    COLOR_PALETTE:
      LoadPNGImagePalette(Src, Dest);
    COLOR_RGB:
      LoadPNGImageWOTransparent(Src, Dest);
    COLOR_RGBALPHA:
      LoadPNGImageTransparent(Src, Dest);
    else
      Dest.Assign(Src);
  end;
end;

procedure LoadPNGImageTransparent(PNG: TPNGImage; Bitmap: TBitmap);
var
  I, J: Integer;
  DeltaS, DeltaSA, DeltaD: Integer;
  AddrLineS, AddrLineSA, AddrLineD: NativeInt;
  AddrS, AddrSA, AddrD: NativeInt;
begin
  if Bitmap.PixelFormat <> pf32bit then
    Bitmap.PixelFormat := pf32bit;

  Bitmap.SetSize(PNG.Width, PNG.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(AddrD)^ := PRGB(AddrS)^;
      Inc(AddrS, 3);
      Inc(AddrD, 3);
      PByte(AddrD)^ := PByte(AddrSA)^;
      if PByte(AddrD)^ = 0 then
        //integer is 4 bytes, but 4th byte is transparencity and it't = 0
        PInteger(AddrD - 3)^ := 0;
      Inc(AddrD, 1);
      Inc(AddrSA, 1);
    end;
    Inc(AddrLineS, DeltaS);
    Inc(AddrLineSA, DeltaSA);
    Inc(AddrLineD, DeltaD);
  end;
end;

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,16 bits for each pixel is not supported by windows bitmap} -> see PNG implementation
  if BitDepth = 2 then
    BitDepth := 4;
  if BitDepth = 16 then
    BitDepth := 8;


  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;
      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;
      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];
        end;

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

procedure LoadPNGImage8bitTransparent(PNG: TPNGImage; Bitmap: TBitmap);
var
  I, J: Integer;
  DeltaS, DeltaSA, DeltaD: Integer;
  AddrLineS, AddrLineSA, AddrLineD: NativeInt;
  AddrS, AddrSA, AddrD: NativeInt;
begin
  if Bitmap.PixelFormat <> pf32bit then
    Bitmap.PixelFormat := pf32bit;

  Bitmap.SetSize(PNG.Width, PNG.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(AddrD)^.R := PByte(AddrS)^;
      PRGB(AddrD)^.G := PByte(AddrS)^;
      PRGB(AddrD)^.B := PByte(AddrS)^;
      Inc(AddrS, 1);
      Inc(AddrD, 3);
      PByte(AddrD)^ := PByte(AddrSA)^;
      Inc(AddrD, 1);
      Inc(AddrSA, 1);
    end;
    Inc(AddrLineS, DeltaS);
    Inc(AddrLineSA, DeltaSA);
    Inc(AddrLineD, DeltaD);
  end;
end;

procedure LoadPNGImage8BitWOTransparent(PNG: TPNGImage; Bitmap: TBitmap);
var
  I, J: Integer;
  DeltaS, DeltaD: Integer;
  AddrLineS, AddrLineD: NativeInt;
  AddrS, AddrD: NativeInt;
  BitDepth, BitDepthD8, ColorMask, P, Rotater, Multilpyer: Byte;

begin
  if Bitmap.PixelFormat <> pf24bit then
    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,16 bits for each pixel is not supported by windows bitmap} -> see PNG implementation
  if BitDepth = 2 then
    BitDepth := 4;
  if BitDepth = 16 then
    BitDepth := 8;

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

  Multilpyer := 1;
  case BitDepth of
    1: Multilpyer := 255;
    2: Multilpyer := 85;
    4: Multilpyer := 17;
    8: Multilpyer := 1;
  end;

  for I := 0 to PNG.Height - 1 do
  begin
    AddrS := AddrLineS;
    AddrD := AddrLineD;
    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;

      PRGB(AddrD)^.R := P * Multilpyer;
      PRGB(AddrD)^.G := P * Multilpyer;
      PRGB(AddrD)^.B := P * Multilpyer;

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

procedure LoadPNGImageWOTransparent(PNG: TPNGImage; Bitmap: TBitmap);
var
  I, J: Integer;
  DeltaS, DeltaD: Integer;
  AddrLineS, AddrLineD: NativeInt;
  AddrS, AddrD: NativeInt;
begin
  if Bitmap.PixelFormat <> pf24bit then
    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;

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




--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Poseidon
Дата 6.1.2015, 14:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133
Цитата(Illusion Dolphin @  6.1.2015,  08:49 Найти цитируемый пост)
Вот код перевода из PNG в BMP, отсюда можно отковырять то, что надо:
Вечером поковыряю эти функции, возможно там и есть что-то интересного. Но вот что выяснилось. Если ColorType = 
COLOR_RGBALPHA, то моя функция отрабатывает нормально. Если COLOR_PALETTE, то глючит. Наткнулся тут еще на схожую тему, может еще там что интересного нарою. 


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Illusion Dolphin
Дата 6.1.2015, 14:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63
Цитата

Если COLOR_PALETTE, то глючит.

Для этого LoadPNGImagePalette функция в том же листинге

Цитата

Наткнулся тут еще на схожую тему, может еще там что интересного нарою.  

Там только часть, я сюда больше скинул листинга.


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Poseidon
Дата 6.1.2015, 15:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133
Цитата(Illusion Dolphin @  6.1.2015,  14:52 Найти цитируемый пост)
Там только часть, я сюда больше скинул листинга. 
Мне не очень нравится вариант с конвертированием в bmp.

Я взял из той темы код функции ConvertToRGBA, который выложил x128 и внедрил в свою CopyPNG. В итоге получилось вот что:
Код

function CopyPNG(const PNG: TPngImage; const R: TRect): TPngImage;
var
  i: Integer;
  PngImage: TPngImage;
begin
  PngImage := TPngImage.Create;
  try
    PngImage.Assign(PNG);

    if PngImage.Header.ColorType <> COLOR_RGBALPHA then
      ConvertToRGBA(PngImage);

    Result := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, R.Width, R.Height);
    BitBlt(Result.Canvas.Handle, 0, 0, R.Width, R.Height, PngImage.Canvas.Handle, R.Left, R.Top, SRCCOPY);

    for i := 0 to R.Height - 1 do
      begin
        if not Assigned(Result.AlphaScanline[i]) or not Assigned(PngImage.AlphaScanline[i + R.Top]) then
          Break;

        CopyMemory(Result.AlphaScanline[i], PByte(Integer(PngImage.AlphaScanline[i + R.Top]) + R.Left), R.Width);
      end;
  finally
    PngImage.Free;
  end;
end;


Пока на тех картинках, что мне попадаются, работает. Спасибо Illusion Dolphin за помощь, без твоих наводок не разобрался бы.


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Illusion Dolphin
Дата 6.1.2015, 19:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63
Цитата

Я взял из той темы код функции ConvertToRGBA

Ну ConvertToRGBA это не совсем кошерно smile Я думал, что предполагается оставить исходный формат. 

Код

        if not Assigned(Result.AlphaScanline[i]) or not Assigned(PngImage.AlphaScanline[i + R.Top]) then
          Break;

Учитывая исходники - эта проверка пшик, т.к. код вернёт непустой указатель при любом входе в вашем случае:
Код

function TPngImage.GetAlphaScanline(const LineIndex: Integer): pByteArray;
begin
  with Header do
    if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
      PByte(Result) := PByte(ImageAlpha) + (Cardinal(LineIndex) * Width)
    else Result := nil;  {In case the image does not use alpha information}
end;



--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Poseidon
Дата 6.1.2015, 22:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133
Цитата(Illusion Dolphin @  6.1.2015,  19:04 Найти цитируемый пост)
Учитывая исходники - эта проверка пшик
Ну, в таком виде как сейчас, да. Хотя до этого эта проверка избавляла от не нужного AV.

Добавлено через 1 минуту и 17 секунд
Цитата(Illusion Dolphin @  6.1.2015,  19:04 Найти цитируемый пост)
Я думал, что предполагается оставить исходный формат.
Пользователю, по сути, все равно что там COLOR_RGBALPHA или COLOR_PALETTE. Главное что бы картинка отображалась.



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0576 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.