Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Программа и интерфейс
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 10.04.2015, 11:40
Аватар для SCrat.ORS
SCrat.ORS SCrat.ORS вне форума
Активный
 
Регистрация: 20.02.2007
Адрес: Мой адрес не дом и не улица, мой адрес 0x7С00
Сообщения: 208
Версия Delphi: 2006
Репутация: 884
Вопрос Меню с иконками в стиле aero - часть 2

Часть 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? Если ДА, то каким образом?
__________________
Програмистами не рождаются, ими становятся!

Последний раз редактировалось SCrat.ORS, 10.04.2015 в 11:43.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 19:00.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter