s the Son of his
|
'Класс Son - Наследник класса Father Implements Father Private Property Let Father_MyProperty(ByVal RHS As String) 'Реализация отложена End Property Private Property Get Father_MyProperty() As String 'Реализация отложена End Property Private Sub Father_MyPureMethod() MsgBox ("It's the Son") End Sub Private Sub Father_MyRealMethod() 'Реализация отложена End Sub Public Sub SonNewMethod() MsgBox ("It' s the Son of his Father") End Sub |
| Пример 5.1. |
| Закрыть окно |
|
Option Explicit Implements Father Implements Son Private Property Let Father_MyProperty( ByVal RHS As String) 'Реализация отложена End Property Private Property Get Father_MyProperty() As String 'Реализация отложена End Property Private Sub Father_MyPureMethod() 'Реализация отложена End Sub Private Sub Father_MyRealMethod() 'Реализация отложена MsgBox ("It's the GrandSon") End Sub Private Sub Son_SonNewMethod() 'Реализация отложена End Sub |
| Пример 5.2. |
| Закрыть окно |
|
Public Sub Family() Dim F As New Father, S As New Son, GS As New GrandSon Dim Grand As Father, GrandS As Son Set Grand = F Grand.MyProperty = "Flat" Grand.MyRealMethod Grand.MyPureMethod Debug.Print Grand.MyProperty Set Grand = S Grand.MyProperty = "Flat" Grand.MyRealMethod Grand.MyPureMethod If TypeOf Grand Is Son Then Set GrandS = Grand: GrandS.SonNewMethod End If Debug.Print Grand.MyProperty Set Grand = GS If TypeOf Grand Is GrandSon Then Set GrandS = Grand: GrandS.SonNewMethod End If Grand.MyProperty = "Flat" Grand.MyRealMethod Grand.MyPureMethod Debug.Print Grand.MyProperty End Sub |
| Пример 5.3. |
| Закрыть окно |
|
Option Explicit 'Класс Машина ' Свойства класса Private Марка As String Private ДатаВыпуска As Date Private Цвет As String 'Конструкторы класса Private Sub Class_Initialize() Марка = "Форд" ДатаВыпуска = "20.07.1925" Цвет = "Вишневый" End Sub Public Sub НоваяМашина(M As String, D As Date, C As String) Марка = M ДатаВыпуска = D Цвет = C End Sub 'Методы класса Public Sub PrintDataCar() Debug.Print "Марка = ", Марка Debug.Print "ДатаВыпуска = ", ДатаВыпуска Debug.Print "Цвет = ", Цвет End Sub Public Property Get МаркаМашины() As String МаркаМашины = Марка End Property Public Property Get ЦветМашины() As String ЦветМашины = Цвет End Property Public Property Get ДатаВыпускаМашины() As Date ДатаВыпускаМашины = ДатаВыпуска End Property |
| Пример 5.4. |
| Закрыть окно |
|
Option Explicit 'Класс ВладелецМашины 'Наследует интерфейсы классов Личность и Машина Implements Машина Implements Личность 'Свойства класса Private Сам As Личность Private ЕгоМашина As Машина Private Sub Class_Initialize() Set Сам = New Личность Set ЕгоМашина = New Машина End Sub 'Реализация интерфейсов класса Личность Private Sub Личность_CopyPerson(You As Личность) Сам.CopyPerson (You) End Sub Private Sub Личность_InitPerson(ByVal FN As String, ByVal LN As String, ByVal DoB As Date) 'Инициализация личности Сам.InitPerson FN, LN, DoB End Sub Private Sub Личность_PrintPerson() 'Печать в отладочном окне Immediate Сам.PrintPerson End Sub Private Sub Личность_SayWhoIs() ' Вывод сообщения о поле и возрасте владельца машины Dim StrMsg As String StrMsg = "Думаю, Владелец машины марки: " & _ ЕгоМашина.МаркаМашины & " это - " If Сам.WhoIs Then If Year(Сам.ВашаДатаРождения) > 1967 Then StrMsg = StrMsg & "молодая девушка!" Else: StrMsg = StrMsg & "женщина!" End If Else If Year(Сам.ВашаДатаРождения) > 1967 Then StrMsg = StrMsg & "молодой человек!" Else: StrMsg = StrMsg & "мужчина!" End If End If MsgBox (StrMsg) End Sub Private Function Личность_WhoIs() As Boolean Сам.WhoIs End Function Private Property Let Личность_ВашаДатаРождения(ByVal NewValue As Date) Сам.ВашаДатаРождения = NewValue End Property Private Property Get Личность_ВашаДатаРождения() As Date 'Зажигает событие ДеньРождения 'в зависимости от значения текущей даты Личность_ВашаДатаРождения = Сам.ВашаДатаРождения End Property Private Property Let Личность_ВашаФамилия(ByVal NewValue As String) 'Зажигает событие ИзменениеФамилии Сам.ВашаФамилия = NewValue End Property Private Property Get Личность_ВашаФамилия() As String Личность_ВашаФамилия = Сам.ВашаФамилия End Property Private Property Let Личность_ВашеИмя(ByVal NewValue As String) Сам.ВашеИмя = NewValue End Property Private Property Get Личность_ВашеИмя() As String Личность_ВашеИмя = Сам.ВашеИмя End Property Private Property Let Личность_ВашеОтчество(ByVal NewValue As String) Сам.ВашеОтчество = NewValue End Property Private Property Get Личность_ВашеОтчество() As String Личность_ВашеОтчество = Сам.ВашеОтчество End Property 'Реализация интерфейсов класса Машина Private Property Get Машина_ДатаВыпускаМашины() As Date Машина_ДатаВыпускаМашины = ЕгоМашина.ДатаВыпускаМашины End Property Private Property Get Машина_МаркаМашины() As String Машина_МаркаМашины = ЕгоМашина.МаркаМашины End Property Private Property Get Машина_ЦветМашины() As String Машина_ЦветМашины = ЕгоМашина.ЦветМашины End Property Private Sub Машина_PrintDataCar() ЕгоМашина.PrintDataCar End Sub Private Sub Машина_НоваяМашина(M As String, D As Date, C As String) ЕгоМашина.НоваяМашина M, D, C End Sub 'Собственный интерфейс класса ВладелецМашины 'Public методы - интерфейс Владельца машины Public Sub InitCarOwner(FN As String, LN As String, DoB As Date, _ Marka As String, DB As Date, Color As String) 'Инициализация данных о хозяине и его машине Личность_InitPerson FN, LN, DoB Машина_НоваяМашина Marka, DB, Color End Sub Public Sub ConnectOwnerAndCar(pers As Личность, car As Машина) 'соединяет данные о хозяине и его новой машине Сам.CopyPerson pers Машина_НоваяМашина car.МаркаМашины, car.ДатаВыпускаМашины, _ car.ЦветМашины End Sub Public Sub PrintOwnerData() Личность_PrintPerson Debug.Print " владеет машиной: " Машина_PrintDataCar End Sub |
| Пример 5.5. |
| Закрыть окно |
|
Option Explicit ' Модуль Примеры Public FriendOne As New Личность Public FriendTwo As New Личность Public FriendThree As New Личность Public carOne As New Машина Public carTwo As New Машина Public carThree As New Машина Public OwnerOne As New ВладелецМашины Public OwnerTwo As New ВладелецМашины Public OwnerThree As New ВладелецМашины Public FOne As New Личности Public Sub Люди() 'Вызывается конструктор с параметрами 'и происходит знакомство с объектами FriendOne.InitPerson FN:="Станислав", LN:="Федотов", _ DoB:="21.05.39" FriendTwo.InitPerson FN:="Катя", LN:="Павлова", _ DoB:="22.03.79" FriendThree.InitPerson FN:="Остап", LN:="Бендер", DoB:="23.07.1910" FriendOne.PrintPerson FriendTwo.PrintPerson FriendOne.SayWhoIs FriendTwo.SayWhoIs 'Связывание с двойниками. 'Теперь объекты могут реагировать на события! FOne.Connect End Sub Public Sub Cars() 'Вызывается конструктор с параметрами carOne.НоваяМашина "Антилопа", "12.12.12", "Неопределенный" carTwo.НоваяМашина "Москвич", "12.11.98", "Морская волна" carThree.НоваяМашина "Jeep", "23.05.97", "Orange" End Sub Public Sub CarOwners() OwnerOne.ConnectOwnerAndCar FriendOne, carTwo OwnerTwo.ConnectOwnerAndCar FriendThree, carOne OwnerThree.InitCarOwner FN:="Юрий", LN:="Вегера", _ DoB:="21.08.34", Marka:="Газ69", DB:="20.01.76", Color:="Зеленый" OwnerOne.PrintOwnerData OwnerTwo.PrintOwnerData OwnerThree.PrintOwnerData End Sub Public Sub CallEvents() Dim DoB As Date 'Вызов методов приведет к возникновению событий! 'При замене фамилии возникнет событие ИзменениеФамилии 'Заметьте, не всегда фамилия будет изменена! FriendOne.ВашаФамилия = "Фидотов" FriendTwo.ВашаФамилия = "Волконская" 'При попытке узнать дату рождения 'может быть вызван обработчик события ДеньРождения. DoB = FriendOne.ВашаДатаРождения Debug.Print DoB DoB = FriendTwo.ВашаДатаРождения Debug.Print DoB FriendOne.PrintPerson FriendTwo.PrintPerson 'События не наследуются Set FriendOne = OwnerTwo 'Нельзя связать теперь объект FriendOne с двойником 'FOne.Connect FriendOne.ВашаФамилия = "Воробьянинов" FriendOne.PrintPerson End Sub Public Sub Группа() Const SizeGroup = 6 Const SizeGarage = 6 Dim i As Byte Dim Group(1 To SizeGroup) As Личность Dim Гараж(1 To SizeGarage) As Машина Set Group(1) = FriendOne Set Group(2) = FriendTwo Set Group(3) = FriendThree Set Group(4) = OwnerOne Set Group(5) = OwnerTwo Set Group(6) = OwnerThree For i = 1 To SizeGroup Group(i).SayWhoIs Next i Set Гараж(1) = carOne Set Гараж(2) = carTwo Set Гараж(3) = carThree Set Гараж(4) = OwnerOne Set Гараж(5) = OwnerTwo Set Гараж(6) = OwnerThree For i = 1 To SizeGarage Гараж(i).PrintDataCar Next i End Sub Public Sub ЛюдиИМашины() Люди Cars CarOwners Группа PolyMorf FriendTwo PolyMorf OwnerTwo End Sub Public Sub PolyMorf(One As Личность) One.SayWhoIs End Sub |
| Пример 5.6. |
| Закрыть окно |
| Станислав Федотов родился 21.05.39 Катя Павлова родилась 22.03.79 Станислав Федотов родился 21.05.39 владеет машиной: Марка = Москвич ДатаВыпуска = 12.11.98 Цвет = Морская волна Остап Бендер родился 23.07.1910 владеет машиной: Марка = Антилопа ДатаВыпуска = 12.12.12 Цвет = Неопределенный Юрий Алексеевич Вегера родился 21.08.34 владеет машиной: Марка = Газ69 ДатаВыпуска = 20.01.76 Цвет = Зеленый Марка = Антилопа ДатаВыпуска = 12.12.12 Цвет = Неопределенный Марка = Москвич ДатаВыпуска = 12.11.98 Цвет = Морская волна Марка = Jeep ДатаВыпуска = 23.05.97 Цвет = Orange Марка = Москвич ДатаВыпуска = 12.11.98 Цвет = Морская волна Марка = Антилопа ДатаВыпуска = 12.12.12 Цвет = Неопределенный Марка = Газ69 ДатаВыпуска = 20.01.76 Цвет = Зеленый |
| Пример 5.7. |
| Закрыть окно |
| Sub TestOfCollection() 'Так объявляются объекты (переменные) типа Collection Dim MyCollection As New Collection 'Объявление обычных локальных переменных Dim i As Integer Dim N As Long 'Оператор With позволяет избежать многократного указания имени объекта With MyCollection N =.Count Debug.Print" Число элементов пустой коллекции =", N ' Добавление элементов в конец списка. 'Элементы имеют индексы, но не имеют ключа. .Add (2) .Add (4) .Add (6) 'Добавление нечетных элементов на свои места. 'Заметьте, как указывается позиция 'добавления c использованием параметров - before и after ' Добавляемые элементы имеют строковый тип и обладают ключом .Add" один"," first", 1 ' before (перед первым элементом) .Add" три"," third",, 2 'after (после второго) .Add" пять"," fifth",, 4 N =.Count Debug.Print" Число элементов после 6-и вызовов метода Add", N Debug.Print" Элементы коллекции:" ' Отладочная печать созданной коллекции из шести элементов. For i = 1 To MyCollection.Count Debug.Print MyCollection(i) Next ' Удаление 4-го и 5-го элементов по заданному индексу и ключу. .Remove 4 .Remove" fifth" N =.Count Debug.Print" Число элементов после двух вызовов метода Remove=", N Debug.Print" Элементы коллекции:" 'И снова печать коллекции, в которой теперь четыре элемента. For i = 1 To MyCollection.Count Debug.Print MyCollection(i) Next End With End Sub |
| Пример 5.8. |
| Закрыть окно |
| Public Sub Collection() 'Создание и работа с коллекцией личностей Dim Личности As New Collection 'Работа с коллекцией, как со списком Dim Адам As New Личность Адам.InitPerson "Адам", "Первый Человек", #1/1/100# Личности.Add Адам Dim Ной As New Личность Ной.InitPerson "Ной", "Праведник", #1/1/100# Личности.Add Ной 'Работа с коллекцией, как с динамическим массивом Dim Шекспир As New Личность Шекспир.InitPerson "Вильям", "Шекспир", #4/23/1564# Личности.Add Item:=Шекспир, After:=2 Dim Гомер As New Личность Гомер.InitPerson "Гомер", "Великий Слепой", #1/1/100# Личности.Add Item:=Гомер, Before:=3 Личности(4).SayWhoIs 'Работа с коллекцией, как со словарем Dim Пушкин As New Личность Пушкин.InitPerson "Александр", "Пушкин", #6/6/1799# Личности.Add Item:=Пушкин, Key:="Гений" Dim Булгаков As New Личность Булгаков.InitPerson "Михаил", "Булгаков", #1/23/1891# Личности.Add Item:=Булгаков, Key:="Мастер" Debug.Print Личности("Гений").ВашаФамилия, " - это Гений!" Debug.Print Личности("Мастер").ВашаФамилия, " - это Мастер!" 'Печать всего списка Dim I As Byte For I = 1 To Личности.Count Личности(I).PrintPerson Next I End Sub |
| Пример 5.9. |
| Закрыть окно |
|
Option Explicit 'Определение класса СписокЛичностей ' Свойства Private First As ЭлементСпискаЛичностей Private Last As ЭлементСпискаЛичностей Public Count As Integer 'Методы Private Sub Class_Initialize() Set First = Nothing Set Last = Nothing Count = 0 End Sub Public Sub AddFirst(F As Личность) Dim Elem As New ЭлементСпискаЛичностей Dim Info As New Личность 'Создаем копию переменной F. В списке будем использовать копию, а не ссылку. Info.CopyPerson F Set Elem.Сам = Info Set Elem.Друг = First If First Is Nothing Then Set Last = Elem End If Set First = Elem Count = Count + 1 End Sub Public Sub PrintList() Dim P As ЭлементСпискаЛичностей Dim Q As Личность Set P = First While Not (P Is Nothing) Set Q = P.Сам Q.PrintPerson Set P = P.Друг Wend End Sub Public Sub AddLast(F As Личность) Dim Elem As New ЭлементСпискаЛичностей Dim Info As New Личность 'Создаем копию переменной F. В списке будем использовать копию, а не ссылку. Info.CopyPerson F Set Elem.Сам = Info Set Elem.Друг = Nothing If First Is Nothing Then Set First = Elem Else Set Last.Друг = Elem End If Set Last = Elem Count = Count + 1 End Sub Public Sub ClearList() 'Попытка освободить память не достигает успеха из-за отсутствия 'соответствующего оператора. Dim P As ЭлементСпискаЛичностей, R As ЭлементСпискаЛичностей Dim Q As Личность Set P = First While Not (P Is Nothing) Set Q = P.Сам 'Unload Q Set R = P Set P = P.Друг 'Unload R Wend 'Обнуление указателей Set First = Nothing Set Last = Nothing Count = 0 End Sub |
| Пример 5.10. |
| Закрыть окно |
|
Option Explicit 'Определение класса КоллекцияЛичностей ' Свойства Private First As ЭлементСпискаЛичностей Private Count As Long 'Обратите внимание: встраиваем коллекцию Private Persons As Collection 'Методы Private Sub Class_Initialize() Set First = Nothing Count = 0 'при создании объекта класса КоллекцияЛичностей создается 'и внутренняя коллекция для хранения его элементов Set Persons = New Collection End Sub Private Sub AddFirst(F As Личность) Dim Elem As New ЭлементСпискаЛичностей Dim Info As New Личность 'Создаем копию переменной F. В списке будем использовать копию, а не ссылку. Info.CopyPerson F Set Elem.Сам = Info Set Elem.Друг = First Set First = Elem Count = Count + 1 End Sub Public Sub PrintList() 'Печать текущего состояния списка Dim i As Long For i = 1 To Persons.Count Persons(i).PrintPerson Next i End Sub Public Sub AddPerson(Item As Личность, Optional key As String = "", _ Optional before As Long = 0, Optional after As Long = 0) Dim P As Личность 'Вначале добавляем элемент в линейный список, 'используя внутренний метод AddFirst AddFirst Item 'Разбор случаев вызова Set P = First.Сам If key <> "" Then Persons.Add P, key ElseIf before <> 0 Then Persons.Add P,, before ElseIf after <> 0 Then Persons.Add P,,, after Else Persons.Add P End If Count = Persons.Count End Sub Public Property Get Количество() As Long Количество = Count End Property Public Sub Remove(key As Variant) Persons.Remove key Count = Persons.Count End Sub Public Function Item(key As Variant) As Личность Set Item = Persons.Item(key) End Function Public Sub PrintHystory() 'Печать всех элементов в порядке, обратном их добавлению в список. 'Печатаются все элементы, независимо от того, были ли они удалены. Dim P As ЭлементСпискаЛичностей Dim Q As Личность Set P = First While Not (P Is Nothing) Set Q = P.Сам Q.PrintPerson Set P = P.Друг Wend End Sub |
| Пример 5.11. |
| Закрыть окно |
|
Public Sub Великие() 'Создание и работа с коллекцией личностей Dim Личности As New КоллекцияЛичностей Dim ЭтоЛичность As Личность 'Работа с коллекцией, как со списком Dim Адам As New Личность Адам.InitPerson "Адам", "Первый Человек", #1/1/100# Личности.AddPerson Адам, "Первый" Dim Ной As New Личность Ной.InitPerson "Ной", "Праведник", #1/1/100# Личности.AddPerson Item:=Ной, after:=1 'Работа с коллекцией, как с динамическим массивом Dim Шекспир As New Личность Шекспир.InitPerson "Вильям", "Шекспир", #4/23/1564# Личности.AddPerson Item:=Шекспир, after:=2 Dim Гомер As New Личность Гомер.InitPerson "Гомер", "Великий Слепой", #1/1/100# Личности.AddPerson Item:=Гомер, before:=3 'Работа с коллекцией, как со словарем Dim Булгаков As New Личность Булгаков.InitPerson "Михаил", "Булгаков", #1/23/1891# Личности.AddPerson Item:=Булгаков, key:="Мастер" Dim Пушкин As New Личность Пушкин.InitPerson "Александр", "Пушкин", #6/6/1799# Личности.AddPerson Item:=Пушкин, key:="Гений" 'Печать всего списка Личности.PrintList Debug.Print Личности.Количество 'Удаление элементов Личности.Remove "Первый" Личности.Remove 2 'Печать после удаления Личности.PrintList Debug.Print Личности.Количество 'Доступ к отдельным элементам по ключу Set ЭтоЛичность = Личности.Item("Гений") ЭтоЛичность.PrintPerson Set ЭтоЛичность = Личности.Item(2) ЭтоЛичность.PrintPerson End Sub |
| Пример 5.12. |
| Закрыть окно |
