Transformatie van functionaliteit van wrapperklasse

Inleiding.

Vorige week hebben we een nieuwe Wrapper Class ClsTiles gemaakt, waarbij we de ClsArea Class twee keer hebben gebruikt in de nieuwe Class Module, één instantie voor Floor dimensiewaarden, en de tweede instantie voor Floor-Tile dimensie, om het aantal tegels voor de kamer te berekenen.

In de nieuwe Wrapper Class Module transformeren we de Volume Class (ClsVolume2) naar Sales (ClsSales) Class. Met enkele cosmetische veranderingen zullen we het een totale facelift geven in de Wrapper-klasse, waarbij we zijn ware identiteit verbergen als een volumeberekeningsklasse en deze gebruiken voor het berekenen van de verkoopprijs van producten met korting.

Dat klopt, onze ClsVolume2-klasse heeft alle benodigde eigenschappen om de vereiste verkoopgegevenswaarden in te voeren, zoals Beschrijving, Hoeveelheid, Eenheidsprijs en Kortingspercentage, die respectievelijk in de Volumeklasse-eigenschappen strDesc, dblLength, dblWidth, dblHeight zullen worden opgenomen.

We mogen niet vergeten dat de ClsVolume2-klasse een Afgeleide klasse is , gebouwd met ClsArea als basisklasse.

ClsVolume2-klasse opnieuw bezocht.

Maar eerst wordt de VBA-code van de ClsVolume2-klassenmodule (de basisklasse voor onze nieuwe ClsSales-klassenmodule) hieronder weergegeven ter referentie:

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

Het enige probleem dat ons ervan weerhoudt om ClsVolume2 Class rechtstreeks te gebruiken voor de Verkoop gegevensinvoer is dat de Property Procedure-namen dblLength, dblWidth, dblHeight niet overeenkomen voor de Sales-eigenschapswaarden Hoeveelheid, Eenheidsprijs, Kortingspercentage. De numerieke gegevenstypen van ClsVolume2-klasse zijn allemaal dubbele precisiegetallen en ze zijn geschikt voor onze verkoopklasse en kunnen worden gebruikt zonder wijziging van het gegevenstype. De namen van de openbare functies Area() en Volume() zijn ook niet geschikt, maar hun berekeningsformule kan ongewijzigd worden gebruikt voor Sales-berekeningen.

a) Oppervlakte =dblLength * dblWidth is geschikt voor TotalPrice =Hoeveelheid * UnitPrice

b) Volume =Area * dblHeight is goed voor DiscountAmount =TotalPrice * DiscountPercentage

Hier hebben we twee keuzes om gebruik te maken van ClsVolume2-klasse als ClsSales-klasse.

De gemakkelijkste manier is om een kopie te maken van de ClsVolume2-klasse en deze op te slaan in een nieuwe klasse-module met de naam ClsSales. Breng de juiste wijzigingen aan in de eigendomsprocedure en openbare functienamen die geschikt zijn voor verkoopwaarden en berekeningen. Voeg indien nodig meer functies toe in de nieuwe klassenmodule.
Maak een Wrapper-klasse met ClsVolume2 als basisklasse en creëer geschikte eigenschapsprocedures en openbare functienaamwijzigingen, waarbij de eigenschapsprocedures en functienamen van de basisklasse worden gemaskeerd. Maak zo nodig nieuwe functies in de Wrapper-klasse.

De eerste optie is enigszins rechttoe rechtaan en eenvoudig te implementeren. Maar we zullen de tweede optie selecteren om te leren hoe we de eigenschappen van de basisklasse kunnen adresseren in de nieuwe wrapperklasse en hoe we de oorspronkelijke eigenschapsnamen kunnen maskeren met nieuwe.

De getransformeerde ClsVolume2-klasse.

Open je database en open het VBA-bewerkingsvenster (Alt+F11).
Selecteer de Klasmodule van Invoegen Menu, om een nieuwe klasmodule in te voegen.
Wijzig de waarde van de eigenschap Name van de Class Module van Class1 in ClsSales .

Kopieer en plak de volgende VBA-code in de module en sla de code op:

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

Wat hebben we gedaan in de Wrapper Class? Een instantie van de ClsVolume2-klasse gemaakt en de eigenschapnamen en functienamen gewijzigd en validatiecontroles toegevoegd met de juiste foutmeldingen en voorkomen dat deze in de validatiecontrole van de basisklasse terechtkwam met ongepaste foutmeldingen, zoals 'Waarde in dblLength em> property is invalid' kan verschijnen vanuit de volumeklasse.

Controleer de regels die ik in de bovenstaande code heb gemarkeerd en ik hoop dat u kunt achterhalen hoe de eigenschapswaarden worden toegewezen aan/opgehaald van/naar de basisklasse ClsVolume2.

U kunt eerst de ClsArea-klassenmodule doorlopen en vervolgens de ClsVolume2-klassenmodule – de afgeleide klasse die ClsArea-klasse als basisklasse gebruikt. Nadat u beide codes hebt doorgenomen, kunt u de code in deze Wrapper-klasse nog eens bekijken.

Testprogramma voor ClsSales-klasse in standaardmodule.

Laten we een testprogramma schrijven om de Wrapper Class uit te proberen.

Kopieer en plak de volgende VBA-code in een standaardmodule.

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

Voer de code uit.

Houd het foutopsporingsvenster open (Ctrl+G).
Klik ergens in het midden van de code en druk op F5 toets om de code uit te voeren en de uitvoer in het foutopsporingsvenster af te drukken.
U kunt de code verder testen door een van de invoerwaarden met een negatief getal in te voeren en de code uit te voeren om het nieuwe foutbericht te activeren. Schakel een van de invoerregels uit, met een commentaarsymbool ('), voer de code uit en kijk wat er gebeurt.

Bereken prijs/korting voor een reeks producten.

De volgende testcode creëert een array van drie producten en verkoopwaarden door rechtstreeks vanuit het toetsenbord in te voeren.

Kopieer en plak de volgende code in een standaardmodule en voer deze uit om de Wrapper-klasse verder te testen.

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

Nadat de juiste waarden in de array zijn ingevoerd, worden de productnamen en verkoopwaarden afgedrukt in het foutopsporingsvenster.

KLASSEMODULES.

MS-Access Class-module en VBA
MS-Access VBA Class Object Arrays
MS-Access-basisklasse en afgeleide objecten
VBA-basisklasse en afgeleide objecten-2
Basisklasse en afgeleide objectvarianten
Ms-Access Recordset en Class Module
Toegang tot klassenmodule en wrapperklassen
Transformatie van functionaliteit van wrapperklasse

COLLECTIE-OBJECT.

Basisprincipes voor MS-Access en verzamelingsobjecten
Ms-Access Class-module en verzamelobject
Tabelrecords in verzamelobject en formulier

WOORDENBOEKOBJECT.

Basisprincipes van woordenboekobjecten
Basisprincipes van woordenboekobjecten-2
Woordenboekobjectsleutels en -items sorteren
Records van woordenboek naar formulier weergeven
Klasobjecten toevoegen als woordenboekitems
Klasobjectwoordenboekitem op formulier bijwerken