Создание ActiveX Control'а с дополнительной формой
На предыдущих уроках было показано создание различных по-сложности ActiveX Control'ов. Однако основной целью было не наращивание сложности от примера к примеру, а показ разнообразных возможностей в создании самих контролов.
Сегодня на примере "простенького" ActiveX Control'a я покажу Вам принцип вывода дополнительных форм.
Появляющаяся подсказка (ToolTipText) при позиционировании курсора на элементе формы имеет один существенный недостаток - вывод всего текста подсказки одной строкой, независимо от ее длины.
Давайте создадим расширенный ToolTip. Назовем проект - ToolTipEx, а UserControl - TTEx. Разместим на контроле Image и вставим в него картинку размерами 24 х 24 или 32 х 32 пиксела. Аналогичную картинку, но 16 х 15 пиксел разместим в свойстве ToolboxBitmap нашего контрола. Установим свойство InvisibleAtRuntime = True.
Добавим новую форму - меню Project/Add Form. Установим свойства новой формы: Name = frmToolTipEx, BackColor = &H00C0FFFF&, BorderStyle = 1 (Fixed Single), Caption[Пусто], ControlBox = False, Icon = [None], StartUpPosition = 0 (Manual), Width = 3000 (Twips). Разместим на форме лейбл: Name = lblTTEx, BackStyle = 0 (Transparent), Caption = "#", Left = 60, Top = 60, Width = 2880 (ширина формы минус 2 х 60 по краям), WordWrap = True, AutoSize = True (именно в таком порядке устанавливаются два последних свойства).
Свойства контрола:
|
Имя |
Описание |
Привязка к форме |
Тип |
Значение по-умолчанию |
|
BackColor |
Цвет фона |
frmToolTipEx. BackColor |
OLE_COLOR |
&HC0FFFF |
|
ForeColor |
Цвет выводимого текста |
frmToolTipEx. lblTTEx.ForeColor |
OLE_COLOR |
&H80000012 |
|
Font |
Шрифт текста |
frmToolTipEx. lblTTEx.Font |
Font |
MS Sans Serif, 8 |
|
Text |
Содержимое надписи |
frmToolTipEx. lblTTEx.Caption |
String |
vbNullString |
Метод:
|
Имя |
Описание |
Принимаемые параметры |
Возвращаемое значение |
|
ShowTTEx |
Вывод на экран подсказки |
Ctrl As Object |
[Пусто] |
NB! В методе принимаемый параметр мы вынуждены объявить как Object, иначе - появление ошибки о невозможности передачи пользовательского типа.
События:
В данном примере мы не будем создавать пользовательские события.
Запишем наши свойства в окно кодов. Честно говоря, в данном случае трудно посоветовать пользоваться ли помощью мастера или нет. Т.к. приходится вносить достаточно много мелких исправлений в полученные шаблоны кодов. Решайте сами. Я покажу как должна выглядеть кодировка на примере одного свойства. Полностью описания свойств, как всегда, в листинге.
Public
Property Get Text() As String
Text =
frmToolTipEx.lblTTEx.Caption
End Property
Public
Property Let Text(ByVal New_Text As String)
frmToolTipEx.lblTTEx.Caption =
New_Text
PropertyChanged "Text"
End Property
Private
Sub UserControl_ReadProperties(PropBag As PropertyBag)
frmToolTipEx.lblTTEx.Caption =
PropBag.ReadProperty("Text",vbNullString)
End Sub
Private
Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Text",
frmToolTipEx.lblTTEx.Caption,vbNullString)
End Sub
Остальные свойства делаются аналогичным образом. Единственное, что мы сейчас сделаем, это вставим проверку на наличие пустой строки в свойство Text.
If
New_Text = vbNullString Then
frmToolTipEx.Hide
Exit Property
End If
Определим какие API-функции мы будем использовать:
Ну а теперь займемся процедурой ShowTTEx.
В разделе Global объявим первые 2 функции, тип RECT и переменные, необходимые внутри программы
Private CaptionHeight As Long 'и
Private PFrm As RECT 'позиция формы, содержащей UserControl
Public Sub ShowTTEx(ctrl As Object)
' Определяем,
относительно
чего мы будем
позиционировать
'и
присвоим ее к
переменной PFrm
GetWindowRect UserControl.Parent.hwnd, PFrm
'определяем
высоту
заголовка
формы (ведь
при разных
разрешениях
экрана - он
разный)
CaptionHeight = (GetSystemMetrics(SM_CYCAPTION) *
Screen.TwipsPerPixelY)
With frmToolTipEx
'позиционируем
нашу форму
.Move PFrm.Left *
Screen.TwipsPerPixelX + ctrl.Left, _
PFrm.Top *
Screen.TwipsPerPixelY + ctrl.Top + ctrl.Height + CaptionHeight
'обращаемся
к процедуре,
изменяющей
высоту
выводимого
сообщения
' (она
находится в
frmToolTipEx)
.FrmResize
'визуализируем
форму
.Show
End With
End Sub
Вернемся к форме frmToolTipEx. В глобальных объявлениях выведем нашу последнюю, третью API-функцию. Создадим процедуру, изменяющую размеры формы:
Public Sub FrmResize()
Me.Height = lblTTEx.Height + 60
End Sub
А в Form_Load сделаем ссылки на них.
Теперь займемся тестированием. Добавим новый проект и разместим на форме наш контрол, ну и допустим кнопку и лейбл.
Добавим коды:
Option Explicit
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With TTEx1
.Text = "А
здесь текст
короче"
.BackColor = vbGreen
.ForeColor = vbRed
With .Font
.Bold = False
.Italic = True
.Name = "Times New Roman Cyr"
.Size = 8
End With
.ShowTTEx Command1
End With
End Sub
Private
Sub Form_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
TTEx1.Text = vbNullString
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With TTEx1
.Text = "Данный
текст
предназначен
для показа
возможностей
нашего ActiveX Control'a"
.BackColor = vbYellow
.ForeColor = vbBlue
With .Font
.Bold = True
.Italic = False
.Name = "Arial Cyr"
.Size = 10
End With
.ShowTTEx Label1
End With
End Sub
У данного контрола есть определенные недостатки - например, для работы ему необходимо постоянное отслеживание события Mouse_Move, что определенно потребляет некоторое количество ресурсов. Воспользовавшись приведенными здесь кодами, Вы можете избежать этого, например, создав свой контрол TextBox с включенным в него событием ToolTipEx (как это делается см. Урок 3).
Данный пример учебный, а никак не 100% законченный контрол. Поэтому напоследок домашнее задание :-)
а) когда вывод текста небольшой и в одну строку - отследите ширину контрола, чтобы не было пустого места справа;
б) когда элемент, к которому выводится подсказка, находится близко к правому краю экрана - отследите позиционирование контрола, чтобы он не прятался за край.
Успехов!
За листингом сюда:
1999
