Данная статья, пошагово, поможет Вам создать кнопку с выпадающим "меню" в виде цветовой гаммы. Кроме того, здесь будут рассмотрены несколько разнообразных приемов работы с графикой, подробно описаны используемые API-функции.
Чтобы
удачно
начать,
необходимо
открыть VB и
создать
новый проект
ActiveX Control :)
Назовем
проект ButtonColor, а
сам UserControl - BC.
Единственное
свойство,
которое
необходимо
изменить - это
ScaleMode. Установим
его равным 3 (Pixel),
так как все API-функции
работают с
пикселами.
Добавим (меню
File/Add Project) новый
проект Standard Exe, где
будем
проводить
тестирование
нашего
контрола.
Справа, в окне
группы,
щелкнем на
нем правой
клавишей
мыши и
выберем из
контекстного
меню Set As Start Up, для
того, чтобы он
стартовал
первым.
Шаг
1. Займемся
графикой. Для
начала нам
надо
нарисовать
контуры
будущей
кнопки. Для
этого можно
использовать
API-функцию DrawEdge:
Private Declare Function DrawEdge
Lib "user32" ( _
ByVal hdc As Long, _
qrc As RECT, _
ByVal edge As Long, _
ByVal grfFlags As Long) _
As Long
В качестве
своих
параметров
она
использует
тип RECT и ряд
констант:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const BDR_RAISEDINNER = &H4
Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_SUNKENINNER = &H8
Private Const BDR_SUNKENOUTER = &H2
Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Const BF_BOTTOM = &H8
Private Const BF_LEFT = &H1
Private Const BF_RIGHT = &H4
Private Const BF_TOP = &H2
Private Const BF_RECT = (BF_LEFT Or BF_TOP
Or BF_RIGHT Or
BF_BOTTOM)
В
разделе
деклараций
объявим две
переменные с
типом RECT:
Private R As RECT
Private R2 As RECT
Которые
будут
определять
границы двух
частей нашей
кнопки.
В
общем-то
можно теперь
присвоить
значения
каждой из
переменных,
примерно так:
R.Left = ...
R.Top = ...
...
Однако,
существует
еще одна API-функция
- SetRect, которая
позволяет
все это
сделать
гораздо
быстрее и за
один ход:
Private Declare Function SetRect
Lib "user32" ( _
lpRect As RECT, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) _
As Long
Теперь
в событии UserControl_Resize
определим
контуры двух
областей для
рисования.
Обратите
внимание, что
вторая часть
кнопки
(область)
имеет
фиксированную
ширину 16
пиксел и при
желании Вы
можете
установить
другое
значение или
же сделать ее
зависимой от ширины
контрола.
Private Sub
UserControl_Resize()
SetRect R, 0, 0, ScaleWidth - 16, ScaleHeight
SetRect R2, ScaleWidth - 16, 0, ScaleWidth, ScaleHeight
End Sub
В событии
UserControl_Paint - уже по
полученным
размерам
просто
нарисуем
нашу кнопку,
состоящую из
2-х частей:
Private Sub
UserControl_Paint()
DrawEdge hdc, R, EDGE_RAISED, BF_RECT
DrawEdge hdc, R2, EDGE_RAISED, BF_RECT
End Sub
Естественно,
при запуске
должна
происходить
перерисовка
всего
контрола:
Private Sub UserControl_Show()
UserControl_Paint
End Sub
Откроем
тестировочную
форму и
разместим на
ней нашу
кнопку. Можно
поиграться с
размерами.
Шаг 2. Левая (большая) часть кнопки должна вызывать непосредсвенное изменение цвета в в выбранной части приложения, а правая - должна выводить выпадающее меню для выбора цвета. Но этим мы займемся чуть позже. Здесь мы будем обрабатывать нажатие клавиши по контролу и рисовать имитацию нажатия кнопки.
В
разделе
деклараций
объявим
единственное
событие
нашей кнопки:
Event SelectedClick()
А так же
объявим
переменную,
которая
будет
следить за
тем, какая
кнопка
нажата:
Private StatusButton As Boolean
Теперь
займемся
процедурой UserControl_MouseDown.
В
зависимости
от того, где
находится
курсор (в
данном
случае нас не
интересует
вертикальная
координата),
мы будем
перерисовывать
соответствующую
часть кнопки:
Private Sub UserControl_MouseDown(Button
As Integer, _
Shift As Integer, X As Single, Y
As Single)
If X > 0 And X < R.Right
Then
DrawEdge hdc, R, EDGE_SUNKEN, BF_RECT
RaiseEvent SelectedClick
StatusButton = True
Else
DrawEdge hdc, R2, EDGE_SUNKEN, BF_RECT
StatusButton = False
End If
SendKeys vbNullChar
End Sub
А
в процедуре ,
в
зависимости
от
переменной StatusButton
возвратим
исходное
изображение.
Private Sub UserControl_MouseUp(Button
As Integer, _
Shift As Integer, X As Single, Y
As Single)
If StatusButton Then
DrawEdge hdc, R, EDGE_RAISED, BF_RECT
Else
DrawEdge hdc, R2, EDGE_RAISED, BF_RECT
End If
SendKeys vbNullChar
End Sub
Вызов
функции SendKeys с
нулевым
параметром,
позволяет
обрабатывать
имитацию
нажатия без "запаздывания".
Полученная
кнопка на
тестировочной
форме должна
работать, в
зависимости
от положения
мыши. Если Вы
хотите, чтобы
кнопка
работала
только на
нажатие
левой
клавиши мыши -
допишите
соответствующую
проверку:
If Button = vbLeftButton Then
...
End If
Шаг
3. Наша
кнопка
нарисована,
но при
изменении
цвета мы не
видим, какой
сейчас
выбран.
Поэтому
самое время
заняться
написанием
единственного
свойства
нашего
контрола,
отвечающего
за выбор и
передачу
цвета. Чего-либо
особенного
здесь не
предвидится,
поэтому мы
воспользуемся
мастером ActiveX Control
Interface Wizard. С помощью
него
создадим
свойство для
чтения и
записи ColorSelected, с
типом OLE_COLOR и
значением по
умолчанию
равным 0 (т.е.
черный цвет).
Единственное,
что мы
добавим - это
в Let -
перерисовку
контрола.
Данная часть
кода у Вас
должна
выглядеть
так:
Public Property Let
ColorSelected(ByVal New_ColorSelected As OLE_COLOR)
m_ColorSelected = New_ColorSelected
PropertyChanged "ColorSelected"
UserControl_Paint
End Property
Все
остальные
коды,
созданные
мастером,
оставим без
изменения.
Затем
на левой
части кнопки
мы должны
вывести
прямоугольник
с выбранным
цветом. Для
этого нам
понадобится
еще один тип:
Private Type LOGBRUSH
lbStyle As Long
lbColor As Long
lbHatch As Long
End Type
А так же 3 API-функции,
которые
займутся
закрашиванием:
Private Declare Function FillRect
Lib "user32" ( _
ByVal hdc As Long, _
lpRect As RECT, _
ByVal hBrush As Long) _
As Long
Private Declare Function CreateBrushIndirect Lib "gdi32" ( _
lpLogBrush As LOGBRUSH) _
As Long
Private Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long) _
As Long
Первая
функция
отвечает за
заполнение
определенным
цветом
выбранного прямоугольника.
Вторая -
создает
кисть для
закрашивания.
А третья
функция
будет
удалять
отслужившую
кисть,
освобождая
память.
Там же в
разделе
деклараций
объявим 2
константы,
для указания
типа кисти:
Private Const BS_SOLID = 0
Private Const HS_SOLID = 8
И 2
переменные:
одна будет
отвечать за
еип кисти, а
вторая за
размеры
закрашиваемого
прямоугольника:
Private R_in As RECT
Private LB As LOGBRUSH
Где
все это
должно
располагаться?
Самое
логичное - это
в процедурах
UserControl,
отвечающих
за изменение
размеров и
перерисовку.
Пожтому
давайте
дополним
кодами
процедуры Resize и
Paint. В Resize получим
еще один прямоугольник.
Эта
процедура
должна
приобрести
окончательный
вид:
Private Sub UserControl_Resize()
'получаем размеры внешнего контура
SetRect R, 0, 0, ScaleWidth - 16, ScaleHeight
SetRect R2, ScaleWidth - 16, 0, ScaleWidth, ScaleHeight
'получаем размеры внутреннего (закрашиваемого) контура
SetRect R_in, 4, 4, R.Right - 4, ScaleHeight - 4
End Sub
А в Paint создаем
кисть,
закрашиваем
ей созданный
прямоугольник,
удаляем
ненужную
теперь уже
кисть и
напоследок,
для эстетики,
делаем
рамочку:
Private Sub UserControl_Paint()
Dim hBrush As Long
'рисуем внешний контур
DrawEdge hdc, R, EDGE_RAISED, BF_RECT
DrawEdge hdc, R2, EDGE_RAISED, BF_RECT
'заполняем значения для рисования
LB.lbColor = m_ColorSelected
LB.lbStyle = BS_SOLID
LB.lbHatch = HS_SOLID
'создаем кисть
hBrush = CreateBrushIndirect(LB)
'заполняем выбранным цветом внутренний прямоугольник
FillRect hdc, R_in, hBrush
'удаляем кисть, освобождая память
DeleteObject hBrush
'рисуем контур внутреннего прямоугольника
DrawEdge hdc, R_in, EDGE_ETCHED, BF_RECT
End Sub
Откроем
тестировочную
форму. Теперь,
при
изменении
свойства ColorSelected в
окне свойств,
изменяется
цвет в левой
нашей части
кнопки.
Добавим на
форму любой
элемент
управления,
поддерживающий
изменение
цвета. Ну,
допустим, PictureBox. И
напишем код:
Private Sub BC1_SelectedClick()
Picture1.BackColor = BC1.ColorSelected
End Sub
После
запуска
проекта на
исполнение,
клик по
правой части
кнопки пока
ничего не
делает, а клик
по левой
части - будет
окрашивать
PictureBox в
указанный
цвет.
Шаг 4. С рисованием самой кнопки мы закончили. Теперь необходимо заняться выпадающей частью. Расположим на контроле PictureBox и установим его свойства: Name = picPopup, AutoRedraw = True, AutoSize = True, BorderStyle = 0 (None), ScaleMode = 3 (Pixel), Visible = False. Далее, графическими методами можно было бы нарисовать на нем квадратики с различными цветами, но мы сделаем по другому. Скопируем из стандартного диалогового окна изменения цвета палитру и сохраним ее в jpg-формате. А затем вставим в picPopup.
Следующим
шагом будет
присвоение
хендла вновь
создаваемому
окну. Для
этого
используются
две API-функции:
Private Declare Function SetParent
Lib "user32" ( _
ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) _
As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
И две
константы к
ним:
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOOLWINDOW = &H80
Вывод
данных
функций
необходимо
произвести
как можно
раньше, еще во
время
инициализации
контрола:
Private Sub UserControl_Initialize()
SetWindowLong picPopup.hwnd, GWL_EXSTYLE, WS_EX_TOOLWINDOW
SetParent picPopup.hwnd, 0
End Sub
Теперь
необходимо
написать 2
функции. Одна
отвечает за
показ
выпадающего
окна (ShowPopup),
другая - за
его скрытие (HidePopup).
В них мы будем
так же
использовать
API-функции: 3
функции для
захвата и
снятия
захвата picPopup и
одна для
позиционирования
его
относительно
кнопки:
Private Declare Function SetCapture
Lib "user32" ( _
ByVal hwnd As Long) _
As Long
Private Declare Function ReleaseCapture Lib "user32" () _
As Long
Private Declare Function GetCapture Lib "user32" () _
As Long
Private Declare Function GetWindowRect Lib "user32" ( _
ByVal hwnd As Long, _
lpRect As RECT) _
As Long
В
функции ShowPopup,
вначале получим
необходимые
координаты
для
выпадающей
части,
присвоим ей
эти
координаты,
сделаем
видимой и
расположим
поверх
других ЭУ. В
конце,
захватим
мышь, для
клика по
картинке.
Private Sub ShowPopUp()
Dim tmpRect As RECT
Dim lTop As Long, lLeft
As Long
GetWindowRect hwnd, tmpRect
lTop = tmpRect.Bottom * Screen.TwipsPerPixelY
lLeft = tmpRect.Left * Screen.TwipsPerPixelX
With picPopup
.Top = lTop
.Left = lLeft
.Visible = True
.ZOrder
End With
DoEvents
SetCapture picPopup.hwnd
End Sub
Функция
HidePopup гораздо
проще.
Сначала
проверим
захват мыши и,
если он есть,
снимем его.
После чего
сделаем
невидимым picPopup:
Private Sub HidePopup()
If GetCapture = picPopup.hwnd Then
ReleaseCapture
End If
picPopup.Visible = False
DoEvents
End Sub
Где
мы будем
показывать
выпадающую
часть?
Конечно же в
событии UserControl_MouseUp
при клике по
правой части
кнопки. В
окончательном
варианте это
событие
выглядит так:
Private Sub UserControl_MouseUp(Button
As Integer, _
Shift As Integer, X As Single, Y
As Single)
If StatusButton Then
DrawEdge hdc, R, EDGE_RAISED, BF_RECT
Else
DrawEdge hdc, R2, EDGE_RAISED, BF_RECT
ShowPopUp
End If
SendKeys vbNullChar
End Sub
А
вот скрытие
должно
происходить
как при клике
по picPopup, так и при
потере
фокуса
контролом.
Первый
вариант мы
распишем в
следующем
шаге, а второй
должен
выглядеть
так:
Private Sub UserControl_ExitFocus()
If picPopup.Visible Then HidePopup
End Sub
Шаг
5. Выбор
цвета и
передача его
свойству ColorSelected.
Следуя из
логики
событий, во
время щелчка
по
выпадающей
части кнопки,
должно
происходить
считывание
параметров
пиксела,
находящегося
под курсором.
Для этого нем
будет
необходима
очередная API-функция,
а именно:
Private Declare Function GetPixel
Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long) _
As Long
Ничего
сложного в
ней нет.
Требуется hdc считываемого
устройства и
координаты
точки.
Координаты
можно
получить в
событии picPopup_MouseDown,
что мы и
сделаем.
Вначале
проверим
попадает ли
курсор на
выпадающую
часть кнопки,
и, если
попадает -
передаем
цвет пиксела
свойству ColorSelected,
затем
скрывем picPopup и
обрабатываем
наше событие SelectedClick.
Во всех
остальных
случаях - мы
просто
скрываем picPopup:
Private Sub picPopup_MouseDown(Button
As Integer, _
Shift As Integer, X As
Single, Y As Single)
If X < 0 Or X > picPopup.Width / Screen.TwipsPerPixelX _
Or Y < 0
Or Y > picPopup.Height / Screen.TwipsPerPixelY Then
HidePopup
ElseIf Button = vbLeftButton Then
ColorSelected = GetPixel(picPopup.hdc, X, Y)
HidePopup
RaiseEvent SelectedClick
Else
HidePopup
End If
End Sub
В результате мы получили кнопку с выпадающим меню для выбора цвета. Пользуйтесь!
