PJHayward.net - Because it's cool (and/or useful)

32 bpp Delphi/Pascal Icon Unit
Download

It's a well known fact that Delphi's built in Icon support stinks. As in 16 color stinks. As in Windows 3.1 style icon stinks. Yeah. It's that bad.

Anyway, after some digging around, I finally decided to write up a unit for using full color icons with full transparency support. I am making it available free of charge. If you use it in your program, I would like a mention in your program credits, and if you wanted to add a link to http://pjhayward.net/, that would be great. Traffic is good.

First off, a quick example, which just loads a bitmap file and saves it as an icon.

procedure TForm1.Button1Click(Sender: TObject);
var
  colorbmp,alphabmp:tBitmap;
  row:PByteArray;
  i,j:integer;
begin
  if OpenDialog1.Execute then begin
    colorbmp:=TBitmap.Create;
    alphabmp:=TBitmap.Create;
    colorbmp.LoadFromFile(OpenDialog1.FileName);
    colorbmp.PixelFormat:=pf24bit;
    alphabmp.Width:=colorbmp.Width;
    alphabmp.Height:=colorbmp.Height;
    alphabmp.PixelFormat:=pf8bit;
    for i:=0 to alphabmp.Height-1 do begin
      row:=AlphaBmp.ScanLine[i];
      for j:=0 to alphabmp.Width-1 do
        row[j]:=128; //half transparent
    end;
    if saveBitmapsToIcon(colorbmp,alphabmp,'c:\test.ico') > 0 then
      Application.MessageBox('Oops.  It didn''t work!','Oh no!');
    colorbmp.Free;
    alphabmp.Free;
  end;
end;

The following is from the beginning of the file. I'm including it here as a basic how-to guide. As side note, it also mentions that this unit only supports 32 bit (XP style) icons (should display fine on most screens). The structures defined in the file will work for other bit depths, but I didn't want to bother with the code for the lower bit depths. Check out http://msdn2.microsoft.com/en-us/library/ms997538.aspx for the nitty-gritty details of pre-XP icons

//true color icon format unit for use on WinXP and later
// Only supports XP style 32 bit icons
// does not support PNG (Vista) icons
// written 18 Oct 2007 by Phil Hayward
// phil at pjhayward.net or http://pjhayward.net/

//How to use this unit:
//  define a color bitmap and alpha (transparency) bitmap for each icon resolution you want
//    i.e. 8x8, 16x16, 24x24, 32x32, 48x48, etc - you don't need them all, just one
//  Load in your color bitmap
//  Set the pixel format on your color bitmap to pf24bit, and
//    the pixel format on your alpha bitmap to pf8bit
//  The unit uses the color index of the alpha bitmap to determine transparency,
//    not the actual color.  color index 0 is completely transparent,
//    and color index 255 is completely opaque.  an example of how to use it:
//
// var row:PByteArray;
//    for i:=0 to alphabmp.Height-1 do begin
//      row:=AlphaBmp.ScanLine[i];
//      for j:=0 to alphabmp.Width-1 do
//        row^[j]:=128; //128 is halfway transparent
//    end;
//  Once you have your color and alpha bitmaps prepared, you have a couple options.
//  The quick and easy way is to call SaveBitmapsToIcon(ColorBmp,AlphaBmp,'filename.ico');
//    but that only gives you a single resolution icon.  To load in additional sizes:
//  Define a variable of type icon, i.e. var myicon:icon, then set it using
//    newicon.  i.e. myicon:=newIcon(ColorBmp,AlphaBmp);
//  Add any additional icon resolutions using AddBitmapsToIcon.
//    i.e. AddBitmapsToIcon(ColorBmp2,AlphaBmp2,myicon);
//  Save the icon file using SaveIcon, and check the return value for errors.
//    i.e. if SaveIcon(myicon,'your\icon\folder\and\file_name.ico') > 0 then do_something
//  Destroy the icon when you're done with it to clean up dynamically allocated memory
//    i.e. destroyIcon(myicon);

//  It's worth mentioning that destroyIcon doesn't destroy the variable itself.  After
//    a call to destroyIcon, the icon image data is gone, but you could add it back in
//    using AddBitmapsToIcon.  Saving an icon with no image data will return a result of 1

//  To check if an icon has image data, look in the icon.directory.idCount variable.
//  Naturally, that will only be valid if you only use the routines provided in this unit.

//  I only built in support for 32 bit icons, but the structures are valid for 4, 8, 16 and 24
//    bit icons as well.  instead of an 8 bit transparency channel, you will have a 1 bit
//    AND channel you'll need to create, which should be stored in the icAND property of the
//    icon image data. Maybe in a later release I'll add that functionality, but the way I see
//    it, 32 bit with full transparency control looks better.
//  If you decide to use 8bpp or less, you will need to generate a color table for that image.
//    I haven't looked up the color table format yet, but I imagine you could probably
//    pull it from your bitmap image, since the .ico format is so similar to .bmp

procedure addBitmapsToIcon(bitmapImage,grayscaleAlpha:tBitmap;var workicon:icon);
procedure destroyIcon(var icondata:icon);
function newIcon(bitmapImage,grayscaleAlpha:tBitmap):icon;
function saveIcon(icondata:icon;filename:string):integer;
//exit codes:
//  0: success
//  1: no image data in icon
//  2: exception occured while saving

//shortcut routine that uses the others.
function saveBitmapsToIcon(bitmapImage,grayscaleAlpha:tBitmap;filename:string):integer;
//same exit codes as saveIcon, except exit code 1 should never happen...

2007-2009 Phillip Hayward