*****************************************************************
* Neveprise Inc. Delphi FAQ					*
*****************************************************************
* Section: Graphics		Topic:   Creating icons		*
* Created: July 26th, 1999	Revised: July 27th, 1999 	*
* Updates: www.neveprise.de	Info:	 support@neveprise.de	*
*****************************************************************

Q: How can I create icons within my Delphi app (from a bitmap)?

A: The WinAPI offers a function called CreateIconIndirect. It ex-
	pects two bitmaps to create an icon from. The first icon
	will be unchanged, a second one is the same but has to be
	modified to work as a mask. So, if having a non-rectangular
	image, all non-transparent areas must be shifted to one colour,
	so we have a shape from the "object". Using a blitter with OR,
	the still coloured image is drawn on the shape. In our function,
	we only have to provide one bitmap, specifying a transparent
	colour, like in TBitmap since Delphi 3.
	Additionally, we need three helper functions that change some
	colours, to create the mask etc.

TIconSize = (ico16, ico24, ico32, ico48, ico64);

procedure Bitmap2IconH(Source: TBitmap; TransparentColor: TColor; IconSize: TIconSize; ResultIcon: TIcon);
//helper functions (3)
	procedure ChangeColorH(Source: TBitmap; FromColor, ToColor: TColor; ResultBitmap: TBitmap);
	var x, y: cardinal;
	begin
	 ResultBitmap.Width:=Source.Width;
	 ResultBitmap.Height:=Source.Height;
	 ResultBitmap.Canvas.Draw(0,0,Source);
	 for x:=0 to ResultBitmap.Width do
	 begin
    		for y:=0 to ResultBitmap.Height do
		begin
        	  if ResultBitmap.Canvas.Pixels[x,y]=FromColor then ResultBitmap.Canvas.Pixels[x,y]:=ToColor;
    		end;
	 end;
	end;

	procedure ChangeColorsH(Source: TBitmap; StayColor, ToColor: TColor; ResultBitmap: TBitmap);
	var x,y: cardinal;
	begin
	 ResultBitmap.Width:=Source.Width;
	 ResultBitmap.Height:=Source.Height;
	 ResultBitmap.Canvas.Draw(0,0,Source);
	 for x:=0 to ResultBitmap.Width do
	 begin
	    	for y:=0 to ResultBitmap.Height do
		begin
	          if ResultBitmap.Canvas.Pixels[x,y]<>StayColor then ResultBitmap.Canvas.Pixels[x,y]:=ToColor;
	    	end;
	 end;
	end;

	procedure InverseBWH(Source, ResultBitmap: TBitmap);
	var x, y: cardinal;
	begin
	 ResultBitmap.Width:=Source.Width;
	 ResultBitmap.Height:=Source.Height;
	 ResultBitmap.Canvas.Draw(0,0,Source);
	 for x:=0 to ResultBitmap.Width do
	 begin
    		for y:=0 to ResultBitmap.Height do
		begin
        	   if ResultBitmap.Canvas.Pixels[x,y]=clWhite then ResultBitmap.Canvas.Pixels[x,y]:=clBlack else ResultBitmap.Canvas.Pixels[x,y]:=clWhite;
    		end;
	 end;
	end;

var AndBmp, XorBmp: TBitmap;
    IconInfo: TIconInfo;
    x: byte;
begin
//now the function itself
case IconSize of //set icon's size
     ico16: x:=16;
     ico24: x:=24;
     ico32: x:=32;
     ico48: x:=48;
     ico64: x:=64;
end;
XOrBmp:=TBitmap.Create; //create icon image
XOrBmp.Width:=x; //and set dimensions
XOrBmp.Height:=x;
//assign source bitmap (stretch if nessessary)
XOrBmp.Canvas.StretchDraw(Rect(0,0,x,x),Source);
//change transparent color to black
ChangeColorH(XOrBmp,TransparentColor,clBlack, XOrBmp);
AndBmp:=TBitmap.Create;
AndBmp.Width:=x;
AndBmp.Height:=x;
//assign source bitmap (stretch if nessessary)
AndBmp.Canvas.StretchDraw(Rect(0,0,x,x),Source);
//change all color except tramsparent key to white,
//this creates a mask, a white shape from the icon
//on that the colored will be drawn
ChangeColorsH(AndBmp,TransparentColor,clWhite, AndBmp);
//okay, in fact is drawn on black: inverse black to white and vive versa
InverseBWH(AndBmp, AndBmp);
//go shure the bitmap is really b/w
AndBmp.MonoChrome:=true; 
with IconInfo do begin
     IconInfo.fIcon:=true;
     IconInfo.xHotSpot:=0; //...is no cursor :-)
     IconInfo.yHotSpot:=0;
     IconInfo.hbmMask:=AndBmp.Handle; //add transparency images
     IconInfo.hbmColor:=XOrBmp.Handle; //add primary image
end;
//create it and retrieve the handle
ResultIcon.Handle:=CreateIconIndirect(IconInfo);
end;




	Blazko