Solved

TMemoryStream -> PNGImage -> TIcon convertion

Posted on 2013-01-27
22
1,307 Views
Last Modified: 2013-02-11
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).
0
Comment
Question by:Casady
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 11
  • 10
22 Comments
 
LVL 1

Expert Comment

by:gxs
ID: 38825591
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
 
LVL 27

Expert Comment

by:Sinisa Vuk
ID: 38825771
Follow this link to convert-png-jpg-gif-to-ico
0
 

Author Comment

by:Casady
ID: 38825794
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 27

Expert Comment

by:Sinisa Vuk
ID: 38825815
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
 

Author Comment

by:Casady
ID: 38825921
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
 
LVL 27

Expert Comment

by:Sinisa Vuk
ID: 38826364
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
 

Author Comment

by:Casady
ID: 38827099
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
 
LVL 27

Expert Comment

by:Sinisa Vuk
ID: 38827726
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
 

Author Comment

by:Casady
ID: 38827795
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
 
LVL 27

Expert Comment

by:Sinisa Vuk
ID: 38833477
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
 

Author Comment

by:Casady
ID: 38833649
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
 
LVL 27

Expert Comment

by:Sinisa Vuk
ID: 38834157
You can get it in this package: PngComponents
0
 

Author Comment

by:Casady
ID: 38834167
The link you've posted is for members only.
0
 
LVL 27

Expert Comment

by:Sinisa Vuk
ID: 38834191
0
 

Author Comment

by:Casady
ID: 38839050
With the latest components, the image is loaded, but appears as a grey square.

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

Expert Comment

by:Sinisa Vuk
ID: 38857086
... 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
 

Author Comment

by:Casady
ID: 38857111
Sinisav,

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

Expert Comment

by:Sinisa Vuk
ID: 38863381
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
 

Author Comment

by:Casady
ID: 38874981
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
 
LVL 27

Expert Comment

by:Sinisa Vuk
ID: 38875731
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
 

Author Comment

by:Casady
ID: 38875756
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
 
LVL 27

Accepted Solution

by:
Sinisa Vuk earned 500 total points
ID: 38875782
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

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question