Динамическое изменение элементов меню
В процессе работы программы можно изменить элементы меню. Эти возможности показаны на примере программы MenuMod (созданной на основе программы MenuBMP).
VB6 в действии: проект MenuMod
Приложение MenuMod позволяет организовать переключение отображения элементов меню либо в виде растрового изображения, либо в виде текста. Меню приложения MenuMod соответствует меню приложения MenuBMP, но, кроме того, добавлен третий пункт Display Graphics (вывести изображение, если элемент меню содержит текст) или Display Text (вывести текст, если элемент меню содержит графику). Обработчик события Click этого пункта меню вызывает функцию DisplayTextMenu()
или DisplayBitmap Мепи(), что позволяет переключаться из одного режима в другой. В процедуре ModifyMenu() для организации замены графики на текст в элементе меню следует использовать флаг MF_STRING, а для обратной замены — флаг MF_BITMAP.
Программа 13.6. Приложение MenuMod
Option Explicit
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 ModifyMenu Lib "user32" _
Alias "ModifyMenuA" (ByVal hMenu As Long,
ByVal nPosition As Long, ByVal wFlags As Long, _
ByVal wIDNewItem As Long, ByVal IpString As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32"_
(ByVal hdc As Long, ByVal nWidth As Long,_
ByVal nHeight As Long) As Long
Private Declare Function Select0b]ect Lib "gdi32"_
(ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBIt Lib "gdi32" _
(ByVal hDestDC As Long, ByVal x As Long, ByVal у As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcDC As Long, ByVal x Src As Long, _
ByVal уSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Const MF_STRING = &HO&
Const SRCCOPY = &HCC0020
Const MF_BYPOSITION - &H400&
Const MFJ3ITMAP - &H4&
Private Sub Exit_Click()
Unload Me
End Sub
Private Sub Form Load()
Call DisplayBitmapMenu
End Sub
Private Sub Graphics_Click()
‘ Отображение текста
If Graphics Checked Then
Graphics Checked = False
Call DisplayTextMenu
Else
Graphics.Checked = True
Call DisplayBitmapMenu
End If
End Sub
Private Sub MyMenu_Click(Index As Integer)
Me CIs
Me Font Name - MyMenu(Index) Caption
Me CurrentX - (Me ScaleWidth - __
Me.TextWidth(MyMenu(Index).Caption))/2
Me CurrentY = (Me.ScaleHeight _
Me TextHeight(MyMenu(Index) Caption))/2
Me.Print MyMenu(Index).Caption
End Sub
Private Sub DisplayTextMenu()
Dim hMenuID As Long, menuID As Long
Dim menuPos As Integer
Dim retValue As Long
‘ Получение дескриптора меню
hMenuID = GetSubMenu(GetMenu(Me.hwnd),0)
menuPos = 0
menuID - GetMenuItemID(hMenuID, menuPos)
retValue = ModifyMenu(hMenuID, menuPos, _
MF_BYPOSITION Or MF_STRING, menuID, "Verdana")
menuPos = 1
menuID = GetMenuItemID(hMenuID, menuPos)
retValue - ModifyMenu(hMenuID, menuPos,
MF_BYPOSITION Or MF_STRING, menuID, "Serif")
menuPos - 2
menuID - GetMenuIteitiID (hMenuID, menuPos)
retValue = ModifyMenu(hMenuID, menuPos, _
MF_BYPOSITION Or MF_STRING, menuID, "Comic Sans")
End Sub
Private Sub DisplayBitmapMenu()
Dim Width As Integer, Height As Integer
Dim hTmpDC As Long, hMenuID As Long
Dim hBitmap As Long
Dim retValue As Long
Dim tmpID As Long
Dim fileName As String
Dim menuPos As Integer, menuID As Long
‘ Установка позиции меню и имени файла
menuPos - О
fileName - Арр Path & "\verdana.bmp"
Picturel Picture - LoadPicture(fileName)
Width 64
Height =16
‘ Получение дескриптора меню
hMenuID=GetSubMenu(GetMenu(Me.hwnd), menuPos)
‘ Создание контекста устройства, предназначенного для хранения
‘ растрового изображения
hTmpDC = CreateCompatibleDC(Picturel hdc)
‘ Создание растрового изображения
hBitmap = CreateCompatibleBitmap(Picturel hdc. Width, Height)
‘ Выбор растрового изображения во временный контекст
tmpID - Select0b;ect(hTmpDC, hBitmap)
‘ Копирование содержимого из элемента управления в контекст
‘ устройства
retValue = BitBIt(hTmpDC, 0, 0, Width, Height, _
Picturel.hdc, О, О, SRCCOPY)
‘ Отмена выбора
tmpID = SelectObject(hTmpDC, tmpID)
‘ Модификация меню
menuID = GetMenuItemID(hMenuID, menuPos)
retValue = ModifyMenu(hMenuID, menuPos, _
MF_BYPOSITION Or MF_BITMAP, menuID, hBitmap)
‘ Второй пункт меню
menuPos = 1
fileName = App.Path & "\serif.bmp"
Picturel.Picture = LoadPicture(fileName)
‘ Создание растрового изображения для элемента меню
hBitmap = CreateCompatibleBitmap(Picturel.hdc. Width, Height)
‘ Выбор растрового изображения во временный контекст устройства tmpID = SelectObject(hTmpDC, hBitmap)
retValue = BitBIt(hTmpDC, 0, 0, Width, Height, _
Picturel.hdc, 0, 0, SRCCOPY)
tmpID = Select0b;ect(hTmpDC, tmpID)
menuID = GetMenuItemID(hMenuID, menuPos)
retValue = ModifyMenu(hMenuID, menuPos,
MFJ3YPOSITION Or MF_BITMAP, menuID, hBitmap)
‘ Третий пункт меню
menuPos = 2
fileName = App.Path & "\comic.bmp"
Picturel.Picture = LoadPicture(fileName)
‘ Создание растрового изображения для элемента меню
hBitmap = CreateCompatibleBitmap(Picturel.hdc. Width, Height)
‘ Выбор растрового изображения во временный контекст устройства tmpID = SelectObject(hTmpDC, hBitmap)
retValue = BitBIt(hTmpDC, 0, 0, Width, Height, _
Picturel.hdc, 0, 0, SRCCOPY)
tmpID = SelectObject(hTmpDC, tmpID)
menuID = GetMenuItemID(hMenuID, menuPos)
retValue = ModifyMenu(hMenuID, menuPos,
MF_BYPOSITION Or MF_BITMAP, menuID, hBitmap)
‘ Очистка
retValue = DeleteDC(hTmpDC)
End Sub
