ReSQL.ru
     
powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / А вообще иконки в VB6 меню тяжело добавить?
9 сообщений из 9, страница 1 из 1
А вообще иконки в VB6 меню тяжело добавить?
    #38263942
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Ну честно в меню Tray иконки я б добавил картинок.
Поверхностно пока просмотрел:
SetMenuItemBitmaps function] http://msdn.microsoft.com/en-us/library/windows/desktop/ms647998(v=vs.85).aspx
SetMenuItemInfo function] http://msdn.microsoft.com/en-us/library/windows/desktop/ms648001(v=vs.85).aspx
MENUITEMINFO structure] http://msdn.microsoft.com/en-us/library/windows/desktop/ms647578(v=vs.85).aspx

Или есть подводные камни?
Предполагаю что один из камней связан с тем что при разных разрешениях экрана требуются картинки разных размеров (размер меню меняется). Про монохромность что то тоже не очень понимаю.

The selected and clear bitmaps should be monochrome. The system uses the Boolean AND operator to combine bitmaps with the menu so that the white part becomes transparent and the black part becomes the menu-item color. If you use color bitmaps, the results may be undesirable.

Use the GetSystemMetrics function with the CXMENUCHECK and CYMENUCHECK values to retrieve the bitmap dimensions.


Потом,
hbmpItem
Type: HBITMAP

A handle to the bitmap to be displayed, or it can be one of the values in the following table. It is used when the MIIM_BITMAP flag is set in the fMask member.

В чем мне аккумулировать картинки.
Для Listview/Treeview я испольльзую 32-битные иконки (подменяя vb-шные в exe-шнике) + API-ImageList.
Как здесь быть?

Нет ли где каких (незаумных, без дурацких контролов) примеров простых?
...
Рейтинг: 0 / 0
20.05.2013, 05:59
| Ответить | Цитировать | Написать  
А вообще иконки в VB6 меню тяжело добавить?
    #38264614
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
В принципе вот это работает,

Код: vbnet
1.
2.
3.
4.
5.
Private Sub InitMenuPictures()
  Dim hSubMenu As Long
  hSubMenu = GetSubMenu(GetMenu(Me.hWnd), 0)
  SetMenuItemBitmaps hSubMenu, 0, MF_BYPOSITION, ImageList1.ListImages(1).Picture, ImageList1.ListImages(1).Picture
End Sub



Сразу вопросы:
1. Мне естественно нужен API-imagelist
Я его создаю
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
  m_hImlMN = ImageList_Create(16, 16, ILC_MASK Or ILC_COLOR32, 6, 0)
  If IsIDEApp Then
      ImageList_AddMasked m_hImlMN, LoadResPicture(101, vbResBitmap), vbBlue
...
  Else
      lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(101), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR)
      ImageList_ReplaceIcon m_hImlMN, -1, lngIcon
      DestroyIcon lngIcon
...


За основу естественно берутся 32-битные полноцветные иконки(нижний код), ибо с битмэпами (верхний код) нормально не получается.
Т.е. как мне вытащить из API-ImageList HBITMAP ? Который мне нужен для SetMenuItemBitmaps?
Через длинные GDI-махинации только?

2. Я еще не разбирался с GetSystemMetrics
но в лоб я вижу следующее:

На Висте иконка 16х16 рисуется нормально в плане размеров.
На классике 16х16 явно много - она обрезается. А хочется естественно как в меню Start -а там очевидно 16х16.
Куда копать?
Ощущение, что от иконок на XP придется отказываться.
...
Рейтинг: 0 / 0
20.05.2013, 14:58
| Ответить | Цитировать | Написать  
А вообще иконки в VB6 меню тяжело добавить?
    #38264912
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Вот так вот рисует

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
Private Sub InitMenuPictures()
  Dim hSubMenu As Long
  Dim hBitmap As Long
  hSubMenu = GetSubMenu(GetMenu(Me.hwnd), 0)
   hBitmap = HBITMAP_fromICON(101)
  SetMenuItemBitmaps hSubMenu, 0, MF_BYPOSITION, hBitmap, hBitmap
  hBitmap = HBITMAP_fromICON(102)
  SetMenuItemBitmaps hSubMenu, 1, MF_BYPOSITION, hBitmap, hBitmap
...

Public Function HBITMAP_fromICON(icon_index As Long) As Long
  Dim lngIcon As Long
  Dim hdc As Long
  Dim hMemDC As Long
  Dim hMemBmp As Long
  Dim hResultBmp As Long
  Dim hOrgBMP As Long
  
  lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(icon_index), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR)
  hdc = GetDC(0)
  hMemDC = CreateCompatibleDC(hdc)
  hMemBmp = CreateCompatibleBitmap(hdc, 16, 16)
  hResultBmp = 0
  hOrgBMP = SelectObject(hMemDC, hMemBmp)
  DrawIconEx hMemDC, 0, 0, lngIcon, 16, 16, 0, 0, DI_NORMAL
  hResultBmp = hMemBmp
  hMemBmp = 0
  SelectObject hMemDC, hOrgBMP
  DeleteDC hMemDC
  ReleaseDC 0, hdc
  DestroyIcon lngIcon
  HBITMAP_fromICON = hResultBmp
End Function



Но фон картинки черный, а не прозрачный. Ну, в принципе интуитивно понятно, с mask-color новоявленного битмапа я ничего не делал.
Может их сразу на hdc итема как-то рисовать через DrawIconEx?

И на XP чего делать чтоб 16х16 помещались?
...
Рейтинг: 0 / 0
20.05.2013, 17:23
| Ответить | Цитировать | Написать  
А вообще иконки в VB6 меню тяжело добавить?
    #38265127
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Visual Style Menus
but Windows Vista® uses alpha-blended bitmaps instead
Для Висты вот так вот все получилось в лучшем виде:

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
Private Sub InitMenuPictures()
  Dim hSubMenu As Long
  Dim hBitmap As Long
  hSubMenu = GetSubMenu(GetMenu(Me.hwnd), 0)
   hBitmap = HBITMAP_fromICON(101)
  SetMenuItemBitmaps hSubMenu, 0, MF_BYPOSITION, hBitmap, hBitmap
  hBitmap = HBITMAP_fromICON(102)
  SetMenuItemBitmaps hSubMenu, 1, MF_BYPOSITION, hBitmap, hBitmap
...

Public Function HBITMAP_fromICON(icon_index As Long) As Long
  Dim lngIcon As Long
  Dim hdc As Long
  Dim hMemDC As Long
  Dim hMemBmp As Long
  Dim hResultBmp As Long
  Dim hOrgBMP As Long
  Dim bmiDst As BITMAPINFO2
  Dim pBits As Long
  
  lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(icon_index), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR)
  hdc = GetDC(0)
  hMemDC = CreateCompatibleDC(hdc)
  
  With bmiDst.bmiHeader
    .biSize = LenB(bmiDst.bmiHeader)
    .biWidth = 16
    .biHeight = 16
    .biPlanes = 1
    .biBitCount = 32
    .biCompression = BI_RGB
  End With
  hMemBmp = CreateDIBSection(0, bmiDst, DIB_RGB_COLORS, pBits, 0, 0)
  
  'hMemBmp = CreateCompatibleBitmap(hdc, 16, 16)
  hResultBmp = 0
  hOrgBMP = SelectObject(hMemDC, hMemBmp)
  DrawIconEx hMemDC, 0, 0, lngIcon, 16, 16, 0, 0, DI_NORMAL
  hResultBmp = hMemBmp
  hMemBmp = 0
  SelectObject hMemDC, hOrgBMP
  DeleteDC hMemDC
  ReleaseDC 0, hdc
  DestroyIcon lngIcon
  HBITMAP_fromICON = hResultBmp
End Function



Для XP видимо придется попотеть или забить:
In Windows XP, owner-draw menus show icons,

Здесь вот люди рассуждают об этом.
Что я должен сделать чтоб превратить VB6-меню в "owner-draw"?
...
Рейтинг: 0 / 0
20.05.2013, 19:07
| Ответить | Цитировать | Написать  
А вообще иконки в VB6 меню тяжело добавить?
    #38265439
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Ну в принципе и на XP все достаточно просто.
И че говорят что в VB-шное меню картинки не добавишь. Задача в общем так себе по сложности оказалась.
Owner-draw как таковой даже не нужен.
Достаточно забабахать в итем .hbmpItem = HBMMENU_CALLBACK

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Public Sub SetPopMenuBitmapCallback(hSubMenu As Long, ByVal mnuItem As Long)
  Dim mInfo As MENUITEMINFO
  
  With mInfo
    .cbSize = Len(mInfo)
    .fMask = MIIM_BITMAP
    .hbmpItem = HBMMENU_CALLBACK
  End With
  
  Call SetMenuItemInfo(hSubMenu, mnuItem, True, mInfo)

End Sub



и это автосгенерирует WM_MEASUREITEM и WM_DRAWITEM
первое сообщение позволяет подготовить пространсво под картинку, второе нарисовать картинку через DrawIconEx:
Как то так (я сделал для popup меню)


Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
Public Function NewFormMeWindowProc( _
 ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
  Dim mM As MEASUREITEMSTRUCT
  Dim dM As DRAWITEMSTRUCT
  Dim lngIcon As Long
  Dim menu_caption As String
  Dim length As Long
  Dim j As Long
  
  Select Case Msg
    Case WM_INITMENUPOPUP 'menu
      Debug.Print "WM_INITMENUPOPUP-" & wParam & " - " & CBool(HIWORD(lParam)) & " - " & LOWORD(lParam)
      If (CBool(HIWORD(lParam)) = False) And (LOWORD(lParam) = 0) Then
        'CBool(HIWORD(lParam)) = True это НЕ popup, а меню заголовка окна (развернуть-минимизировать)
        'LOWORD(lParam) = 0 означает, что вызвали popup, а не какое-то его submenu
        'у нас нет submenu
        'все заряжается в момент вызова основного popup
        If IsWinVista And ThemesEnabled(Form1.hwnd) Then
          'http://msdn.microsoft.com/en-us/library/bb757020.aspx
          'but Windows Vista® uses alpha-blended bitmaps instead
          hBitmap(0) = HBITMAP_fromICON(101)
          hBitmap(1) = HBITMAP_fromICON(102)
          hBitmap(2) = HBITMAP_fromICON(103)
          hBitmap(3) = HBITMAP_fromICON(104)
          hBitmap(4) = HBITMAP_fromICON(105)
          hBitmap(5) = HBITMAP_fromICON(106)
          SetMenuItemBitmaps wParam, 0, MF_BYPOSITION, hBitmap(0), hBitmap(0)
          SetMenuItemBitmaps wParam, 1, MF_BYPOSITION, hBitmap(1), hBitmap(1)
          SetMenuItemBitmaps wParam, 3, MF_BYPOSITION, hBitmap(2), hBitmap(2)
          SetMenuItemBitmaps wParam, 4, MF_BYPOSITION, hBitmap(3), hBitmap(3)
          SetMenuItemBitmaps wParam, 5, MF_BYPOSITION, hBitmap(4), hBitmap(4)
          SetMenuItemBitmaps wParam, 7, MF_BYPOSITION, hBitmap(5), hBitmap(5)
        Else
          'http://www.nanoant.com/programming/themed-menus-icons-a-complete-vista-xp-solution
          'HBMMENU_CALLBACK method
          SetPopMenuBitmapCallback wParam, 0
          SetPopMenuBitmapCallback wParam, 1
          SetPopMenuBitmapCallback wParam, 3
          SetPopMenuBitmapCallback wParam, 4
          SetPopMenuBitmapCallback wParam, 5
          SetPopMenuBitmapCallback wParam, 7
        End If
      End If
    Case WM_EXITMENULOOP
      Debug.Print "WM_EXITMENULOOP"
      If IsWinVista Then 'And ThemesEnabled(Form1.hwnd)
        For j = 0 To 5
          If hBitmap(j) <> 0 Then DeleteObject hBitmap(j)
        Next
      End If
    Case WM_MEASUREITEM 'классика или XP
      Debug.Print "WM_MEASUREITEM"
      CopyMemory mM, ByVal lParam, Len(mM)
      If mM.CtlType = ODT_MENU Then
        'Debug.Print "ODT_MENU"
        mM.itemWidth = mM.itemWidth + 8 'зазор между иконками и текстом
        If mM.itemHeight < 18 Then mM.itemHeight = 18 'чтоб было как в Start menu, надо 18 а не 16
        CopyMemory ByVal lParam, mM, Len(mM)
      End If
    Case WM_DRAWITEM 'классика или XP
      Debug.Print "WM_DRAWITEM"
      CopyMemory dM, ByVal lParam, Len(dM)
      If dM.CtlType = ODT_MENU Then
        'Debug.Print "ODT_MENU"
        ' Get the menu caption - ну, тупо прочтем чего написано в Item.Caption
        menu_caption = Space$(1024)
        length = GetMenuString(dM.hwndItem, dM.itemID, menu_caption, _
         Len(menu_caption), 0)
        menu_caption = Left$(menu_caption, length)
        'Debug.Print menu_caption
        Select Case menu_caption
          Case "Start":
            lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(101), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR)
          Case "Stop":
            lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(102), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR)
          Case "Setup":
            lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(103), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR)
          Case "OK":
            lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(104), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR)
          Case "Delete":
            lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(105), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR)
          Case "Help":
            lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(106), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR)
          Case Else
        End Select
        If lngIcon <> 0 Then
          DrawIconEx dM.hdc, _
           dM.rcItem.Left - 16, _
           dM.rcItem.Top + (dM.rcItem.Bottom - dM.rcItem.Top - 16) / 2, _
           lngIcon, 16, 16, _
           0, 0, DI_NORMAL
          DestroyIcon lngIcon
        End If
      End If
    Case Else
  End Select
    
  NewFormMeWindowProc = CallWindowProc( _
   OldFormMeWindowProc, hwnd, Msg, wParam, _
   lParam)
End Function



Ну, разве что для enabled=false надо допилить (видимо в градациях серого). Но мне это кажется для меню трея сейчас не нужно.
...
Рейтинг: 0 / 0
21.05.2013, 04:00
| Ответить | Цитировать | Написать  
А вообще иконки в VB6 меню тяжело добавить?
    #38265440
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
...
Рейтинг: 0 / 0
21.05.2013, 04:02
| Ответить | Цитировать | Написать  
А вообще иконки в VB6 меню тяжело добавить?
    #38273313
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Дмитрий77Ну, разве что для enabled=false надо допилить (видимо в градациях серого).
Вот решил все-таки допилить для Item=Disabled.
Пораспихивать картинки по менюшкам. Ну так, не все подряд итемы, а местами - как Microsoft учит, а иначе дурной тон (как во многих программах сделано, действительно дурно это смотрится, особенно когда в 16х16 иконке пытаются довести полное описание проги)

На "Вистах" все замечательно.
Код: vbnet
1.
SetMenuItemBitmaps wParam, 0, MF_BYPOSITION, hBitmap, hBitmap_BW


где hBitmap_BW - картинка в градациях серого
даже можно
Код: vbnet
1.
SetMenuItemBitmaps wParam, 0, MF_BYPOSITION, hBitmap, hBitmap


Она сама сделает GrayScale и заретуширует в лучшем виде.
Полная автоматика, душа радуется.

А вот на XP честно немного Ж.
Если делать:

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
   Case WM_DRAWITEM 'классика или XP
         Select Case menu_caption
          Case "&Delete":
             If Form1.menu_EditDelete.Enabled Then
              lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(241), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR) 'цветная
            Else
              lngIcon = LoadImage(App.hInstance, MAKEINTRESOURCE(246), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR) 'GrayScale
            End If
...
        If lngIcon <> 0 Then
          DrawIconEx dm.hdc, _
           dm.rcItem.Left - 16, _
           dm.rcItem.Top + (dm.rcItem.Bottom - dm.rcItem.Top - 16) / 2, _
           lngIcon, 16, 16, _
           0, 0, DI_NORMAL
          DestroyIcon lngIcon


То
1) Если пункт меню Form1.menu_EditDelete.Enabled = false и при этом не выделен ,
то lngIcon будет преобразовано в "контуры", чтоб это выглядело нормально, надо очень аккуратно рисовать иконку контурами с применением только белый/черный (а не Grayscale).
Но при этом
2) Если пункт меню Form1.menu_EditDelete.Enabled = false и при этом выделен ,
то код выше будет рисовать именно "GrayScale" на фоне выделения.

Посоветуйте:
1. Самый простой вариант решения (и не самый худший):
при .Enabled = false вообще иконку не рисовать
Но что-то он далек от "стандартов".
2. Есть вариант (он используется в VB6 студии) - отменять выделение итемов кот. .Enabled = false Будут всегда "контуры".
Но опять же, хочу чтоб они-таки подсвечивались при выделении.
3. Наилучшим мне кажется вариант: надо сделать чтоб и при выделенном, и при невыделенном итеме был Grascale.
Какой-то флаг структуры DRAWITEMSTRUCT structure ?

itemState
Type: UINT
The visual state of the item after the current drawing action takes place. This member can be a combination of the values shown in the following table.

Надо поиграться и попробовать чего нибудь поменять.
Кстати интересно - обратил внимание
В IE8 (на XP) - меню "Избранное" (с картинками) имеет совершенно другой стиль чем соседние (другая высота итемов - чтоб поместились картинки ) и пункты которые "Disabled" - выглядят серыми, а не вдавленными, как в соседних меню.
Т.е. такой гибрид считается нормальным.
Видимо если для подменю с картинками сделать также как в "Избранное", то будет GrayScale (без контурных картинок). Попробую.
...
Рейтинг: 0 / 0
25.05.2013, 20:37
| Ответить | Цитировать | Написать  
А вообще иконки в VB6 меню тяжело добавить?
    #38273478
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Здесь ответ:

Как заменить "вдавленный стиль" на "серый" (в меню)
...
Рейтинг: 0 / 0
26.05.2013, 05:00
| Ответить | Цитировать | Написать  
А вообще иконки в VB6 меню тяжело добавить?
    #38274036
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Вот еще вариант с использованием API ImageList

Хотя я от него отказался из-за избыточности (картинка туда-сюда гоняется) и из-за вероятности появления нек. глючок в связи с двойным преобразованием иконки.
...
Рейтинг: 0 / 0
26.05.2013, 22:58
| Ответить | Цитировать | Написать  
9 сообщений из 9, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / А вообще иконки в VB6 меню тяжело добавить?
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=38265439&tid=2156956]:
 0ms
get settings:
 8ms
get forum list:
 15ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 50ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 55ms
get tp. blocked users:
 2ms
others: 271ms
total:  420ms
созд. / загр.: 420ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]