Иконки в PopupMenu

Code:

{

В меню существуют некоторые проблемы масштабированием и палитрой иконки.

Я также ищу лучшее решение, но это все, что я вам могу сейчас дать.

Листинг был изменен для того, чтобы помещать иконки в "чЕкнутое"

состояние меню(просто это делает Win95).Это позволяет вам иметь

"чЕкнутое" и "нечЕкнутое" состояние.

}

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Menus, ShellAPI;

type

TForm1 = class(TForm)

   MainMenu1: TMainMenu;

   File1: TMenuItem;

   Open1: TMenuItem;

   procedure FormCreate(Sender: TObject);

   procedure FormShow(Sender: TObject);

private

   { Private declarations }

public

   { Public declarations }

   Icn, MnuItm: TBitmap;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

var

R: TRect;

HIcn: HIcon;

Ic: TIcon;

Index: Word;

begin

{     /** Получаем иконку некоторого приложения **/}

Index := 0; { 11-я иконка в файле }

Ic := TIcon.Create;

Ic.Handle := ExtractAssociatedIcon(Hinstance,

   'c:\win95\system\shell32.dll', Index);

{     /** Копируем иконку в bitmap для изменения его размера.

Вы не можете менять размер иконки **/}

Icn := TBitmap.Create;

with Icn do

begin

   Width := 32;

   Height := 32;

   Canvas.Brush.Color := clbtnface;

   Canvas.Draw(0, 0, Ic);

end;

{     /** Создаем окончательное изображение, куда мы помещаем иконку и текст **/}

MnuItm := TBitmap.Create;

with MnuItm do

begin

   Width := 18;

   Height := 18;

   with Canvas do

   begin

     Brush.Color := clbtnface;

     Pen.Color := clbtnface;

     CopyMode := cmSrcAnd;

     StretchDraw(Rect(0, 0, 16, 16), Icn);

   end;

end;

end;

procedure TForm1.FormShow(Sender: TObject);

var

ItemInfo: TMenuItemInfo;

hBmp1: THandle;

begin

HBmp1 := MnuItm.Handle;

with ItemInfo do

begin

   cbSize := SizeOf(ItemInfo);

   fMask := MIIM_CHECKMARKS;

   fType := MFT_BITMAP;

   hBmpunChecked := HBmp1; { Неотмеченное (Unchecked) состояние }

   hBmpChecked := HBmp1; { Отмеченное (Checked) состояние }

end;

{     /** Заменяем MenuItem Open1 законченным изображением **/}

SetMenuItemInfo(GetSubMenu(MainMenu1.Handle, File1.MenuIndex),

   Open1.MenuIndex, true, ItemInfo);

end;

end.