Solved

TMemoryStream -> PNGImage -> TIcon convertion

Posted on 2013-01-27
22
1,227 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 26

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 26

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 26

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 26

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 26

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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 26

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 26

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 26

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 26

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 26

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 26

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
System restore point 4 91
Best Firemonkey component pack 1 87
Intraweb download file link ? 1 109
Tviruailstringtree sort multi columns on header click 1 53
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
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…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

910 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

20 Experts available now in Live!

Get 1:1 Help Now