цвет меню

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
Chuvak
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 102
Зарегистрирован: 11.03.2003 (Вт) 8:39
Откуда: Russia, Ozёrsk

цвет меню

Сообщение Chuvak » 22.04.2003 (Вт) 8:31

можно ли задать цвет меню
если да, то как

, а цвет MsgBox ?

serix
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 177
Зарегистрирован: 09.11.2002 (Сб) 17:54
Откуда: Russia

Сообщение serix » 22.04.2003 (Вт) 13:03

Насчет меню не уверен, но помоему нет.
А вот для msgBox'а точно нельзя.
Ну что я могу посоветовать, делай свои собственные :idea: ...
ZU

goro
Постоялец
Постоялец
 
Сообщения: 494
Зарегистрирован: 03.12.2002 (Вт) 11:45
Откуда: Украина, Запорожье

Re: цвет меню

Сообщение goro » 22.04.2003 (Вт) 19:36

Chuvak писал(а):можно ли задать цвет меню
если да, то как

Можно через сабклассинг. Сходи на сайт www.vbaccelerator.com
ПРЕВЕД

Chuvak
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 102
Зарегистрирован: 11.03.2003 (Вт) 8:39
Откуда: Russia, Ozёrsk

Сообщение Chuvak » 25.04.2003 (Пт) 5:31

всё ништяк получилось, откопал в своих архивах (но это не моё)
если кому надо, то вот:
Код: Выделить всё
Option Explicit
' CreateBrushIndirect используется, чтобы создать фоновую кисть для меню
Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
' GetMenu используется, чтобы получить дескриптор меню
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
' GetMenuInfo используется, чтобы получить текущую информацию для меню
Private Declare Function GetMenuInfo Lib "user32" (ByVal hMenu As Long, lpcmi As tagMENUINFO) As Long
' SetMenuInfo используется, чтобы установить фоновую кисть назад в меню и все подменю
Private Declare Function SetMenuInfo Lib "user32" (ByVal hMenu As Long, lpcmi As tagMENUINFO) As Long
' Используется в запросах к CreateBrushIndirect
Private Type LOGBRUSH
lbStyle As Long ' Тип cтиля (мы только должны создать твердый фон для этого примера)
lbColor As Long ' Установите цвет кисти
lbHatch As Long ' Стиль штриховки (не используемый в этом примере, потому что это игнорируется для Твердого стиля)
End Type
' Используется в GetMenuInfo и запросах SetMenuInfo
Private Type tagMENUINFO
cbSize As Long ' Размер структуры типа (используйте len, чтобы вычислить)
fMask As Long ' Маска информации / действий, чтобы обработать
dwStyle As Long ' Стиль меню (не используемый в этом примере)
cyMax As Long ' Максимальная высота меню в пикселах (не используется в этом примере)
hbrBack As Long ' Дескриптор фоновой кисти
dwContextHelpID As Long ' ИДЕНТИФИКАТОР Справочного контекста (не используется в этом примере)
dwMenuData As Long ' Данные меню (снова не используются в этом примере)
End Type
Private Const BS_SOLID = 0 ' Твердый стиль для кисти
Private Const MIM_APPLYTOSUBMENUS = &H80000000 ' Обращение к маске подменю
Private Const MIM_BACKGROUND = &H2 ' Фоновая маска
Private Sub Form_Load()
Dim ret As Long ' Переменная для удержаyия возвращаемых значения от GetMenuInfo и SetMenuInfo
Dim hMenu As Long ' Переменная для удержания дескриптора меню
Dim hBrush As Long ' Переменная для удержания дескриптора фоновой кисти, которую мы собираемся создавать
Dim lbBrushInfo As LOGBRUSH ' Переменная для удержания информации CreateBrushIndirect API
Dim miMenuInfo As tagMENUINFO ' Переменная для удержания информации меню
lbBrushInfo.lbStyle = BS_SOLID ' Установить тип кисти
lbBrushInfo.lbColor = vbRed ' Здесь мы устанавливаем наш цвет кисти
lbBrushInfo.lbHatch = 0 ' Это значение игнорируется
hBrush = CreateBrushIndirect(lbBrushInfo) ' Мы создаем нашу кисть
hMenu = GetMenu(Me.hwnd) ' Получают дескриптор меню, которое изменяем
miMenuInfo.cbSize = Len(miMenuInfo) ' Набор MenuInfo структурирует размер так, чтобы мы не получили ошибки
ret = GetMenuInfo(hMenu, miMenuInfo) ' Получить фактическую информацию меню (в случае успеха возвращается 0)
miMenuInfo.fMask = MIM_APPLYTOSUBMENUS Or MIM_BACKGROUND ' Устанавливают маску для изменений (изменение фона меню и всех подменю)
miMenuInfo.hbrBack = hBrush ' Назначение нашей кисти для меню
ret = SetMenuInfo(hMenu, miMenuInfo) ' Записывают нашу информацию назад в меню. Все OK (в случае успеха возвращается non-zero)
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then 'Процедура контекстного меню
Me.PopupMenu mnuMenu
End If
End Sub


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: SemrushBot, Yandex-бот и гости: 4

    TopList