How to create an alpha mixed icon / cursor (indirect) from a 32 bit / s TBitmap instance without using a temporary DIB section?

Question

According to the MS KB entry , there is a quirk in CreateIconIndirect that recognizes the HBITMAP created with BITMAPV5HEADER passed to CreateDIBSection (and the location of the BGRA channel).

However, TBitmap instances with (PixelFormat = pf32bit) and (AlphaFormat = afDefined) (which behave like alpha mixed for other purposes), when referenced by its Handle , are not recognized as valid alpha mixed bitmaps to create icons or cursors.

Currently I need to create a full copy of TBitmap using the described API calls ( see ) in order to make CreateIconIndirect sign of the bitmap descriptor as an alpha mixture. How can I overcome this clumsiness?

Answer 1

Here is an example:

 procedure TForm1.Button1Click(Sender: TObject); const crAlpha = TCursor(-25); var Bmp: TBitmap; Px: PRGBQuad; X, Y: Integer; BmpMask: TBitmap; II: TIconInfo; AlphaCursor: HCURSOR; begin Bmp := TBitmap.Create; Bmp.PixelFormat := pf32bit; Bmp.Canvas.Brush.Color := clWhite; Bmp.SetSize(32, 32); Bmp.Canvas.Font.Style := [fsBold]; Bmp.Canvas.Font.Color := clRed; Bmp.Canvas.TextOut(1, 10, 'alpha'); for Y := 0 to (Bmp.Height - 1) do begin Px := Bmp.ScanLine[Y]; for X := 0 to (Bmp.Width - 1) do begin if DWORD(Px^) = DWORD(clWhite) then Px.rgbReserved := $00 else Px.rgbReserved := $FF; Inc(Px); end; end; BmpMask := TBitmap.Create; BmpMask.SetSize(Bmp.Width, Bmp.Height); II.fIcon := False; II.xHotspot := 32; II.yHotspot := 32; II.hbmMask := BmpMask.Handle; II.hbmColor := Bmp.Handle; AlphaCursor := CreateIconIndirect(II); Win32Check(AlphaCursor <> 0); BmpMask.Free; Bmp.AlphaFormat := afDefined; // AlphaBlend below, premultiply channels Canvas.Draw(0, 0, Bmp); // test draw Bmp.Free; Screen.Cursors[crAlpha] := AlphaCursor; Cursor := crAlpha; end; 

(The top 'alpha' is a test draw, the other is the cursor)