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).
CasadyAsked:
Who is Participating?
 
Sinisa VukConnect With a Mentor Commented:
Sorry, I forgot to put declarations here at first and you grab wrong one from net. This is how should be:

const
  rc3_StockIcon = 0;
  rc3_Icon = 1;
  rc3_Cursor = 2;

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

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

Open in new window

0
 
gxsCommented:
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

0
 
Sinisa VukCommented:
Follow this link to convert-png-jpg-gif-to-ico
0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
CasadyAuthor Commented:
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).
0
 
Sinisa VukCommented:
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

0
 
CasadyAuthor Commented:
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.
0
 
Sinisa VukCommented:
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
0
 
CasadyAuthor Commented:
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.
0
 
Sinisa VukCommented:
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).
0
 
CasadyAuthor Commented:
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
0
 
Sinisa VukCommented:
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.
0
 
CasadyAuthor Commented:
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'
0
 
Sinisa VukCommented:
You can get it in this package: PngComponents
0
 
CasadyAuthor Commented:
The link you've posted is for members only.
0
 
Sinisa VukCommented:
0
 
CasadyAuthor Commented:
With the latest components, the image is loaded, but appears as a grey square.

https://www.dropbox.com/s/9zw5lpijgp4hcvi/PngToIco.zip
0
 
Sinisa VukCommented:
... 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.
0
 
CasadyAuthor Commented:
Sinisav,

A solution for 16x16 and 32x32 would be enough.
0
 
Sinisa VukCommented:
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.
0
 
CasadyAuthor Commented:
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
0
 
Sinisa VukCommented:
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
0
 
CasadyAuthor Commented:
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
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.