Наверное, каждый разработчик хочет сделать интерфейс своей программы более привлекательным, используя нестандартные элементы ActiveX. Возьмём, например стандартную командную кнопку, без которой не обойдёшься, и усовершенствуем её - создадим свою. Сделаем так, чтобы можно было выбрать стиль её бордюра (при нормальном состоянии, при движении по ней курсором и при нажатии на неё), добавим возможность выбора картинок для кнопки (во всех предыдущих состояниях + состояние дезактивации кнопки) и добавим возможность выбора цвета текста при движении по кнопки курсором.
Наверное, каждый разработчик хочет сделать интерфейс своей программы более привлекательным, используя нестандартные элементы ActiveX. Возьмём, например стандартную командную кнопку, без которой не обойдёшься, и усовершенствуем её - создадим свою. Сделаем так, чтобы можно было выбрать стиль её бордюра (при нормальном состоянии, при движении по ней курсором и при нажатии на неё), добавим возможность выбора картинок для кнопки (во всех предыдущих состояниях + состояние дезактивации кнопки) и добавим возможность выбора цвета текста при движении по кнопки курсором. Сначала создадим новый элемент ActiveX и назовём его "CoolButton", а проект "CoolBTN". Установим свойство элемента "AutoRedraw" = True. Теперь добавим на контрол четыре элемента PictureBox, назовём их "picUP", "picDown", "picMove" и "picDisabled". Они будут хранить картинки различных состояний кнопки. Завершим работу с элементами - установим свойства элементов PictureBox "AutoRedraw" = True и "Visible" = False. Запустим мастер "ActiveX Control Interface Wizard" и добавим следующие свойства и методы:
Название | Тип | Владелец / тип данных | BackColor | Свойство | UserControl | Caption | Свойство | (None) / String | Click | Событие | UserControl | Enabled | Свойство | UserControl | Font | Свойство | UserControl | ForeColor | Свойство | UserControl | HoverColor | Свойство | (None) / OLE_COLOR | MouseDown | Событие | UserControl | MouseMove | Событие | UserControl | MouseUp | Событие | UserControl | PictureDisabled | Свойство | picDisabled | PictureDown | Свойство | picDown | PictureMove | Свойство | picMove | PictureUp | Свойство | picUp | StyleDown | Свойство | (None) / Variant | StyleMove | Свойство | (None) / Variant | StyleUp | Свойство | (None) / Variant | Теперь перейдём в код нашего элемента. Для определения положения курсора и некоторых графических операций нам потребуются следующие API функции, добавьте их в код элемента: Private Declare Function GetCapture Lib "user32" () As Long Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long Функция GetCapture получает окно, которое принимает сообщения мышки, а функция SetCapture, соответственно, устанавливает, какому окну получать мышиные сообщения. Чтобы мышиные сообщения получало окно, над которым действительно находится курсор, будем использовать эту функцию. Для рисования рамки кнопки нам потребуется API функция DrawRect, необходимые для неё структура и константы перечислены ниже. При рисовании текста с помощью функции DrawText нам будет необходима функция SetTextColor, чтобы установить цвет текста. Значение свойства "ForeColor" элемента ActiveX не будет влиять на цвет текста, нарисованный функцией DrawText. Private Const BDR_RAISEDINNER = &H4 Private Const BDR_SUNKENOUTER = &H2 Private Const BF_BOTTOM = &H8 Private Const BF_LEFT = &H1 Private Const BF_TOP = &H2 Private Const BF_RIGHT = &H4 Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM) Private Const BDR_RAISEDOUTER = &H1 Private Const BDR_SUNKEN = &HA Private Const BDR_RAISED = &H5 Private Const DT_LEFT = &H0 Private Const DT_CENTER = &H1 Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Сделаем у нашей кнопки несколько стилей бордюра (добавим перечисление этих стилей): Public Enum ButtonStyle None = 0 FlatUp = 1 FlatDown = 2 Standart = 3 End Enum Для того, чтобы пользователь мог выбрать один из этих стилей поправьте тип данных в процедурах Let и Get каждого совойства Style...: Public Property Get StyleUp() As ButtonStyle StyleUp = m_StyleUp End Property Public Property Let StyleUp(ByVal New_StyleUp As ButtonStyle) m_StyleUp = New_StyleUp PropertyChanged "StyleUp" RenderUP End Propert Для отрисовки кнопки нам необходимы процедуры для каждого состояния кнопки, рассмотрим одну из них: Private Sub RenderUP() 'рисуем кнопку в нормальном состоянии If Enabled = False Then RenderDisabled: Exit Sub 'на всякий случай, если элемент ActiveX дезактивирован, то выходим от сюда на ... :) Dim RT As RECT, y As Long 'объявляем структуру для отрисовки бордюра и текста. Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF 'очищаем элмент, закрашивая его цветом поверхности самого элмента. Используем Line вместо Cls, чтобы избежать мерцания If picUP.Picture = Empty Then 'рисуем кнопку, если картинка для нормального состояния не указана. RT.Left = 0 RT.Right = (ScaleWidth 15) RT.Top = (ScaleHeight 30) - TextHeight(Caption) 30 'центрируем положения текста RT.Bottom = (ScaleHeight 15) DrawText hdc, Caption & vbNullString, Len(Caption), RT, DT_CENTER 'рисуем текст Else 'а если у нас картинка установлена... y = (ScaleHeight 30) - (picUP.ScaleHeight 30) 'это значение необходимо, чтобы нарисовать картинку центрально по вертикали RT.Left = 4 + (picUP.ScaleWidth 15) 'смещаем текст от картинки RT.Right = (ScaleWidth 15) RT.Top = (ScaleHeight 30) - TextHeight(Caption) 30 RT.Bottom = (ScaleHeight 15) DrawText hdc, Caption & vbNullString, Len(Caption), RT, DT_CENTER DrawPicture picUP, hdc, 4, y 'для отрисовки картинки я создал специальный модуль с этой функцией (посмотрите в исходнике). End If RT.Top = 0 RT.Left = 0 RT.Right = (ScaleWidth 15) RT.Bottom = (ScaleHeight 15) Select Case m_StyleUp 'здесь всё просто - рисуем рамку в зависимости значения свойства StyleUp Case FlatUp DrawEdge hdc, RT, BDR_RAISEDINNER, BF_RECT Case FlatDown DrawEdge hdc, RT, BDR_SUNKENOUTER, BF_RECT Case Standart DrawEdge hdc, RT, BDR_RAISED, BF_RECT End Select End Sub Вызывать процедуры отрисовки мы будем в мышиных событиях (также в событиях UserControl_Resize и UserControl_Show): Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) RaiseEvent MouseMove(Button, Shift, x, y) 'генерируем событие для владельца нашей кнопки If GetCapture <> hwnd Then SetCapture (hwnd) 'переводим мышиные события на наш элемент If Button <> vbLeftButton Then If x > 0 And x < ScaleWidth And y > 0 And y < ScaleHeight Then RenderMove 'отрисовываемся, если курсор находится над кнопкой Else ReleaseCapture 'если курсор не над кнопкой, освобождаем мышь и рисуем её нормальное состояние RenderUP End If Else If x > 0 And x < ScaleWidth And y > 0 And y < ScaleHeight Then 'а если ещё и нажата кнопка... RenderDown Else RenderUP End If End If End Sub Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) RaiseEvent MouseDown(Button, Shift, x, y) If Button = vbLeftButton Then RenderDown Else End If End Sub Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton And x > 0 And x < ScaleWidth And y > 0 And y < ScaleHeight Then RaiseEvent MouseUp(Button, Shift, x, y) End If RenderUP End Sub В событиях MouseDown и MouseUp думаю, что нет ничего сложного и их не надо объяснять. Процедуры отрисовки кнопки в других состояних аналогичны процедуре RenderUp, за исключением некоторых особенностей. В этой статье я рассмотрел основу работы нашей кнопки. Скачайте функциональный исходник крутой кнопки, думаю, что трудности не возникнут. Скачать "Cool Button" |