Как добавить иконки в меню

[HotKitten]

В VBStreets -> Популярные вопросы RayShade писал:

Создайте новый проект с формой и кнопкой на ней. Добавьте picturebox (установите Autosize=True) с картинкой bmp (не иконкой ico!), размер картинки должен быть 13х13. Скопируйте в проект код примера.

Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Public Const MF_BITMAP = &H4&

Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean

Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MFT_STRING = &H0&

Private Sub Command1_Click()
'Get the menuhandle of your app
hMenu& = GetMenu(Form1.hwnd)
'Get the handle of the first submenu (Hello)
hSubMenu& = GetSubMenu(hMenu&, 0)
'Get the menuId of the first entry (Bitmap)
hID& = GetMenuItemID(hSubMenu&, 0)
'Add the bitmap
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture
End Sub

===========================================
а чё-то ругается у меня VB на Public Const и на hMenu, может я чё не так сделал?
вообше, я уже давно ищу - как засунуть иконку в меню трея

[Kovu]

Я бы тоже ругался если бы вместо того чтобы обьявлять в коде формы всё как Private или вынести обьявления в отдельный модуль мы маемся дурью

[HotKitten]

а если вынести Private в модуль то ругается на hMenu, может, я чё-то не догоняю, подправьте кодик плиз

[Kovu]

Код: Выделить всё

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Private Const MF_BITMAP = &H4&

Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean

Private Const MIIM_ID = &H2
Private Const MIIM_TYPE = &H10
Private Const MFT_STRING = &H0&

Private Sub Command1_Click()
'Get the menuhandle of your app
hMenu& = GetMenu(Form1.hwnd)
'Get the handle of the first submenu (Hello)
hSubMenu& = GetSubMenu(hMenu&, 0)
'Get the menuId of the first entry (Bitmap)
hID& = GetMenuItemID(hSubMenu&, 0)
'Add the bitmap
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture
End Sub

Всё в коде формы

[HotKitten]

ругается на hMenu&, hSubMenu&, hID& я их описал так
Dim hMenu&
Dim hSubMenu&
Dim hID&
и вроде заработало, только картинка в меню, оличается от картинки в picturebox - она тускнее

чё нибудь мона сделать??

[Amed]

Вообще какая-то необычная палитра. Настройки Windows?

[tyomitch]

Непременное упоминание: PopupMenu2

[HotKitten]

люди, а может у кого нибудь есть кодик на добавление иконок в меню, мне бы маленький, ато у меня есть килобайт по 30-40, а мне надо бы на килобайт 5-10 как у RayShade

[Wolfsider]

Народ... оцените, плз. что не так. На форме : Command1 , Picture1 с впихнутой 13x13 bmp .

Код: Выделить всё

Const MF_CHECKED = &H8&
Const MF_APPEND = &H100&
Const TPM_LEFTALIGN = &H0&
Private Const MIIM_ID = &H2
Private Const MIIM_TYPE = &H10
Private Const MFT_STRING = &H0&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Const TPM_RETURNCMD = &H100&
Const TPM_RIGHTBUTTON = &H2&
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal hwnd As Long, ByVal lptpm As Any) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim hMenu As Long




Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Private Const MF_BITMAP = &H4&

Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean


Private Sub Command1_Click()
'Get the handle of the first submenu (Hello)
hSubMenu& = GetSubMenu(hMenu, 0)
'Get the menuId of the first entry (Bitmap)
hID& = GetMenuItemID(hSubMenu&, 0)
'Add the bitmap
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture
End Sub

Private Sub Form_Click()
Dim Pt As POINTAPI
Dim ret As Long


GetCursorPos Pt

ret = TrackPopupMenuEx(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, Pt.x, Pt.y, Me.hwnd, ByVal 0&)

Debug.Print ret
End Sub

Private Sub Form_Load()

hMenu = CreatePopupMenu()
AppendMenu hMenu, MF_STRING, 1, "Hello !"
AppendMenu hMenu, MF_GRAYED Or MF_DISABLED, 2, "Testing ..."
AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0&
AppendMenu hMenu, MF_CHECKED, 4, "TrackPopupMenu"

End Sub

Цель - добавление иконки в програмно созданное контекстное меню. При вызове меню картинка не отображается. Если можете, помогите рабочим примером.

[GSerg]

Находит все старые темы, кроме нужной...
http://bbs.vbstreets.ru/viewtopic.php?p=56536#56536

[Wolfsider]

ДА НАФИГ МНЕ ВАШ КОНТРОЛ НУЖЕН! Я уже его видел сто раз... дайте мне API.

[GSerg]

Не ори, мой юный 13-летний друг.
Если ты не в состоянии посмотреть "контролу" (хотя где ты его нашёл? там нет контрола) внутрь и увидеть там те самые API, то мы не сможем тебе помочь. Забаним за ор просто и всё.

[Wolfsider]

Тип верно ответил насчет возможности определения возраста по поведению... и я еще ни разу не видел такого, что рунетчик брал цитату из буржуйского башорга. Это выглядит так, как будто они умнее нас...
Это раз. Во вторых, я не гоыорил "контрола"... тебе, верноятно, приснилось. Я сказал Control -__- ЗЫ. объясни мне все таки (пофиг, что оффтоп) причем тут сия цитата? Вашу кучу, под названием mnu30.rar я посмотрел... и нашел там кучу ненужного. Буду выуживать... раз уж тако сложно написать рабочий вариант. Меня никто не убедит в том, что у вас его нет.

[Viper]

По-моему, по совокупности, данный субъект (Wolfsider) вполне уже наорал на баню с люлями...

[GSerg]

Тип верно ответил насчет возможности определения возраста по поведению...

Это да.

и я еще ни разу не видел такого, что рунетчик брал цитату из буржуйского башорга.

Минут 15 в инете, небось?..
Или может только по славянофильским сайтам, где без буквы "ять" - моветон, мизерабль и мовежанр?

Это выглядит так, как будто они умнее нас...

Английский bash.org является оригиналом. Русский - копией. Это первое; и второе - если бы более подходящая случаю цитата наличествовала в русском, я взял бы её.

Это раз. Во вторых, я не гоыорил "контрола"... тебе, верноятно, приснилось. Я сказал Control -__-

Забавно, забавно...
Протри глазки, что ль
И узри цитату из себя постом выше:

ДА НАФИГ МНЕ ВАШ КОНТРОЛ НУЖЕН!

ЗЫ. объясни мне все таки (пофиг, что оффтоп) причем тут сия цитата?

Исключительно по поводу ВАШЕГО ОРА, милейший, исключительно по поводу оного.
Или тот факт, что БОЛЬШИЕ БУКВЫ в инете воспринимаются как крик, ускользнул от взора вашего, поисками картинок в меню занятого?..

Вашу кучу, под названием mnu30.rar я посмотрел... и нашел там кучу ненужного. Буду выуживать... раз уж тако сложно написать рабочий вариант. Меня никто не убедит в том, что у вас его нет.

Там, в куче ненужного, всё разбито по кусочкам, надо просто нужный кусочек взять, остальное проигнорировав. Проявить, так сказать, усилие мысли...

[Viper]

Вашу кучу, под названием mnu30.rar я посмотрел... и нашел там кучу ненужного. Буду выуживать... раз уж тако сложно написать рабочий вариант.

...зернышко разумного в этом есть... По моему стоит труды GSerg и Tyomitch довести до "кирпичного" состояния...

[GSerg]

А оно кирпичное... Включай в проект и пользуйся... Завершённое, отдельное... Просто лежит в проектах, по доброй памяти...

[Viper]

я то пользуюсь... причем именно нужными мне частями (собственно там уже есть собственные фишки давно). Просто в "Кирпичах" размещение данного проекта было бы логичнее.

[lister]

А оно кирпичное... Включай в проект и пользуйся... Завершённое, отдельное... Просто лежит в проектах, по доброй памяти...

Еще как кирпичное! Доводить "для всеобщего обозрения" тут ничего не нужно - если надо, каждый по своим потребностям доведет.

Я давно предлагал оную тему из проектов перетащить в кирпичи - народ частенько спрашивает насчет PopUpMenu.
Вчера кстати такая тема была.
http://bbs.vbstreets.ru/viewtopic.php?t=28911
(Хм... и автор, кстати, Wolfsider)

И частенько темы, касаемые PopUpMenu, заканчаваются казусами. Вчерашняя и сегоднящняя - не исключение. Поэтому, срочно в кирпичи

[Kovu]

Wolfsider
Нервные клетки не восстанавливаются, так что спокойнее, спокойнее.
SetMenuItemBitmaps надо напрямую делать. + Ограничение на картинку, о нем думаю сам прочитаешь.

Код: Выделить всё

SetMenuItemBitmaps hMenu&, 1, MF_BITMAP, Picture1.Picture, Picture1.Picture