Наверное, каждый встречался с такой ситуацией: создана форма, расположены на ней контролы, написан основной код. И вдруг необходимо какое-то небольшое дополнение. Причем, это дополнение вполне могло бы быть одним из свойств расположенных на форме контролов. Однако, как показывает ситуация, в 99% случаев такого свойства контрол не содержит. Все гораздо проще, если данный ActiveX Control писали вы сами и у вас сохранились исходники. Вы просто добавляете новые свойства, методы или события и заново компилируете его. Совсем не ординарная ситуация получается если вы хотите добавить, допустим, какое-то новое свойство к стандартному элементу управления. Исходных кодов у вас, естественно, нет и тогда встает вопрос: "Как быть в данной ситуации?" То ли отказаться от задуманного нововведения, то ли самому написать ActiveX Control, то ли написать код для обработки данной ситуации.
Однако Visual Basic, оказывается, предусмотрел выход из данной ситуации. И этот выход WithEvents. Давайте на примере обычного Label добавим к нему новое свойство.
Пусть это будет открытие броузера или почтовой программы при выполнении события Click.
Разобравшись, как это делается, вы не будете испытывать неудобства в ситуациях, описанных выше.
Шаг 1. Создадим новый проект Standard EXE.
Name=WithEventsSample
Изменим имя формы на frmMain.
Расположим на ней 4 Label. Их свойства указаны в следующей таблице:
| Name | Caption | ForeColor | Font.Underline |
| lblInfo1 | Посетите сайт: | &H80000012& | False |
| lblHomePage | http:\\www.mik.h1.ru | &H00800000& | True |
| lblInfo2 | Связаться с автором | &H80000012& | False |
| lblEMail | miceskin@usa.net | &H00800000& | True |
NB! Адреса сайта и электронной почты указаны здесь как образец, в своих программах вы можете использовать любые другие корректные адреса.
Шаг 2. Добавим к проекту модуль класса.
Name=clsNewProperty
В разделе деклараций объявим API –функцию ShellExecute и константу для нее SW_NORMAL. Данная функция послужит нам для открытия броузера или почтовой программы. Сделаем объявление WithEvents:
Private WithEvents NewLabel As Label
Теперь, если мы нажмем в коде класса выпадающее меню с перечнем контролов, то увидим появившуюся там новую строку NewLabel. Если мы его выберем, то появится объявление его события по умолчанию. Так как у Label основным событием является Click, то и у NewLabel, основанном на нем, событием по умолчанию будет являться также Click. Пока оставим его в покое.
Создадим свойство для связи Label, расположенного на форме, с нашим классом
Public Property Set LabelControl(ExternalLabel As Label)
Set NewLabel = ExternalLabel
End Property
Шаг 3. Добавим еще одно свойство, определяющее выполняемое действие: открытие броузера, открытие программы или ничего не делать.
NB! В данных ситуациях предпочтительно (хотя и необязательно) предусматривать НЕ обработку ситуации, чтобы остальных идентичных контролов не коснулись наши изменения.
Создадим нумерованную константу в разделе деклараций, там же объявим внутреннюю переменную для этого свойства
Public Enum constTypeMsg
None = 0
HomePage = 1
EMail = 2
End Enum
Private mvarTypeMsg As constTypeMsg
Теперь напишем само свойство.
NB! Само свойство можно создать с помощью Class Builder Utility.
Public Property Let TypeMsg(ByVal vData As constTypeMsg)
mvarTypeMsg = vData
End Property
Public Property Get TypeMsg() As constTypeMsg
TypeMsg = mvarTypeMsg
End Property
Шаг 3а. Сейчас нам необходимо сделать обработку события Click для NewLabel. Опираться мы будем на состояние свойства TypeMsg. Для состояния None мы не будем описывать никаких изменений. Состояние HomePage вызывает через функцию ShellExecute открытие броузера, а состояние Email – открытие почтовой программы по умолчанию.
Private Sub NewLabel_Click()
Select Case mvarTypeMsg
Case None
Case HomePage
Dim X
X = ShellExecute(0&, "Open", NewLabel.Caption, _
&O0,
&O0, SW_NORMAL)
Case EMail
Call ShellExecute(0&, "Open", "mailto:" +
NewLabel.Caption + _
"?Subject="
+ "About WithEventsSamples", "", "", SW_NORMAL)
End Select
End Sub
Шаг 3b. Изменим состояние курсора при попадании его на адрес, учитывая состояние свойства TypeMsg. Для этого вначале скопируем в свою папку курсор "указывающего пальца". Загрузку данного курсора можно производить через метод LoadPicture (как в нашем примере), либо использовать для этого файл ресурсов.
Private Sub NewLabel_MouseMove(Button As
Integer, Shift As Integer, _
X As Single, Y As
Single)
Select Case mvarTypeMsg
Case None
'NewLabel.MousePointer = vbDefault
Case HomePage
NewLabel.MouseIcon = LoadPicture(App.Path & "/H_POINT.CUR")
NewLabel.MousePointer = vbCustom
Case EMail
NewLabel.MouseIcon = LoadPicture(App.Path & "/H_POINT.CUR")
NewLabel.MousePointer = vbCustom
End Select
End Sub
Вот, собственно говоря, и все, что необходимо сделать в классе.
Шаг 4. Перейдем в форму. В разделе деклараций объявим новый класс как класс clsNewProperty для каждого из Label.
NB! Для тех контролов, у которых мы НЕ хотим иметь дополнительно созданные нами свойства, мы класс НЕ объявляем.
В событии Form_Load инициализируем каждый класс, выполняем привязку контрола к этому классу через событие LabelControl и для соответствующих контролов выполняем событие TypeMsg.
Private Sub Form_Load()
Set clsLabelHomePage = New clsNewProperty
Set clsLabelHomePage.LabelControl = lblHomePage
clsLabelHomePage.TypeMsg = HomePage
Set clsLabelEMail = New clsNewProperty
Set clsLabelEMail.LabelControl = lblEMail
clsLabelEMail.TypeMsg = EMail
Set clsLabelInfo1 = New clsNewProperty
Set clsLabelInfo1.LabelControl = lblInfo1
clsLabelInfo1.TypeMsg = None
Set clsLabelInfo2 = New clsNewProperty
Set clsLabelInfo2.LabelControl = lblInfo2
clsLabelInfo2.TypeMsg = None
End Sub
Запустите проект на исполнение и проверьте полученный результат. Надеюсь, теперь с недостатком свойств у стандартных контролов проблем у вас не возникнет.
2001 г.