asked on

TMemoryStream -> PNGImage -> TIcon convertion

This is rather complicated, but a solution that uses components that I don't have currently installed would be fine, as long as they work with Delphi 5 (cannot currently upgrade this old project to a new Delphi version).

I've a TMemoryStream. The content of the stream is a png image.

I need this data converted to a bitmap that is stored in a TIcon object.

So the chain should be:

MemoryStream -> a png class that loads the image from the stream -> convertion to a TIcon (not HICON).

gxs

Well, the problem needs a little bit of time to solve.

For the time being, I have the following (convert hIcon to TIcon) :

procedure whatever;
var
  MyIcon:TIcon;
  icoHandle: HIcon;
begin
  MyIcon:=TIcon.Create;
  try
   icoHandle := ExtractIcon(application.handle,'c:\windows\explorer.exe', 0) ;
   MyIcon.Handle:=icoHandle;
   Image1.Picture.Icon:=MyIcon;
  finally
   MyIcon.free;
  end;
end;

Open in new window

Sinisa Vuk

Follow this link to convert-png-jpg-gif-to-ico

Casady

ASKER

I cannot use Img.Picture.LoadFromFile, as I have a TMemoryStream where the PNG Image is located. I cannot save the stream to a file and then use LoadFromFile, as it would be extremely slow (I'm processing hundreds of streams).

Sinisa Vuk

This code needs little correction for your needs....You could do by yourself... but here it is...

procedure ConvPng2Ico(ms: TMemoryStreaml; Ico: TIcon; IcoW, IcoH: Integer)
var
  Img: TImage;
  BmImg: TBitmap;
  Bmp: TBitmap;
  BmpMask: TBitmap;
  IconInfo: TIconInfo;
begin
  Img := TImage.Create(nil);
  Img.Picture.LoadFromStream(ms);

  BmImg := TBitmap.Create;
  BmImg.Assign(Img.Picture.Graphic);
  Img.Free;

  Bmp := TBitmap.Create;
  Bmp.SetSize(IcoW, IcoH);
  SetStretchBltMode(Bmp.Canvas.Handle, HALFTONE);
  StretchBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height,
              BmImg.Canvas.Handle, 0, 0, BmImg.Width, BmImg.Height, SRCCOPY);
  BmImg.Free;

  BmpMask := TBitmap.Create;
  BmpMask.Canvas.Brush.Color := clBlack;
  BmpMask.SetSize(Bmp.Width, Bmp.Height);

  FillChar(IconInfo, SizeOf(IconInfo), 0);
  IconInfo.fIcon := True;
  IconInfo.hbmMask := BmpMask.Handle;
  IconInfo.hbmColor := Bmp.Handle;

  //Ico := TIcon.Create; // create ticon outside of procedure
  Ico.Handle := CreateIconIndirect(IconInfo);

  Bmp.Free;
  BmpMask.Free;
end;

Open in new window

Casady

ASKER

I'm on Delphi 7 (cannot upgrade this project currently do Delphi XE, as many components would have to be rewritten).

Img.Picture.LoadFromStream() is not available with Delphi 7.

Sinisa Vuk

Sorry, I didn't try this, just modified a little. I rewrote it again:

procedure TForm1.ConvGraphic2Ico(ms: TMemoryStream; IcoW, IcoH: Integer);
var
  Img: TPngObject;
  BmImg: TBitmap;
  Bmp: TBitmap;
  IconInfo: TIconInfo;
  Ico: TIcon;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.PixelFormat := pf24bit;
    Bmp.Width := IcoW;
    Bmp.Height := IcoH;

    BmImg := TBitmap.Create;
    try
      BmImg.PixelFormat := pf32bit;

      Img := TPngObject.Create;
      try
        ms.Seek(0, 0);
        Img.Transparent := True;
        Img.LoadFromStream(ms);
        BmImg.Assign(Img);
      finally
        Img.Free;
      end;

      SetStretchBltMode(Bmp.Canvas.Handle, COLORONCOLOR); //STRETCH_DELETESCANS
      StretchBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height,
        BmImg.Canvas.Handle, 0, 0, BmImg.Width, BmImg.Height, SRCCOPY);
    finally
      BmImg.Free;
    end;

    Bmp.Transparent := True;

    FillChar(IconInfo, SizeOf(IconInfo), 0);
    IconInfo.fIcon := True;
    IconInfo.hbmMask := Bmp.MaskHandle;
    IconInfo.hbmColor := Bmp.Handle;

    Ico := TIcon.Create;
    try
      Ico.Handle := CreateIconIndirect(IconInfo);
      Ico.SaveToFile(...);
      Image1.Picture.Assign(Ico);
    finally
      Ico.Free;
    end;
  finally
    Bmp.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  ms : TMemoryStream;
begin
  ms := TMemoryStream.Create;
  ms.LoadFromFile(...); //load png 
  ConvGraphic2Ico(ms, 32, 32);
  ms.Free;
end;

Open in new window

Note: I use this Png library: http://sourceforge.net/projects/pngdelphi2/?source=directory

Here is another sources:
http://www.swissdelphicenter.ch/en/showcode.php?id=913
http://www.swissdelphicenter.ch/en/showcode.php?id=426

Casady

ASKER

Well, it doesn't give any exceptions, but the final Ico file (or the bitmap of it) is empty (not nil, only without content). I've created an example (with precompiled exe).

https://www.dropbox.com/s/9zw5lpijgp4hcvi/PngToIco.zip

p.s.

I think the problem is related to this:

If I load the example png file to TImage, and then reference (even read only) TImage.Picture.Bitmap or TImage.Picture.Icon the image becomes immediately empty.

Sinisa Vuk

This is because TIcon is a link to storage in TBitmap, not a container like TBitmap.

IconInfo.hbmMask := Bmp.MaskHandle;
IconInfo.hbmColor := Bmp.Handle;

Open in new window

You should pass TImage in function and assign TIcon to TImage in function as I do.
After Bmp.Free TIcon is unassigned (handle is destroyed).

Casady

ASKER

I did as you've suggested, and this does not solve the problem. Still empty picture.

I've uploaded the new version (same URL):

https://www.dropbox.com/s/9zw5lpijgp4hcvi/PngToIco.zip

Sinisa Vuk

Hold on. I find out than you use older pngimage.pas. Get newer version from link I gave you.
Second, I see issue with transparency. I need more time to solve this, so please wait a little more.

Casady

ASKER

I've downloaded pngimage_2.0.zip from your link, replaced the older version,
but the project will not compile with Delphi 7:

zlibpas.pas(106): File not found: 'obj\crc32.obj'

Sinisa Vuk

You can get it in this package: PngComponents

Casady

ASKER

The link you've posted is for members only.

Sinisa Vuk

PngComponents

Casady

ASKER

With the latest components, the image is loaded, but appears as a grey square.

https://www.dropbox.com/s/9zw5lpijgp4hcvi/PngToIco.zip

Sinisa Vuk

... finally... after reading a lot ... converting png to icon with transparency is not trivial task.
There is some limitation in delphi too. Look this:

http://en.wikipedia.org/wiki/ICO_%28file_format%29
http://blogs.msdn.com/b/oldnewthing/archive/2010/10/18/10077133.aspx
http://blogs.msdn.com/b/oldnewthing/archive/2010/10/19/10077610.aspx
http://blogs.msdn.com/b/oldnewthing/archive/2010/10/21/10078690.aspx
http://blogs.msdn.com/b/oldnewthing/archive/2010/10/22/10079192.aspx
http://stackoverflow.com/questions/9805587/load-multiframe-icons

..this is my example:

function Png2Ico(ms: TMemoryStream; IcoW, IcoH: Integer): Boolean;
type
  TRGBTripleArray = array[word] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBQuadArray = array[word] of TRGBQuad;
  PRGBQuadArray = ^TRGBQuadArray;
var
  Img: TPngObject;
  BmImg, BmMaskImg: Graphics.TBitmap;
  rgbL : PRGBTripleArray;
  alphaL: PByteArray;
  destBmL: PRGBQuadArray;
  x, y: Integer;
  IconDir: TIconDir;
  IconDirectoryEntry: TIconDirectoryEntry;
  ColorInfoHeaderSize, ColorImageSize, MaskInfoHeaderSize, MaskImageSize: DWORD;
  ColorInfoHeader, ColorImage, MaskInfoHeader, MaskImage: Pointer;
begin
  Result := False;
  try
    BmImg := Graphics.TBitmap.Create;
    BmMaskImg := Graphics.TBitmap.Create;
    try
      BmImg.PixelFormat := pf32bit;
      BmMaskImg.PixelFormat := pf1bit;
      BmMaskImg.Monochrome := True;
      BmImg.Width := IcoW;
      BmImg.Height := IcoH;
      BmMaskImg.Width := IcoW;
      BmMaskImg.Height := IcoH;

      Img := TPngObject.Create;
      try
        ms.Seek(0, 0);
        Img.LoadFromStream(ms);

        if (IcoW<>Img.Width) or (IcoH<>Img.Height) then  //do resize
        begin
          //xor mask
          BmImg.Canvas.Brush.Color := clBlack;
          BmImg.Canvas.FillRect(BmImg.Canvas.ClipRect);
          BmImg.Canvas.StretchDraw(BmImg.Canvas.ClipRect, Img);
          //and mask
          BmMaskImg.Canvas.Brush.Color := clWhite;
          BmMaskImg.Canvas.FillRect(BmMaskImg.Canvas.ClipRect);
          BmMaskImg.Canvas.StretchDraw(BmMaskImg.Canvas.ClipRect, Img);
        end
        else //no need to resize
        begin
          for y := 0 to IcoH-1 do
          begin
            rgbL := Img.Scanline[y];
            alphaL := Img.AlphaScanline[y];
            destBmL := BmImg.Scanline[y];
            for x := 0 to IcoW-1 do
            begin
              //AND Mask
              if alphaL[x]>0 then
                BmMaskImg.Canvas.Pixels[x, y] := clBlack
              else
                BmMaskImg.Canvas.Pixels[x, y] := clWhite;

              //XOR Mask
              destBmL[x].rgbBlue := rgbL[x].rgbtBlue;
              destBmL[x].rgbGreen := rgbL[x].rgbtGreen;
              destBmL[x].rgbRed := rgbL[x].rgbtRed;
              destBmL[x].rgbReserved := alphaL[x];
            end;
          end;
        end;

        //get sizes
        GetDIBSizes(BmImg.Handle, ColorInfoHeaderSize, ColorImageSize);
        GetDIBSizes(BmMaskImg.Handle, MaskInfoHeaderSize, MaskImageSize);

        //allocate memory
        GetMem(ColorInfoHeader, ColorInfoHeaderSize);
        GetMem(MaskInfoHeader,  MaskInfoHeaderSize);
        GetMem(ColorImage,  ColorImageSize);
        GetMem(MaskImage,  MaskImageSize);
        try
          //get colored and masked bitmap header and image bytes
          GetDIB(BmImg.Handle, 0, ColorInfoHeader^, ColorImage^);
          GetDIB(BmMaskImg.Handle, 0, MaskInfoHeader^, MaskImage^);

          ZeroMemory(@IconDir, Sizeof(IconDir));
          ZeroMemory(@IconDirectoryEntry, Sizeof(TIconDirectoryEntry));

          //icon dir
          with IconDir do
          begin
            Reserved := 0;
            wType := rc3_Icon;
            Count := 1;  //1 icon
          end;

          //dir entries - 1 icon for now
          with IconDirectoryEntry do
          begin
            bWidth := PBitmapInfoHeader(ColorInfoHeader)^.biWidth and $FF;
            bHeight := PBitmapInfoHeader(ColorInfoHeader)^.biHeight and $FF;
            bColorCount := 0; //set max colors 
            wPlanes := PBitmapInfoHeader(ColorInfoHeader)^.biPlanes;
            wBitCount := PBitmapInfoHeader(ColorInfoHeader)^.biBitCount;
            dwBytesInRes := ColorInfoHeaderSize + ColorImageSize + MaskImageSize;
            dwImageOffset := SizeOf(TIconDir) + SizeOf(TIconDirectoryEntry);
          end;

          // color height includes mask bits - so double it
          PBitmapInfoHeader(ColorInfoHeader)^.biHeight :=
            PBitmapInfoHeader(ColorInfoHeader)^.biHeight * 2;

          //celar stream where will be new icon
          ms.Clear;
          //write headers to stream
          ms.Write(IconDir, SizeOf(TIconDir));
          ms.Write(IconDirectoryEntry, SizeOf(TIconDirectoryEntry));
          //write data to stream
          ms.Write(ColorInfoHeader^, ColorInfoHeaderSize);
          ms.Write(ColorImage^, ColorImageSize);
          ms.Write(MaskImage^, MaskImageSize);
        finally
          FreeMem(ColorInfoHeader);
          FreeMem(MaskInfoHeader);
          FreeMem(ColorImage);
          FreeMem(MaskImage);
        end;
      finally
        Img.Free;
      end;
    finally
      BmMaskImg.Free;
      BmImg.Free;
    end;
  except
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MStream: TMemoryStream;
  Png: TPNGObject;
  icn: TIcon;
begin
  Png := TPNGObject.Create;
  MStream := TMemoryStream.Create;
  icn := TIcon.Create;
  try
    Png.LoadFromFile(ExtractFilePath(ParamStr(1))+'testimage.png'); //just for get size
    Png.SaveToStream(MStream);
    MStream.Seek(0,0);
    Caption := IntToStr(MStream.Size);
    Png2Ico(MStream, Png.Width, Png.Height);
    MStream.Seek(0,0);
    icn.LoadFromStream(MStream);
    Image1.Picture.Assign(icn);
  finally
    icn.Free;
    MStream.Free;
    Png.Free;
  end;
end;

Open in new window

As I can see, delphi doesn't support icon size of 256x256.

Casady

ASKER

Sinisav,

A solution for 16x16 and 32x32 would be enough.

Sinisa Vuk

Have you try my example? Png2Ico will process memorystream (with png in it), downsize
if needed (16x16 or32x32 if you set) and store icon file (not TIcon itself) to that stream as result and you can store stream data to disk as .ico or load to TIcon and use it somewhere in application.

Casady

ASKER

Some type information was missing (Delphi 7), but I have found it with Google.

PIconDirectoryEntry = ^TIconDirectoryEntry;
TIconDirectoryEntry = packed record
bWidth: Byte;
bHeight: Byte;
bColorCount: Byte;
bReserved: Byte;
wPlanes: Word;
wBitCount: Word;
dwBytesInRes: DWORD;
dwImageOffset: DWORD;
end;

PIconDir = ^TIconDir;
TIconDir = packed record
Reserved: Word;
wType: Word;
Count: Word;
idEntries: TIconDirectoryEntry;
end;

The project compiles fine, but gives access violation on Image1.Picture.Assign(icn);

https://www.dropbox.com/s/9zw5lpijgp4hcvi/PngToIco.zip

Sinisa Vuk

As I can see, you have old png component. Please get newer (fixed one) from:
http://proger.i-forge.net/Useful_Delphi_packages/71R
PNGImage-156.zip

Casady

ASKER

The PNG Components were from the link you've given me before.

I've updated them to PNGImage-156.zip, but the access violation remains the same.

Updated the project:

https://www.dropbox.com/s/9zw5lpijgp4hcvi/PngToIco.zip

ASKER CERTIFIED SOLUTION

Sinisa Vuk

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

TMemoryStream -&gt; PNGImage -&gt; TIcon convertion

TMemoryStream -> PNGImage -> TIcon convertion