Иконки в PopupMenu

Code:

type

TForm1 = class(TForm)

   MainMenu1: TMainMenu;

   File1: TMenuItem;

   // * * * * Элемент для Menu Bar * * * * /

     Open1: TMenuItem;

   // * * * * Элемент для Menu file * * * * /

     procedure FormCreate(Sender: TObject);

   procedure FormShow(Sender: TObject);

private

   {private declarations}

public

   {public declarations}

   Icn, Txt, MnuItm: TBitmap;

end;

procedure TForm2.FormCreate(Sender: TObject);

var

R: TRect;

HIcn: HIcon;

Ic: TIcon;

Index: Word;

FileName: PChar;

begin

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

   Ic := TIcon.Create;

Ic.Handle := ExtractAssociatedIcon(Hinstance, // * задаем путь и имя файла * /

   , Index);

// * * Создаем для текста изображение * * /

   Txt := TBitmap.Create;

with Txt do

begin

   Width := Canvas.TextWidth(' Тест');

   Height := Canvas.TextHeight(' Тест');

   Canvas.TextOut(0, 0, ' Тест');

end;

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

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

   Icn := TBitmap.Create;

with Icn do

begin

   Width := 32;

   Height := 32;

   Brush.Color := clBtnFace;

   Canvas.Draw(0, 0, Ic);

end;

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

   MnuItm := TBitmap.Create;

with MnuItm do

begin

   Width := Txt.Width + 18;

   Height := 18;

   with Canvas do

   begin

     Brush.Color := clBtnFace;

     Pen.Color := clBtnFace;

     Brush.Style := bsSolid;

     Rectangle(0, 0, Width, Height);

     CopyMode := cmSrcAnd;

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

     CopyMode := cmSrcAnd;

     Draw(16, 8 - (Txt.Height div 2), Txt);

   end;

end;

end;

procedure TForm2.FormShow(Sender: TObject);

var

ItemInfo: TMenuItemInfo;

hBmp1: THandle;

begin

HBmp1 := MnuItm.Handle;

with ItemInfo do

begin

   cbSize := SizeOf(ItemInfo);

   fMask := MIIM_TYPE;

   fType := MFT_BITMAP;

   dwTypeData := PChar(MakeLong(hBmp1, 0));

end;

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

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

     Open1.MenuIndex, true, ItemInfo);

end;