Omslagsklass Funktionalitet Transformation

Introduktion.

Förra veckan har vi skapat en ny Wrapper Class ClsTiles, med ClsArea Class två gånger i den nya Class Module, en instans för Golv dimensionsvärden och den andra instansen för Golv-kakel dimension, för att beräkna antalet plattor för rummet.

I den nya Wrapper Class-modulen kommer vi att omvandla volymklassen (ClsVolume2) till Sales (ClsSales)-klassen. Med några kosmetiska förändringar kommer vi att ge den en total ansiktslyftning i Wrapper-klassen, dölja dess sanna identitet som en volymberäkningsklass och använda den för att beräkna försäljningspriset för produkter med rabatt.

Det stämmer, vår ClsVolume2 Class har alla nödvändiga egenskaper för att ange de nödvändiga försäljningsdatavärdena som beskrivning, kvantitet, enhetspris och rabattprocent, som kommer att gå in i volymklassegenskaperna strDesc, dblLength, dblWidth, dblHeight.

Vi bör inte glömma att ClsVolume2-klassen är en härledd klass , byggd med ClsArea som basklass.

ClsVolume2 Class Re-Visited.

Men först, VBA-koden för ClsVolume2 Class Module (basklassen för vår nya ClsSales Class Module) återges nedan för referens:

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

Det enda problemet som hindrar oss från att använda ClsVolume2 Class direkt för försäljningen datainmatning är att egenskapsprocedurens namn dblLength, dblWidth, dblHeight inte matchar för försäljningsegendomsvärdena Kvantitet, UnitPrice, Rabattprocent. De numeriska datatyperna för ClsVolume2 Class är alla dubbla precisionsnummer och de är lämpliga för vår försäljningsklass och kan användas utan att datatyp ändras. Namnen på de offentliga funktionerna Area() och Volume() är inte heller lämpliga men deras beräkningsformel kan användas för försäljningsberäkningar utan ändringar.

a) Area =dblLength * dblWidth är lämplig för TotalPrice =Quantity * UnitPrice

b) Volym =Area * dblHeight är bra för DiscountAmount =TotalPrice * DiscountPercentage

Här har vi två val att använda ClsVolume2 Class som ClsSales Class.

1. Det enklaste sättet är att göra en kopia av ClsVolume2 Class och spara den i en ny klassmodul med namnet ClsSales. Gör lämpliga ändringar i fastighetsförfarandet och offentliga funktionsnamn som är lämpliga för försäljningsvärden och beräkningar. Lägg till fler funktioner, om det behövs, i den nya klassmodulen.
2. Skapa en Wrapper-klass med ClsVolume2 som basklass och skapa lämpliga egenskapsprocedurer och offentliga funktionsnamnändringar, maskera basklassens egenskapsprocedurer och funktionsnamn. Skapa nya funktioner i Wrapper Class, om det behövs.

Det första alternativet är något rakt fram och lätt att implementera. Men vi kommer att välja det andra alternativet för att lära oss hur man adresserar basklassens egenskaper i den nya omslagsklassen och hur man maskerar dess ursprungliga egenskapsnamn med nya.

The Transformed ClsVolume2 Class.

1. Öppna din databas och visa VBA-redigeringsfönstret (Alt+F11).
2. Välj Klassmodulen från Infoga Meny för att infoga en ny klassmodul.
3. Ändra klassmodulens namnegenskapsvärde från Class1 till ClsSales .
4. Kopiera och klistra in följande VBA-kod i modulen och spara koden:
   

   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
    

Vad gjorde vi i Wrapper-klassen? Skapade en instans av klassen ClsVolume2 och ändrade dess egenskapsnamn, funktionsnamn och lade till valideringskontroller med lämpliga felmeddelanden och förhindrade att hamna i valideringskontrollen av basklassen med olämpliga felmeddelanden, som "Värde i dblLength em> egenskapen är ogiltig' kan dyka upp från volymklassen.

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