Solved

TMemoryStream -> PNGImage -> TIcon convertion

Posted on 2013-01-27
22
1,209 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
  • 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 25

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
 
LVL 25

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 25

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 25

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 25

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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 25

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 25

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 25

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 25

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 25

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 25

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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

707 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now