Úvod.
Minulý týden jsme vytvořili novou třídu Wrapper ClsTiles s použitím třídy ClsArea dvakrát v novém modulu třídy, jedna instance pro Floor hodnoty rozměrů a druhý výskyt pro Podlaha rozměr, pro výpočet počtu dlaždic pro místnost.
V novém modulu Wrapper Class Module transformujeme třídu objemu (ClsVolume2) na třídu Sales (ClsSales). S některými kosmetickými změnami provedeme celkový facelift ve třídě Wrapper, skryjeme její skutečnou identitu jako třída pro výpočet objemu a použijeme ji pro výpočet prodejní ceny produktů se slevou.
Správně, naše třída ClsVolume2 má všechny potřebné vlastnosti pro zadání požadovaných hodnot prodejních dat, jako je popis, množství, jednotková cena a procento slevy, které přejdou do vlastností třídy objemu strDesc, dblLength, dblWidth, dblHeight.
Neměli bychom zapomínat, že třída ClsVolume2 je Odvozená třída , vytvořený pomocí ClsArea jako základní třídy.
Znovu navštívená třída ClsVolume2.
Nejprve je však níže reprodukován kód VBA modulu třídy ClsVolume2 (základní třída pro náš nový modul třídy ClsSales):
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
Jediný problém, který nám brání používat třídu ClsVolume2 přímo pro prodej zadávání dat je, že názvy dblLength, dblWidth, dblHeight se neshodují s hodnotami prodejní vlastnosti Množství, Jednotková cena, Procento slevy. Číselné datové typy třídy ClsVolume2 jsou všechny čísla s dvojitou přesností a jsou vhodné pro naši třídu prodeje a lze je použít bez změny datového typu. Veřejné funkce Area() a Volume() names také nejsou vhodné, ale jejich kalkulační vzorec lze použít pro výpočty prodeje beze změny.
a) Plocha =dblLength * dblWidth je vhodná pro TotalPrice =Množství * UnitPrice
b) Objem =Plocha * Výška dbl je vhodná pro Částka slevy =Celková cena * Procento slevy
Zde máme dvě možnosti, jak použít třídu ClsVolume2 jako třídu ClsSales.
- Nejjednodušším způsobem je vytvořit kopii třídy ClsVolume2 a uložit ji do nového modulu třídy s názvem ClsSales. Proveďte příslušné změny procedury vlastností a veřejných názvů funkcí vhodných pro prodejní hodnoty a výpočty. V případě potřeby přidejte do nového modulu třídy další funkce.
- Vytvořte třídu Wrapper pomocí ClsVolume2 jako základní třídy a vytvořte vhodné procedury vlastností a změny názvů veřejných funkcí, maskující procedury vlastností a názvy funkcí základní třídy. V případě potřeby vytvořte nové funkce ve třídě Wrapper.
První možnost je poněkud přímočará a snadno proveditelná. Vybereme však druhou možnost, abychom se naučili, jak řešit vlastnosti základní třídy v nové obalové třídě a jak maskovat její původní názvy vlastností novými.
Třída Transformed ClsVolume2.
- Otevřete databázi a zobrazte okno pro úpravy VBA (Alt+F11).
- Vyberte Modul třídy z Vložit Nabídka pro vložení nového modulu třídy.
- Změňte hodnotu vlastnosti Name modulu Class z Class1 na ClsSales .
- Zkopírujte a vložte následující kód VBA do modulu a uložte kód:
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
Co jsme dělali ve třídě Wrapper? Vytvořila instanci třídy ClsVolume2 a změnila její názvy vlastností, názvy funkcí a přidala kontroly ověření s příslušnými chybovými zprávami a zabránila vpuštění do kontroly ověření třídy Base s nevhodnými chybovými zprávami, jako je 'Hodnota v dblLength property is invalid' se může objevit z Volume Class.
Zkontrolujte řádky, které jsem zvýraznil ve výše uvedeném kódu, a doufám, že budete schopni zjistit, jak jsou hodnoty vlastností přiřazovány/načítány do/z základní třídy ClsVolume2.
Nejprve můžete projít modul třídy ClsArea a poté modul třídy ClsVolume2 – odvozenou třídu využívající třídu ClsArea jako základní třídu. Poté, co si projdete oba tyto kódy, můžete se znovu podívat na kód v této třídě Wrapper.
Testovací program pro třídu ClsSales ve standardním modulu.
Pojďme napsat testovací program, abychom vyzkoušeli třídu Wrapper.
- Zkopírujte a vložte následující kód VBA do standardního modulu.
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
Spusťte kód.
- Ponechejte okno ladění otevřené (Ctrl+G).
- Klikněte někam doprostřed kódu a stiskněte klávesu F5 klávesu ke spuštění kódu a vytištění výstupu v okně ladění.
- Kód můžete dále otestovat zadáním kterékoli ze vstupních hodnot se záporným číslem a spuštěním kódu pro spuštění nové chybové zprávy. Zakažte libovolný ze vstupních řádků pomocí symbolu komentáře ('), spusťte kód a uvidíte, co se stane.
Vypočítejte cenu/slevu pro řadu produktů.
Následující testovací kód vytvoří pole tří produktů a prodejních hodnot zadáním přímo z klávesnice.
Zkopírujte a vložte následující kód do standardního modulu a spusťte jej pro další testování třídy 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
Po úspěšném zadání správných hodnot do pole se názvy produktů a prodejní hodnoty vytisknou v okně Debug.
MODULY TŘÍDY.
- MS-Access Class Module a VBA
- Pole objektů třídy VBA MS Access
- Základní třída MS-Access a odvozené objekty
- Základní třída VBA a odvozené objekty-2
- Základní třída a varianty odvozených objektů
- Sada záznamů a modul třídy Ms-Access
- Přístup k modulu třídy a třídám Wrapper
- Transformace funkčnosti třídy Wrapper
PŘEDMĚT SBÍRKY.
- Základy přístupu a shromažďovacích objektů
- Modul třídy Ms-Access a objekt kolekce
- Záznamy tabulek v objektu a formuláři kolekce
OBJEKT SLOVNÍKU.
- Základy objektů slovníku
- Základy objektů slovníku-2
- Řazení klíčů a položek objektů slovníku
- Zobrazení záznamů ze slovníku do formuláře
- Přidat objekty třídy jako položky slovníku
- Aktualizovat položku slovníku objektů třídy ve formuláři