[SCrat.ORS]

Часть 1 - тут.

Нашёл вариант как реализовать, методом преобразования иконки в 32-х битмап с альфаканалом:

Код:

function Create32BitBitmap(aSize: cardinal): HBITMAP;
var
  BMI: BITMAPINFO;
  DC:  HDC;
begin
  Result := 0;
  DC := GetDC(0);
  if (DC <> 0) then
    try
      ZeroMemory(@BMI, SizeOf(BITMAPINFO));
      BMI.bmiHeader.biSize        := SizeOf(BITMAPINFO);
      BMI.bmiHeader.biPlanes      := 1;
      BMI.bmiHeader.biCompression := BI_RGB;
      BMI.bmiHeader.biWidth       := aSize;
      BMI.bmiHeader.biHeight      := aSize;
      BMI.bmiHeader.biBitCount    := 32;
      Result := CreateDIBSection(DC, BMI, DIB_RGB_COLORS, pointer(nil^), 0, 0);
    finally
      ReleaseDC(0, DC);
    end;
end;

function PARGB32FromIcon(aIconHandle: HICON; aSize: cardinal): HBITMAP;
var
  Bitmap: TBitmap;
  X, Y: Integer;
  Pixel: PRGBQuad;
begin
  Result := 0;
  Bitmap := TBitmap.Create;
  try
    Bitmap.Handle := Create32BitBitmap(aSize);
    if (Bitmap.Handle <> 0) then
    begin
      if (DrawIconEx(Bitmap.Canvas.Handle, 0, 0, aIconHandle, aSize, aSize, 0, 0, DI_NORMAL)) then
      begin
        Assert(Bitmap.PixelFormat = pf32Bit);
        with Bitmap do
          for Y := Height - 1 downto 0 do
            begin
            Pixel := ScanLine[Y];
              for X := Width - 1 downto 0 do
                begin
                  Pixel.rgbBlue := MulDiv(Pixel.rgbBlue, Pixel.rgbReserved, 255);
                  Pixel.rgbGreen := MulDiv(Pixel.rgbGreen, Pixel.rgbReserved, 255);
                  Pixel.rgbRed := MulDiv(Pixel.rgbRed, Pixel.rgbReserved, 255);
                  Inc(Pixel);
                end;
            end;
        Result := Bitmap.Handle;
        Bitmap.ReleaseHandle;
      end;
    end;
  finally
    Bitmap.Free;
  end;
end;

Код:

...
procedure TForm1.FormCreate(Sender: TObject);
Var
Ic:TIcon;
begin
 Ic:=TIcon.Create;
 Ic.LoadFromResourceName(hInstance,'SOMEICON'); //Загрузка иконки 16*16 из ресурсов
 hPopupMenu:=CreatePopupMenu;
 AppendMenu(hPopupMenu,MF_popup,0,'SomeText');
 SetMenuItemBitmaps(hPopupMenu,0,MF_BYPOSITION,PARGB32FromIcon(Ic.Handle,Ic.Height div 2),0);
 Ic.Free;
end;
...

Один вопрос. Вся эта конструкция работает только если меню создается по средствам WinApi.
Если вызывать SetMenuItemBitmaps на Хендл TPopupmenu, или TMenuItem, то результат нулевой.

Возможно ли применить SetMenuItemBitmaps на Хендл TPopupmenu, или TMenuItem? Если ДА, то каким образом?