次に例を示します。
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;
(上の「アルファ」はテスト描画で、もう1つはカーソルです)