Последние записи

made in programmersforum 5

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

6th
Май

png в ico с прозрачностью и разными разрешениями

Posted by obzor under Delphi

Возможно ли переконвертировать PNG в ICO? при этом оставить прозрачность и разбить на разные разрешения в один ico файл?
К примеру имеется PNG (с разрешением 128х128) и его перевести в ico в котором будут несколько разных разрешений (к примеру 128х128, 92х29 ну и т.д.)
Возможно ли такое?
Или хотя бы такое имеется несколько ico с одинаковым изображением, но в различных разрешениях, можно ли их собрать в один ico?

andrestudio

Создаёт файл ico с именем файла png в директории программы. (файл png можно просто перетащить из проводника в окно программы)
За счёт того что прорисовка осуществляется с помощью GDI+ то из картинки к примеру 32х32 получается вполне качественная 256х256 иконка

сама процедура(правда на KOL но нетрудно наверно переделать так как там больше API)

Код:

procedure SaveIcons2Stream( const Icons : array of PIcon; Strm : PStream );
var I, J, Pos : Integer;
    IH : TIconHeader;
    Colors : PList;
    ImgBmp,
    MskBmp : Kol.PBitmap;
   function WriteIcons : Boolean;
   var I, Off : Integer;
       IDI : TIconDirEntry;
       BIH : TBitmapInfoHeader;
       II : TIconInfo;
       B: TagBitmap;
      function RGBArraySize : Integer;
      begin
         Result := 0;
         if (IDI.bColorCount >= 2) or (IDI.bReserved = 1) then
            Result := (IDI.bColorCount + (IDI.bReserved shl 8)) * Sizeof( TRGBQuad );
      end;
      function ColorDataSize : Integer;
      var N: Integer;
      begin
         //Result := 0;
         if (IDI.bColorCount >= 2) or (IDI.bReserved = 1) then
           N := (ColorBits( IDI.bColorCount + (IDI.bReserved shl 8) ) )
         else
           N := IDI.wBitCount;
         Result := ((N * Icons[ I ].Size + 31) div 32) * 4
                       * Icons[ I ].Size;
      end;
      function MaskDataSize : Integer;
      begin
         Result := ((Icons[ I ].Size + 31) div 32) * 4
                   * Icons[ I ].Size;
      end;
   begin
     Result := False;
     if Strm.Write( IH, Sizeof( IH ) ) <> Sizeof( IH ) then Exit;
     Off := Sizeof( IH ) + IH.idCount * Sizeof( IDI );
     for I := Low( Icons ) to High( Icons ) do
     begin
       FillChar( IDI, Sizeof( IDI ), 0 );
       IDI.bWidth := Icons[ I ].Size;
       IDI.bHeight := Icons[ I ].Size;
       GetIconInfo( Icons[ I ].Handle, II );
       if II.hbmColor = 0 then
          IDI.bColorCount := 2
       else
       begin
         {ImgBmp.Handle := CopyImage( II.hbmColor, IMAGE_BITMAP, Icons[ I ].Size,
                          Icons[ I ].Size, LR_CREATEDIBSECTION );}
         ImgBmp.Handle := II.hbmColor;
         II.hbmColor := 0;
         FillChar( BIH, Sizeof( BIH ), 0 );
         BIH.biSize := Sizeof( BIH );
         GetObject( ImgBmp.Handle, Sizeof( B ), @B );
         //if ImgBmp.HandleType = bmDDB then
         begin
            if (B.bmPlanes = 1) and (B.bmBitsPixel >= 15) then
            begin
              //ImgBmp.PixelFormat := pf24bit;
              IDI.bColorCount := 0;
              IDI.bReserved := 0;
              IDI.wBitCount := B.bmBitsPixel;
            end
              else
            if B.bmPlanes * (1 shl B.bmBitsPixel) < 16 then
            begin
               ImgBmp.PixelFormat := pf1bit;
               IDI.bColorCount := 2;
            end
               else
            if B.bmPlanes * (1 shl B.bmBitsPixel) < 256 then
            begin
               ImgBmp.PixelFormat := pf4bit;
               IDI.bColorCount := 16;
            end
               else
            begin
               ImgBmp.PixelFormat := pf8bit;
               IDI.bColorCount := 0;
               IDI.bReserved := 1;
            end;
            //GetObject( ImgBmp.Handle, Sizeof( BIH ), @BIH );
         end;
         //IDI.bColorCount := (1 shl BIH.biBitCount) * BIH.biPlanes;
         //--//DeleteObject( II.hbmColor );
       end;
       if II.hbmMask <> 0 then
         DeleteObject( II.hbmMask );
       Colors.Add( Pointer(IDI.bColorCount + (IDI.bReserved shl 8)) );
       IDI.dwBytesInRes := Sizeof( BIH ) +  RGBArraySize +
                           ColorDataSize + MaskDataSize;
       IDI.dwImageOffset := Off;
       if Strm.Write( IDI, Sizeof( IDI ) ) <> Sizeof( IDI ) then Exit;
       Inc( Off, IDI.dwBytesInRes );
     end;
     for I := Low( Icons ) to High( Icons ) do
     begin
       FillChar( BIH, Sizeof( BIH ), 0 );
       BIH.biSize := Sizeof( BIH );
       BIH.biWidth := Icons[ I ].Size;
       BIH.biHeight := Icons[ I ].Size;
       //GetObject( Icons[ I ].Handle, Sizeof( II ), @II );
       GetIconInfo( Icons[ I ].Handle, II );
       if II.hbmColor <> 0 then
          BIH.biHeight := Icons[ I ].Size * 2;
       BIH.biPlanes := 1;
       PWord( @ IDI.bColorCount )^ := DWord( Colors.Items[ I - Low( Icons ) ] );
       if IDI.wBitCount = 0 then
         IDI.wBitCount := ColorBits( PWord( @ IDI.bColorCount )^ );
       BIH.biBitCount := IDI.wBitCount;
       BIH.biSizeImage := Sizeof( BIH ) + ColorDataSize + MaskDataSize;
       if Strm.Write( BIH, Sizeof( BIH ) ) <> Sizeof( BIH ) then Exit;
       if II.hbmColor <> 0 then
       begin

          ImgBmp.Handle := {CopyImage( II.hbmColor, IMAGE_BITMAP, Icons[ I ].Size,
                          Icons[ I ].Size, 0 );}
                          II.hbmColor;
                          II.hbmColor := 0;
          case BIH.biBitCount of
          1 : ImgBmp.PixelFormat := pf1bit;
          4 : ImgBmp.PixelFormat := pf4bit;
          8 : ImgBmp.PixelFormat := pf8bit;
          16: ImgBmp.PixelFormat := pf16bit;
          24: ImgBmp.PixelFormat := pf24bit;
          32: ImgBmp.PixelFormat := pf32bit;
          end;
       end
          else
       begin
          ImgBmp.Handle := CopyImage( II.hbmMask, IMAGE_BITMAP, Icons[ I ].Size,
                          Icons[ I ].Size, 0 );
          ImgBmp.PixelFormat := pf1bit;
       end;
       if ImgBmp.DIBBits <> nil then
       begin
          if Strm.Write( Pointer(Integer(ImgBmp.DIBHeader) + Sizeof(TBitmapInfoHeader))^,
             PWord( @ IDI.bColorCount )^ * Sizeof( TRGBQuad ) ) <>
             PWord( @ IDI.bColorCount )^ * Sizeof( TRGBQuad ) then Exit;
          if Strm.Write( ImgBmp.DIBBits^, ColorDataSize ) <>
             DWord( ColorDataSize ) then Exit;
       end;
       MskBmp.Handle := CopyImage( II.hbmMask, IMAGE_BITMAP, Icons[ I ].Size,
                          Icons[ I ].Size, 0 {LR_COPYRETURNORG} );
       //***
       if II.hbmMask <> 0 then
         DeleteObject( II.hbmMask );
       if II.hbmColor <> 0 then
         DeleteObject( II.hbmColor );
       //***

       MskBmp.PixelFormat := pf1bit;
       if Strm.Write( MskBmp.DIBBits^, MaskDataSize ) <>
          DWord( MaskDataSize ) then Exit;
     end;
     Result := True;
   end;
begin
  for I := Low( Icons ) to High( Icons ) do
  begin
     if Icons[ I ].Handle = 0 then Exit;
     for J := I + 1 to High( Icons ) do
        if Icons[ I ].Size = Icons[ J ].Size then Exit;
  end;
  
  IH.idReserved := 0;
  IH.idType := 1;
  IH.idCount := High( Icons ) - Low( Icons ) + 1;
  Pos := Strm.Position;
  Colors := NewList;
  ImgBmp := NewBitmap( 0, 0 );
  MskBmp := NewBitmap( 0, 0 );

  if not WriteIcons then
     Strm.Seek( Pos, spBegin );

  ImgBmp.Free;
  MskBmp.Free;
  Colors.Free;
end;