Трансформация на функционалност на класа на обвивката

Въведение.

Миналата седмица създадохме нов клас Wrapper ClsTiles, използвайки класа ClsArea два пъти в новия модул Class, един екземпляр за Floor стойности на размерите и вторият екземпляр за Плочка за под измерение, за да изчислите броя на плочките за стаята.

В новия модул Wrapper Class, ние ще трансформираме Volume Class (ClsVolume2) в Sales (ClsSales) Class. С някои козметични промени ще му направим тотален фейслифтинг в класа Wrapper, като скрием истинската му идентичност като клас за изчисляване на обема и ще го използваме за изчисляване на продажната цена на продуктите с отстъпка.

Точно така, нашият клас ClsVolume2 има всички необходими свойства за въвеждане на необходимите стойности на данни за продажбите като описание, количество, единична цена и процент на отстъпка, които ще влязат в свойствата на обемния клас съответно strDesc, dblLength, dblWidth, dblHeight.

Не бива да забравяме, че класът ClsVolume2 е производен клас , създаден с помощта на ClsArea като основен клас.

Класът ClsVolume2 е посетен повторно.

Но първо, кодът на VBA на модула за клас ClsVolume2 (базовият клас за нашия нов модул ClsSales Class) е възпроизведен по-долу за справка:

Option Compare Database
Option Explicit

Private p_Height As Double
Private p_Area As ClsArea

Public Property Get dblHeight() As Double
    dblHeight = p_Height
End Property

Public Property Let dblHeight(ByVal dblNewValue As Double)
    p_Height = dblNewValue
End Property

Public Function Volume() As Double
    Volume = CArea.dblLength * CArea.dblWidth * Me.dblHeight
End Function

Public Property Get CArea() As ClsArea
   Set CArea = p_Area
End Property

Public Property Set CArea(ByRef AreaValue As ClsArea)
  Set p_Area = AreaValue
End Property

Private Sub Class_Initialize()
Set p_Area = New ClsArea
End Sub

Private Sub Class_Terminate()
Set p_Area = Nothing
End Sub

Единственият проблем, който ни пречи да използваме клас ClsVolume2 директно за Продажби Въвеждането на данни е, че имената на процедурата за свойства dblLength, dblWidth, dblHeight не съвпадат със стойностите на свойството Sales Quantity, UnitPrice, Discount Percentage. Числовите типове данни на ClsVolume2 Class са числа с двойна точност и са подходящи за нашия клас продажби и могат да се използват без промяна на типа данни. Имената на публичните функции Area() и Volume() също не са подходящи, но тяхната формула за изчисления може да се използва за изчисления на продажбите без промяна.

a) Площ =dblLength * dblWidth е подходящ за TotalPrice =Quantity * UnitPrice

б) Обем =Площ * dblHeight е подходящ за DiscountAmount =TotalPrice * DiscountPercentage

Тук имаме два варианта да използваме класа ClsVolume2 като клас ClsSales.

Най-лесният начин е да направите копие на класа ClsVolume2 и да го запишете в нов модул на класа с името ClsSales. Направете подходящи промени в имената на процедурата за собственост и публичните функции, подходящи за стойности на продажбите и изчисления. Добавете още функции, ако е необходимо, в новия модул за клас.
Създайте клас Wrapper, използвайки ClsVolume2 като основен клас и създайте подходящи процедури за свойства и промени в имената на публичните функции, маскирайки процедурите за свойства и имената на функциите на основния клас. Създайте нови функции в класа Wrapper, ако е необходимо.

Първият вариант е донякъде прав и лесен за изпълнение. Но ще изберем втората опция, за да научим как да адресираме свойствата на основния клас в новия клас на обвивка и как да маскираме оригиналните му имена на свойства с нови.

Трансформираният клас ClsVolume2.

Отворете вашата база данни и покажете прозореца за редактиране на VBA (Alt+F11).
Изберете Модул за клас от Вмъкване Меню, за да вмъкнете нов модул за клас.
Променете стойността на свойството Name на модула Class от Class1 на ClsSales .

Копирайте и поставете следния VBA код в модула и запазете кода:

Option Compare Database
Option Explicit

Private m_Sales As ClsVolume2

Private Sub Class_Initialize()
    'instantiate the Base Class in Memory
    Set m_Sales = New ClsVolume2
End Sub

Private Sub Class_Terminate()
    'Clear the Base Class from Memory
    Set m_Sales = Nothing
End Sub

Public Property Get Description() As String
  Description = m_Sales.CArea.strDesc 'Get from Base Class
End Property

Public Property Let Description(ByVal strValue As String)
  m_Sales.CArea.strDesc = strValue ' Assign to Base Class
End Property

Public Property Get Quantity() As Double
Quantity = m_Sales.CArea.dblLength
End Property

Public Property Let Quantity(ByVal dblValue As Double)
   If dblValue > 0 Then
     m_Sales.CArea.dblLength = dblValue ' Assign to clsArea, Base Class of ClsVolume2
   Else
     MsgBox "Quantity: " & dblValue & " Invalid.", vbExclamation, "ClsSales"
     Do While m_Sales.CArea.dblLength <= 0
          m_Sales.CArea.dblLength = InputBox("Quantity:, Valid Value >0")
     Loop
   End If
End Property

Public Property Get UnitPrice() As Double
   UnitPrice = m_Sales.CArea.dblWidth
End Property

Public Property Let UnitPrice(ByVal dblValue As Double)
   If dblValue > 0 Then
      m_Sales.CArea.dblWidth = dblValue ' Assign to clsArea, Base Class of ClsVolume2
   Else
     MsgBox "UnitPrice: " & dblValue & " Invalid.", vbExclamation, "ClsSales"
       Do While m_Sales.CArea.dblWidth <= 0
          m_Sales.CArea.dblWidth = InputBox("UnitPrice:, Valid Value >0")
       Loop
   End If
End Property

Public Property Get DiscountPercent() As Double
   DiscountPercent = m_Sales.dblHeight
End Property

Public Property Let DiscountPercent(ByVal dblValue As Double)
' Assign to Class .dblHeight of ClsVolume2
Select Case dblValue
    Case Is <= 0
       MsgBox "Discount % -ve Value" & dblValue & " Invalid!", vbExclamation, "ClsSales"
       Do While m_Sales.dblHeight <= 0
          m_Sales.dblHeight = InputBox("Discount %, Valid Value >0")
       Loop
    Case Is >= 1
       m_Sales.dblHeight = dblValue / 100
    Case 0.01 To 0.75
       m_Sales.dblHeight = dblValue
End Select
End Property

Public Function TotalPrice() As Double
Dim Q As Double, U As Double
Q = m_Sales.CArea.dblLength
U = m_Sales.CArea.dblWidth
If (Q * U) = 0 Then
   MsgBox "Quantity / UnitPrice Value(s) 0", vbExclamation, "ClsVolume"
Else
   TotalPrice = m_Sales.CArea.Area 'Get from Base Class ClsArea
End If
End Function

Public Function DiscountAmount() As Double
   DiscountAmount = TotalPrice * DiscountPercent
End Function

Public Function PriceAfterDiscount()
   PriceAfterDiscount = TotalPrice - DiscountAmount
End Function

Какво направихме в класа Wrapper? Създаде екземпляр на класа ClsVolume2 и промени неговите имена на свойства, имена на функции и добавени проверки за валидиране с подходящи съобщения за грешки и предотвратено попадане в проверката за валидиране на основния клас с неподходящи съобщения за грешка, като 'Стойност в dblLength свойството е невалидно" може да изскача от класа Volume.

Проверете редовете, които съм маркирал в горния код и се надявам, че ще можете да разберете как стойностите на свойствата се присвояват/извличат към/от базовия клас ClsVolume2.

Можете да преминете първо през модула за клас ClsArea и до модула за клас ClsVolume2 – извлечения клас, използващ клас ClsArea като основен клас. След като преминете през двата кода, можете да погледнете отново кода в този клас на обвивка.

Тестова програма за клас ClsSales в стандартен модул.

Нека напишем тестова програма, за да изпробваме класа Wrapper.

Копирайте и поставете следния VBA код в стандартен модул.

Public Sub SalesTest()
Dim S As ClsSales

Set S = New ClsSales

S.Description = "Micro Drive"
S.Quantity = 12
S.UnitPrice = 25
S.DiscountPercent = 0.07

Debug.Print "Desccription", "Quantity", "UnitPrice", "Total Price", "Disc. Amt", "To Pay"
With S
    Debug.Print .Description, .Quantity, .UnitPrice, .TotalPrice, .DiscountAmount, .PriceAfterDiscount
End With
End Sub

Изпълнете кода.

Дръжте прозореца за отстраняване на грешки отворен (Ctrl+G).
Щракнете някъде в средата на кода и натиснете F5 клавиша за изпълнение на кода и за отпечатване на изхода в прозореца за отстраняване на грешки.
Можете да тествате кода допълнително, като въведете някоя от входните стойности с отрицателно число и стартирате кода, за да задействате новото съобщение за грешка. Деактивирайте всеки от входните редове със символ за коментар ('), стартирайте кода и вижте какво ще се случи.

Изчислете цена/отстъпка за набор от продукти.

Следният тестов код създава масив от три продукти и стойности на продажбите чрез въвеждане директно от клавиатурата.

Копирайте и поставете следния код в стандартен модул и стартирайте, за да тествате допълнително класа Wrapper.

Public Sub SalesTest2()

Dim S() As ClsSales
Dim tmp As ClsSales
Dim j As Long

For j = 1 To 3
Set tmp = New ClsSales
   tmp.Description = InputBox(j & ") Description")
   tmp.Quantity = InputBox(j & ") Quantity")
   tmp.UnitPrice = InputBox(j & ") UnitPrice")
   tmp.DiscountPercent = InputBox(j & ") Discount Percentage")
 ReDim Preserve S(1 To j) As ClsSales
 Set S(j) = tmp
 Set tmp = Nothing
Next

'Output Section
Debug.Print "Desccription", "Quantity", "UnitPrice", "Total Price", "Disc. Amt", "To Pay"
For j = 1 To 3
   With S(j)
       Debug.Print .Description, .Quantity, .UnitPrice, .TotalPrice, .DiscountAmount, .PriceAfterDiscount
   End With
Next

For j = 1 To 3
  Set S(j) = Nothing
Next

End Sub

След успешно въвеждане на правилни стойности в масива, имената на продуктите и стойностите на продажбите се отпечатват в прозореца за отстраняване на грешки.

МОДУЛИ КЛАСОВЕ.

Модул за MS-Access Class и VBA
Обектни масиви от клас VBA на MS-Access
Основен клас на MS-Access и производни обекти
Базов клас на VBA и производни обекти-2
Варианти на основен клас и производен обект
Ms-Access Recordset and Class Module
Достъп до модул за класове и класове за обвивка
Преобразуване на функционалност на класа на обвивката

ОБЕКТ ЗА КОЛЕКЦИЯ.

Основи на Ms-Access и колекция обекти
Модул за клас Ms-Access и обект на колекция
Записи в таблицата в обект и форма на колекция

РЕЧНИК ОБЕКТ.

Основи на обекта на речника
Основи на обекта на речника-2
Сортиране на ключове и елементи в речника
Показване на записи от речник към формуляр
Добавяне на обекти на клас като елементи от речника
Актуализиране на елемент от речника за обект на клас във формуляра