VPF::Не-32bpp bitmap конвертируется в PNG как пустая

Alexeyt

Дата 8.9.2012, 19:34 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 332
Регистрация: 15.9.2006
Где: около Москвы

Репутация: 1
Всего: 2

D7. Проблема с сохранением иконки приложения (например это иконка проекта Project1.exe) в PNG. Если иконка откуда-то 32bpp (например рипнутая из shell32.dll), то конвертится ОК. Но если малоцветная, конвертится в пустую картинку. Отличие малоцветной - PixelFormat<>pf32bit.
вот что я использую

Код


procedure TForm1.Button3Click(Sender: TObject);
var
  b: TBitmap;
  png: TPngObject;
const
  fn='d:\image.png';
begin
  b:= TBitmap.Create;
  b.PixelFormat:= pf32bit;
  LoadIconFromDllToBmp('shell32.dll', 0{IconIndex}, false{SmallIcons}, b);   //получили здесь иконку b

  png:=Bmp32ToPng(b); //здесь конвертим
  if png=nil then begin Showmessage('Failed Bmp32topng'); Exit end;
  png.SaveToFile(fn); //здесь пишется пустая png 32x32
  //FOpenURL(fn, Handle);
  png.free;
  b.free;
end;

/////////////////////
procedure LoadIconFromDllToBmp(const FN: Widestring;
  AIndex: integer; ASmallIcon: boolean; Bmp: TBitmap);
var
  hIco1, hIco2: hIcon;
  piconinfo: TIconInfo;
begin
  ExtractIconExW(PWChar(FN), AIndex, hIco2, hIco1, 1);

  if ASmallIcon then
    GetIconInfo(hIco1, piconinfo)
  else
    GetIconInfo(hIco2, piconinfo);
  try
    Bmp.Handle:= piconinfo.hbmColor;
    Bmp.PixelFormat:= pf32bit; //чтобы получить малоцветную, убрать эту строку
  finally
    DeleteObject(piconinfo.hbmMask);
    DeleteObject(piconinfo.hbmColor);
  end;

  DestroyIcon(hIco1);
  DestroyIcon(hIco2);
end;

//////////////////////////
function Bmp32ToPng(bmp: TBitmap): TPngObject;
var
  x, y: integer;
  src, dst: PngImage.pByteArray;
begin
  Result:= nil;
  if bmp.PixelFormat<>pf32bit then
    Exit;
    {
    это если раскомментить (вместо Exit)- не работает, дает прозрачную пустую png
  if bmp.PixelFormat<>pf32bit then
  begin
    Result:= TPngObject.CreateBlank(COLOR_RGB, 8, bmp.Width, bmp.Height);
    Result.Canvas.Draw(0, 0, bmp);
    Exit;
  end;
  }

  Result:= TPngObject.CreateBlank(COLOR_RGBALPHA, 8, bmp.Width, bmp.Height);
  Result.Canvas.Draw(0, 0, bmp);
  for y:= 0 to bmp.Height-1 do begin
    src:= bmp.ScanLine[y];
    dst:= Result.AlphaScanLine[y];
    for x:= 0 to bmp.Width-1 do
      dst[x]:= src[x*4+3];
  end;
end;

//----------------

проблема в Bmp32ToPng, но как ее поправить для PixelFormat<>pf32bit.

Это сообщение отредактировал(а) Alexeyt - 8.9.2012, 20:44

Illusion Dolphin

Дата 8.9.2012, 20:51 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

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

Цитата

но как ее поправить для PixelFormat<>pf32bit.

Так пробовали?

Код


if bmp.PixelFormat<>pf32bit then
  bmp.PixelFormat := pf32bit;

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

Alexeyt

Дата 8.9.2012, 20:59 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 332
Регистрация: 15.9.2006
Где: около Москвы

Репутация: 1
Всего: 2

Illusion Dolphin,
да, пробовал. Смена формата помогает с полноцветными иконками (например иконки папок в shell32.dll),
но дает ПУСТУЮ битмепу для малоцветных (например иконка 0 в shell32.dll, XP - или иконка Д7)

Alexeyt

Дата 9.9.2012, 21:41 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 332
Регистрация: 15.9.2006
Где: около Москвы

Репутация: 1
Всего: 2

Похоже баг PngImage D7. он создает невалидный (пустой визуально) файл.
хотя Паинт показывает его

Illusion Dolphin

Дата 9.9.2012, 23:27 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

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

Цитата

он создает невалидный (пустой визуально) файл.
хотя Паинт показывает его

Ну тогда всё понятно - просто по умолчанию установлена полная прозрачность, а пэинт игнорирует альфа канал. Надо сделать как-то так:

Код


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;

Код


procedure FixTransparentChannel(Bitmap: TBitmap; TransparentValue: Byte = 0);
var
  I, J: Integer;
  p: PARGB32;
begin
  Bitmap.PixelFormat := pf32Bit;
  for I := 0 to Bitmap.Height - 1 do
  begin
    p := Bitmap.ScanLine[I];
    for J := 0 to Bitmap.Width - 1 do
      p[J].L := TransparentValue;
  end;
end;

И вызвать FixTransparentChannel в случае если изначально bmp <> pf32bit с параметром или 0 или 255.

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »