Delphi 自訂圖示彈出式選單實作教學

目標

建立類似 Windows 開始選單風格，擁有自訂圖示的主選單項目。Delphi 原生 TMainMenu 不直接支援項目圖示，需透過 Windows API SetMenuItemInfo 結合位圖實現。

核心步驟

1. 使用 ExtractAssociatedIcon 從執行檔取得圖示控制碼。
2. 建立位圖 (TBitmap)，將圖示繪製其上並調整尺寸 (通常 16x16)。
3. 建立最終選單項目位圖，包含圖示區與文字區，背景色設為 clBtnFace。
4. 填寫 TMenuItemInfo 結構，設定 fMask = MIIM_TYPE, fType = MFT_BITMAP, dwTypeData 指向位圖控制碼。
5. 呼叫 SetMenuItemInfo 套用至目標選單項目。

完整程式碼範例

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    Icn, Txt, MnuItm: TBitmap;
  end;

procedure TForm1.FormCreate(Sender: TObject);
var
  R: TRect;
  HIcn: HIcon;
  Ic: TIcon;
  Index: Word;
  FileName: PChar;
begin
  // 1. 取得圖示 (此處從自身應用程式取得)
  Ic := TIcon.Create;
  try
    Ic.Handle := ExtractAssociatedIcon(HInstance, FileName, Index);
    // 2. 建立文字位圖 (測量寬高)
    Txt := TBitmap.Create;
    with Txt do
    begin
      Width := Canvas.TextWidth(' Test');
      Height := Canvas.TextHeight(' Tes');
      Canvas.TextOut(0, 0, ' Test');
    end;

    // 3. 建立圖示位圖並縮放至 32x32 (再縮至 16x16)
    Icn := TBitmap.Create;
    with Icn do
    begin
      Width := 32;
      Height := 32;
      Brush.Color := clBtnFace;
      Canvas.Draw(0, 0, Ic);
    end;

    // 4. 組合最終選單項目位圖 (圖示 + 文字)
    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 := cmSrcCopy;
        Draw(16, 8 - (Txt.Height div 2), Txt); // 繪製文字
      end;
    end;
  finally
    Ic.Free;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  ItemInfo: TMenuItemInfo;
  HBmp: THandle;
begin
  HBmp := MnuItm.Handle;
  FillChar(ItemInfo, SizeOf(ItemInfo), 0);
  ItemInfo.cbSize := SizeOf(ItemInfo);
  ItemInfo.fMask := MIIM_TYPE;
  ItemInfo.fType := MFT_BITMAP;
  ItemInfo.dwTypeData := PChar(MakeLong(HBmp, 0));

  // 套用至 File1 子選單中的 Open1 項目
  SetMenuItemInfo(
    GetSubMenu(MainMenu1.Handle, File1.MenuIndex),
    Open1.MenuIndex, True, ItemInfo);
end;

注意事項

• 需在 uses 加入 Windows, Menus。
• 位圖尺寸建議符合系統選單高度 (通常 16~18 像素)。
• Delphi 4/5/6/7 及後續版本均適用。
• 若需支援高 DPI，需依螢幕縮放比例調整位圖尺寸。