Советы по Delphi. Версия 1.4.3 от 1.1.2001

 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;

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

Листинг был изменен для того, чтобы помещать иконки в «чЕкнутое» состояние меню (просто это делает 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;