Я хочу написать небольшую утилиту, которая поможет мне загрузить одно 32-битное растровое изображение (с альфа-версией) из ресурса EXE:

ImageList1.DrawingStyle := dsTransparent;
ImageList1.Handle := ImageList_LoadImage(MainInstance, 'MyBitmap32', 16, ImageList1.AllocBy,
    CLR_NONE, IMAGE_BITMAP, LR_CREATEDIBSECTION or LR_LOADTRANSPARENT);

Выше работает хорошо.

Поэтому для создания этого растрового изображения я загружаю 32-битные прозрачные значки со своего диска (с альфа-версией) в ImageList

for i := 1 to 10 do ... ImageList2.AddIcon(AIcon)

Теперь, как мне экспортировать 32-битное изображение (которое будет прозрачным и иметь альфа-канал) из этого списка изображений и сохранить его как файл, который должен выглядеть следующим образом:

Вот моя попытка. Но выходной битовый массив НЕ выглядит прозрачным и не поддерживает альфа-канал:

procedure PrepareBitmap(bmp: TBitmap);
var
  pscanLine32: pRGBQuadArray;
  i, j: Integer;
begin
  for i := 0 to bmp.Height - 1 do
  begin
    pscanLine32 := bmp.Scanline[i];
    for j := 0 to bmp.Width - 1 do
    begin
      pscanLine32[j].rgbReserved := 0;
    end;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  bmp: TBitmap;
  I: Integer;
  IL: TImageList;
begin
  IL := Imagelist10;
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf32Bit;
  bmp.Canvas.brush.Color := clNone;
  bmp.Width := IL.Width * IL.Count;
  bmp.Height := IL.Height;
  //SetBkMode(bmp.Canvas.Handle, TRANSPARENT); //TRANSPARENT
  PrepareBitmap(bmp);
  for I := 0 to IL.Count - 1 do
  begin
    IL.Draw(bmp.Canvas, (I * 16), 0, I, True);
  end;
  bmp.SaveToFile('2.bmp');
end;

Обратите внимание, что даже если вам удастся использоватьGetImageBitmap (Я сделал с 24-битным imagelist), выходной битовый массив вертикальный и не может быть загружен черезImageList_LoadImage:

Даже в коде, заданном Bummi, выходное растровое изображение становится сглаженным, что не годится. Вот пример (с увеличением 800% - только первые 3 иконки):

Хорошо растровое изображение с альфа-каналом, который будет нормально загружаться сImageList_LoadImage:

Плохой растровое изображение с альфа-каналом (обратите внимание на псевдоним с черным):

Единственный способ, которым я мог получитьидеально результаты были с GDI + и чтением иконок прямо из файлов на диске (НЕ список изображений).
Это работает нормально только на VistaНЕ XP (в старых версиях GDI +GdipCreateBitmapFromHICON а такжеGdipCreateBitmapFromHBITMAP функции разрушают альфа-канал - они записывают альфа = 255 для каждого пикселя).

procedure TForm1.Button3Click(Sender: TObject);
var
  i, num_icons: Integer;
  ico: TIcon;
  icon: HICON;

  encoderClsid: TGUID;
  g: TGPGraphics;
  in_img: TGPBitmap;
  out_img: TGPImage;  
begin
  num_icons := 24;
  out_img := TGPBitmap.Create(16 * num_icons , 16, PixelFormat32bppARGB);

  for i := 1 to num_icons do
  begin
     // does not produce correct bitmap:
     //ico := TIcon.Create;
     //ImageList1.GetIcon(i - 1, ico);
     //in_img := TGPBitmap.Create(ico.Handle);

     in_img := TGPBitmap.Create('D:\Delphi\Projects\Icons\Icon_' + inttostr(i) + '.ico');
     g := TGPGraphics.Create(out_img);
     g.DrawImage(in_img, (i - 1) * 16, 0);
     g.Free;
     in_img.Free;
  end;

  GetEncoderClsid('image/bmp', encoderClsid);
  out_img.Save('output.bmp', encoderClsid);
  out_img.Free;

  ImageList2.DrawingStyle := dsTransparent; 
  // Load from file: 
  ImageList2.Handle := ImageList_LoadImage(0, 'output.bmp', 16, ImageList2.AllocBy,
    CLR_NONE, IMAGE_BITMAP, LR_CREATEDIBSECTION or LR_LOADTRANSPARENT
     or LR_LOADFROMFILE);
end;

Все мои попытки загрузить значки из списка изображений напрямую потерпели неудачу и привели к сглаживанию растровых изображений.

Вот ссылка для скачивания иконок, с которыми я работаю

А вот еще одна картинка, иллюстрирующая результаты растрового изображения:

Я думаю, что наконец-то заработал. все еще нуждается в скручивании, но это работает для меня ключ заключается в том, чтобы скопировать растровые изображения значков на целевые линии сканирования вместо того, чтобы рисовать значки на целевом холсте.

procedure CopyBitmapChannels(Src, Dst: TBitMap; DstOffset: Integer);
var
  pscanLine32Src, pscanLine32Dst: pRGBQuadArray;
  nScanLineCount, nPixelCount: Integer;
begin
  with Src do
  begin
    for nScanLineCount := 0 to Height - 1 do
    begin
      pscanLine32Src := Scanline[nScanLineCount];
      pscanLine32Dst := Dst.Scanline[nScanLineCount];
      for nPixelCount := 0 to Width - 1 do
        with pscanLine32Src[nPixelCount] do
        begin
          pscanLine32Dst[nPixelCount + DstOffset].rgbReserved := rgbReserved;
          pscanLine32Dst[nPixelCount + DstOffset].rgbRed := rgbRed;
          pscanLine32Dst[nPixelCount + DstOffset].rgbGreen := rgbGreen;
          pscanLine32Dst[nPixelCount + DstOffset].rgbBlue := rgbBlue;
        end;
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  h_Bitmap, h_Mask: HBITMAP;
  bm_out, bm_ico: TBitmap;
  hico : HICON;
  icoInfo: TIconInfo;
  i, icon_size, num_icons: Integer;
  in_IL: TImageList;
begin
  // in_IL := ImageList1; // imagelist ready with 32 bit icons
  in_IL := nil; // from files

  icon_size := 16;
  num_icons := 24;

  bm_out := TBitmap.Create;
  bm_out.Width := icon_size * num_icons;
  bm_out.Height := icon_size;
  SetBitmapAlpha(bm_out, 0, 0, 0, 0); // no need to actually modify ScanLines but anyway 

  for i := 0 to num_icons - 1 do
  begin
    if in_IL = nil then
      hico := LoadImage(0, PChar('D:\Delphi\Projects\Icons\Icon_' + inttostr(i + 1) + '.ico'), IMAGE_ICON, 0, 0,
        LR_LOADFROMFILE or LR_LOADTRANSPARENT or LR_CREATEDIBSECTION)
    else
      hico := ImageList_GetIcon(in_IL.Handle, i, ILD_TRANSPARENT); // RGB is slightly changed - not 100% perfect but close enough!

    // get icon info (hbmColor -> bitmap)
    GetIconInfo(hico, icoInfo);
    bm_ico := TBitmap.Create;
    h_Bitmap := CopyImage(icoInfo.hbmColor, IMAGE_BITMAP, 0, 0, {LR_COPYDELETEORG or} LR_COPYRETURNORG or LR_CREATEDIBSECTION);
    bm_ico.Handle := h_Bitmap;

    CopyBitmapChannels(bm_ico, bm_out, i * icon_size);

    DestroyIcon(hico);
    DeleteObject(h_Bitmap);
    bm_ico.Free;
  end;
  bm_out.SaveToFile('output.bmp');
  bm_out.Free;
  // output.bmp is now ready to load with ImageList_LoadImage
end;

Кстати, я мог бы скопироватьGetImageBitmap справиться так:ImageList_GetImageInfo(ImageList1.Handle, 0, Info); h_Bitmap := CopyImage(Info.hbmImage, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) но в любом случае позже его нельзя будет использовать сImageList_LoadImage.