Свойства класса: имя, отчество, фамилию,
|
Option Explicit 'Класс Личность ' Свойства класса: имя, отчество, фамилию, дату рождения 'закроем от прямого доступа, 'получить и изменить их можно только через методы класса Private Имя As String Private Отчество As String Private Фамилия As String Private ДатаРождения As Date Public Sub InitPerson(ByVal FN As String, ByVal LN As String, _ ByVal DoB As Date) 'Инициализация личности Имя = FN Фамилия = LN ДатаРождения = DoB End Sub Public Sub PrintPerson() 'Печать в отладочном окне Immediate Dim S As String If WhoIs Then S = "родилась" Else S = "родился" Debug.Print Имя, Отчество, Фамилия, S, ДатаРождения End Sub Public Sub CopyPerson(You As Личность) Имя = You.ВашеИмя Фамилия = You.ВашаФамилия ДатаРождения = You.ВашаДатаРождения End Sub Public Function WhoIs() As Boolean 'Пытается определить пол личности, анализируя имя и фамилию 'Возвращает True, если думает, что имеет дело с женщиной. Dim F1 As Boolean, F2 As Boolean F1 = ПоследняяБуква(Имя) = "А" Or ПоследняяБуква(Имя) = "Я" F2 = ПоследняяБуква(Фамилия) = "А" Or ПоследняяБуква(Фамилия) = "Я" If F1 And F2 Then 'можно полагать, что наша Личность - женщина WhoIs = True ElseIf Not F1 And Not F2 Then WhoIs = False Else 'Есть сомнения If Отчество = "" Then Отчество = InputBox(Имя & " " & Фамилия _ & "! " & "Назовите отчество, пожалуйста.") End If WhoIs = ПоследняяБуква(Отчество) = "А" End If End Function Public Sub SayWhoIs() ' Вывод сообщения о поле и возрасте личности If WhoIs Then MsgBox ("Думаю," & Имя & _ ", Вы из прекрасной половины человечества!") ElseIf Year(ДатаРождения) > 1967 Then MsgBox ("Думаю, " & Имя & ", Вы - молодой человек!") Else MsgBox ("Думаю, " & Фамилия & ", - мужчина!") End If End Sub Private Function ПоследняяБуква(ByVal W As String) As String 'Внутренняя функция: возвращает в верхнем регистре 'последнюю букву слова W ПоследняяБуква = UCase(Right(W, 1)) End Function Public Property Get ВашеИмя() As String ВашеИмя = Имя End Property Public Property Let ВашеИмя(ByVal vNewValue As String) Имя = vNewValue End Property Public Property Get ВашеОтчество() As String ВашеОтчество = Отчество End Property Public Property Let ВашеОтчество(ByVal vNewValue As String) Отчество = vNewValue End Property Public Property Get ВашаФамилия() As String ВашаФамилия = Фамилия End Property Public Property Let ВашаФамилия(ByVal NewValue As String) Фамилия = NewValue End Property Public Property Get ВашаДатаРождения() As Date ВашаДатаРождения = ДатаРождения End Property Public Property Let ВашаДатаРождения(ByVal NewValue As Date) ДатаРождения = NewValue End Property Private Sub Class_Initialize() Имя = "Адам" Фамилия = "Человек" ДатаРождения = #1/1/100# End Sub |
| Пример 4.1. |
| Закрыть окно |
|
' Конструкторы класса Rational Private Sub Class_Initialize() 'Конструктор по умолчанию 'инициализирует рациональное число дробью 1/1 m = 1 n = 1 End Sub Public Sub CreateRational(ByVal a As Integer, ByVal b As Integer) 'Собственный конструктор 'Выполняет довольно сложные действия, 'прежде чем свойства получат значения Dim d As Integer 'Наибольший общий делитель a и b If b = 0 Then MsgBox " Ошибка при создании рационального числа!" _ & Chr(13) & "Знаменатель не должен равняться 0." Else ' приведение знака If b < 0 Then b = -b: a = -a End If ' приведение к несократимой дроби d = nod(a, b) ' d - НОД(a,b) m = a \ d n = b \ d End If End Sub ' Скрытая функция вычисления НОД(m,n) Private Function nod(ByVal m As Integer, ByVal n As Integer) As Integer Dim p As Integer m = Abs(m): n = Abs(n) If n > m Then p = m: m = n: n = p End If Do p = m Mod n: m = n: n = p Loop Until n = 0 nod = m End Function |
| Пример 4.2. |
| Закрыть окно |
|
'Класс Plan ' Свойство класса Private CurMonth As Integer 'Закрытый массив, играющий служебную роль Private Месяцы(1 To 12) As String Private Sub Class_Initialize() CurMonth = Month(Now) Месяцы(1) = "Январь": Месяцы(2) = "Февраль": Месяцы(3) = "Март" Месяцы(4) = "Апрель": Месяцы(5) = "Май": Месяцы(6) = "Июнь" Месяцы(7) = "Июль": Месяцы(8) = "Август": Месяцы(9) = "Сентябрь" Месяцы(10) = "Октябрь": Месяцы(11) = "Ноябрь": Месяцы(12) = "Декабрь" End Sub Public Property Get ТекущийМесяц() As String ТекущийМесяц = Месяцы(CurMonth) End Property Public Property Let ТекущийМесяц(ByVal NewValue As String) Dim i As Byte i = 1 Do While i <= 12 If Месяцы(i) = NewValue Then CurMonth = i Exit Do End If i = i + 1 Loop If i = 13 Then 'Неверно задан месяц CurMonth = Month(Now) End If End Property |
| Пример 4.3. |
| Закрыть окно |
|
' Класс Группа Личностей Const РазмерГруппы As Byte = 25 'Свойства Private Group(1 To РазмерГруппы) As Личность 'Процедуры-свойства Public Property Get ЧленГруппы(num As Byte) As Личность 'Если номер корректен If (num >= 1) And (num <= РазмерГруппы) Then 'Если существует в группе личность с таким номером If Not (Group(num) Is Nothing) Then Set ЧленГруппы = Group(num) Else: MsgBox ("В группе нет человека с номером " & num) End If Else: MsgBox ("Некорректно задан номер в группе - " & num) End If End Property Public Property Set ЧленГруппы(num As Byte, NewValue As Личность) 'Если номер корректен If (num >= 1) And (num <= РазмерГруппы) Then 'Если в группе нет личности с таким номером, то она создается If Group(num) Is Nothing Then Set Group(num) = NewValue Else: MsgBox ("В группе уже есть человек с номером " & num) End If Else: MsgBox ("Некорректно задан номер в группе - " & num) End If End Property Public Sub Сведения() Dim i As Byte For i = 1 To РазмерГруппы If Not (Group(i) Is Nothing) Then Group(i).PrintPerson End If Next i End Sub |
| Пример 4.4. |
| Закрыть окно |
|
Public Function Plus( a As Rational) As Rational Dim d As Integer, u As Integer, v As Integer Dim R As New Rational u = m * a.Знаменатель + n * a.Числитель v = n * a.Знаменатель d = nod(u, v) R.Числитель = u \ d R.Знаменатель = v \ d Set Plus = R End Function Public Function Minus(a As Rational) As Rational Dim d As Integer, u As Integer, v As Integer Dim R As New Rational u = m * a.Знаменатель - n * a.Числитель v = n * a.Знаменатель d = nod(u, v) R.Числитель = u \ d R.Знаменатель = v \ d Set Minus = R End Function Public Function Mult(a As Rational) As Rational Dim d As Integer, u As Integer, v As Integer Dim R As New Rational u = m * a.Числитель v = n * a.Знаменатель d = nod(u, v) R.Числитель = u \ d R.Знаменатель = v \ d Set Mult = R End Function Public Function Divide(a As Rational) As Rational Dim d As Integer, u As Integer, v As Integer Dim R As New Rational u = m * a.Знаменатель v = n * a.Числитель If v = 0 Then MsgBox ("деление на нуль невозможно") Else d = nod(u, v) R.Числитель = u \ d R.Знаменатель = v \ d Set Divide = R End If End Function Public Sub PrintRational() Debug.Print (m & "/" & n) End Sub |
| Пример 4.5. |
| Закрыть окно |
|
Option Explicit Private WithEvents myFriendOne As Личность Private WithEvents myFriendTwo As Личность Private Sub myFriendOne_ДеньРождения(Dat As Date) BirthDay (Dat) End Sub Private Sub myFriendOne_ИзменениеФамилии(Fam As String, _ NewFam As String, Permission As Boolean) MsgBox ("Изменение фамилии " & Fam & " на " & NewFam & Chr(13) _ & "не разрешается.") Permission = False End Sub Private Sub myFriendTwo_ДеньРождения(Dat As Date) BirthDay (Dat) End Sub Private Sub myFriendTwo_ИзменениеФамилии(Fam As String, _ NewFam As String, Permission As Boolean) MsgBox ("Поздравляю с замужеством, дорогая " & _ Fam & "-" & NewFam & "!") Permission = True End Sub Public Sub BirthDay(Dat As Date) Debug.Print Dat, "-", Now Select Case Day(Dat) Case Day(Now) MsgBox ("Сегодня День Рождения!") Case Is < Day(Now) MsgBox ("Вчера был День Рождения!") Case Else MsgBox ("Завтра День Рождения!") End Select End Sub Public Sub Connect() Set myFriendOne = FriendOne Set myFriendTwo = FriendTwo End Sub |
| Пример 4.6. |
| Закрыть окно |
|
Option Explicit ' Модуль Примеры Public FriendOne As New Личность Public FriendTwo As New Личность Public FOne As New Личности Public Sub Знакомство() 'Вызывается конструктор с параметрами 'и происходит знакомство с объектами FriendOne.InitPerson FN:="Станислав", LN:="Федотов", _ DOB:="21.05.39" FriendTwo.InitPerson FN:="Катя", LN:="Павлова", _ DOB:="22.03.79" FriendOne.PrintPerson FriendTwo.PrintPerson FriendOne.SayWhoIs FriendTwo.SayWhoIs 'Связывание с двойниками. 'Теперь объекты могут реагировать на события! FOne.Connect End Sub Public Sub CallEvents() Dim DOB As Date 'Вызов методов приведет к возникновению событий! 'При замене фамилии возникнет событие ИзменениеФамилии 'Заметьте, не всегда фамилия будет изменена! FriendOne.ВашаФамилия = "Фидотов" FriendTwo.ВашаФамилия = "Волконская" 'При попытке узнать дату рождения 'может быть вызван обработчик события ДеньРождения. DOB = FriendOne.ВашаДатаРождения DOB = FriendTwo.ВашаДатаРождения FriendOne.PrintPerson FriendTwo.PrintPerson End Sub |
| Пример 4.7. |
| Закрыть окно |
