Delphi/C++Builder - Bitmapから透過Iconを生成

Bitmap から透過する色を指定して、Iconを作成

同じサイズのマスク用Bitmap(下ではMaskBmp)を作成して、透過する場所は白、元のBitmapを表示する場所は黒で塗りつぶしておく
IconInfo を通じて、CreateIconIndirect へ元のBitmapとマスク用Bitmapを渡し、Iconへコピーさせる
※元Bitmapの TransparentColorプロパティを利用しようとしたが、設定した値が得られなかったので別引数とした

view plainprint?

1. procedure CopyIconFromTransBitmap(ABitmap: TBitmap; ATransparentColor: TColor; ADstIcon: TIcon);  
2. var  
3.     MaskBmp: TBitmap;  
4.     IconInfo: TICONINFO;  
5.     X, Y: Integer;  
6. begin  
7.     MaskBmp := TBitmap.Create;  
8.     try  
9.         MaskBmp.Assign(ABitmap);  
10.         for X := MaskBmp.Width -1 downto 0 do begin  
11.             for Y := MaskBmp.Height -1 downto 0 do begin  
12.                 if (MaskBmp.Canvas.Pixels[X, Y] = ATransparentColor) then begin  
13.                     MaskBmp.Canvas.Pixels[X, Y] := clWhite;  
14.                 end else begin  
15.                     MaskBmp.Canvas.Pixels[X, Y] := clBlack;  
16.                 end;  
17.             end;  
18.         end;  
19.   
20.         with IconInfo do begin  
21.             fIcon := True;  
22.             xHotspot := 0;  
23.             yHotspot := 0;  
24.             hbmMask := MaskBmp.Handle;  
25.             hbmColor := ABitmap.Handle;  
26.         end;  
27.   
28.         ADstIcon.Handle := CreateIconIndirect(IconINFO);  
29.     finally  
30.         MaskBmp.Free;  
31.     end;  
32. end;  

procedure CopyIconFromTransBitmap(ABitmap: TBitmap; ATransparentColor: TColor; ADstIcon: TIcon);
var
    MaskBmp: TBitmap;
    IconInfo: TICONINFO;
    X, Y: Integer;
begin
    MaskBmp := TBitmap.Create;
    try
        MaskBmp.Assign(ABitmap);
        for X := MaskBmp.Width -1 downto 0 do begin
            for Y := MaskBmp.Height -1 downto 0 do begin
                if (MaskBmp.Canvas.Pixels[X, Y] = ATransparentColor) then begin
                    MaskBmp.Canvas.Pixels[X, Y] := clWhite;
                end else begin
                    MaskBmp.Canvas.Pixels[X, Y] := clBlack;
                end;
            end;
        end;

        with IconInfo do begin
            fIcon := True;
            xHotspot := 0;
            yHotspot := 0;
            hbmMask := MaskBmp.Handle;
            hbmColor := ABitmap.Handle;
        end;

        ADstIcon.Handle := CreateIconIndirect(IconINFO);
    finally
        MaskBmp.Free;
    end;
end;