Indpakningsklasse funktionalitetstransformation

Introduktion.

I sidste uge har vi oprettet en ny Wrapper Class ClsTiles ved at bruge ClsArea Class to gange i det nye Class Module, en forekomst til Floor dimensionsværdier, og den anden instans for gulvfliser dimension, for at beregne antallet af fliser til rummet.

I det nye Wrapper Class Module vil vi transformere Volume Class (ClsVolume2) til Sales (ClsSales) Class. Med nogle kosmetiske ændringer vil vi give den et totalt ansigtsløft i Wrapper-klassen, skjule dens sande identitet som en volumenberegningsklasse og bruge den til at beregne salgsprisen på produkter med rabat.

Det er rigtigt, vores ClsVolume2 Class har alle de nødvendige egenskaber til at indtaste de nødvendige salgsdataværdier som Beskrivelse, Kvantitet, Enhedspris og Rabatprocent, som vil gå ind i Volume Class Properties hhv. strDesc, dblLength, dblWidth, dblHeight.

Vi bør ikke glemme, at ClsVolume2-klassen er en afledt klasse , bygget med ClsArea som basisklasse.

ClsVolume2 klasse genbesøgt.

Men først er VBA-koden for ClsVolume2 Class Module (Basisklassen for vores nye ClsSales Class Module) gengivet nedenfor til reference:

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 eneste problem, der forhindrer os i at bruge ClsVolume2 Class direkte til Salg dataindtastning er, at ejendomsprocedurenavnene dblLength, dblWidth, dblHeight ikke stemmer overens med salgsegenskabsværdierne Kvantitet, UnitPrice, Rabatprocent. De numeriske datatyper i ClsVolume2 Class er alle dobbeltpræcisionsnumre, og de er velegnede til vores salgsklasse og kan bruges uden datatypeændring. De offentlige funktioner Area() og Volume() navne er heller ikke egnede, men deres beregningsformel kan bruges til salgsberegninger uden ændringer.

a) Area =dblLength * dblWidth er egnet til TotalPrice =Quantity * UnitPrice

b) Volumen =Areal * dblHøjde er god for Rabatbeløb =Samlet pris * Rabatprocent

Her har vi to muligheder for at gøre brug af ClsVolume2 Class som ClsSales Class.

Den nemmeste måde er at lave en kopi af ClsVolume2-klassen og gemme den i et nyt klassemodul med navnet ClsSales. Foretag passende ændringer af ejendomsproceduren og offentlige funktionsnavne, der er egnede til salgsværdier og beregninger. Tilføj flere funktioner, hvis det kræves, i det nye klassemodul.
Opret en Wrapper-klasse ved hjælp af ClsVolume2 som basisklasse, og opret passende egenskabsprocedurer og ændringer af offentlige funktionsnavne, der maskerer basisklassens egenskabsprocedurer og funktionsnavne. Opret nye funktioner i Wrapper-klassen, hvis det er nødvendigt.

Den første mulighed er noget ligetil og nem at implementere. Men vi vil vælge den anden mulighed for at lære, hvordan man adresserer basisklassens egenskaber i den nye wrapper-klasse, og hvordan man maskerer dens oprindelige egenskabsnavne med nye.

Den transformerede ClsVolume2-klasse.

Åbn din database, og vis VBA-redigeringsvinduet (Alt+F11).
Vælg Klassemodulet fra Indsæt Menu, for at indsætte et nyt klassemodul.
Skift klassemodulets navnegenskabsværdi fra Class1 til ClsSales .

Kopiér og indsæt følgende VBA-kode i modulet og gem 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

Hvad lavede vi i Wrapper-klassen? Oprettede en forekomst af ClsVolume2-klassen og ændrede dens egenskabsnavne, funktionsnavne og tilføjede valideringstjek med passende fejlmeddelelser og forhindrede i at falde ind i valideringstjekket af basisklassen med upassende fejlmeddelelser, såsom 'Value in dblLength em> egenskaben er ugyldig' kan dukke op fra Volume Class.

Tjek linjerne, jeg har fremhævet i ovenstående kode, og jeg håber, du vil være i stand til at finde ud af, hvordan egenskabsværdierne er tildelt/hentet til/fra basisklassen ClsVolume2.

Du kan gå gennem ClsArea-klassemodulet først og ved siden af ClsVolume2-klassemodulet – den afledte klasse ved at bruge ClsArea-klassen som basisklasse. Efter at have gennemgået begge disse koder, kan du tage et ekstra kig på koden i denne indpakningsklasse.

Testprogram for ClsSales Class i standardmodul.

Lad os skrive et testprogram for at prøve Wrapper-klassen.

Kopiér og indsæt følgende VBA-kode i et standardmodul.

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

Kør koden.

Hold fejlfindingsvinduet åbent (Ctrl+G).
Klik et sted i midten af koden, og tryk på F5 tasten for at køre koden og for at udskrive output i fejlfindingsvinduet.
Du kan teste koden yderligere ved at indtaste en hvilken som helst af inputværdierne med et negativt tal og køre koden for at udløse den nye fejlmeddelelse. Deaktiver enhver af inputlinjerne med et kommentarsymbol ('), kør koden, og se, hvad der sker.

Beregn pris/rabat for en række produkter.

Følgende testkode opretter en række af tre produkter og salgsværdier ved at indtaste direkte fra tastaturet.

Kopiér og indsæt følgende kode i et standardmodul og kør for at teste wrapperklassen yderligere.

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

Efter vellykket indtastning af korrekte værdier i arrayet, udskrives produktnavne og salgsværdier i fejlfindingsvinduet.

KLASSEMODULER.

MS-Access Class Module og VBA
MS-Access VBA Class Object Arrays
MS-Access Basisklasse og afledte objekter
VBA-basisklasse og afledte objekter-2
Basisklasse og afledte objektvarianter
Ms-Access Recordset og klassemodul
Adgang til klassemodul- og indpakningsklasser
Wrapper Class Funktionalitet Transformation

SAMLINGSOBJEKT.

Grundlæggende om Ms-Access og Collection Object
Ms-Access klassemodul og samlingsobjekt
Tabelposter i samlingsobjekt og -form

ORDBOG OBJECT.

Grundlæggende om ordbogsobjekt
Dictionary Object Basics-2
Sortering af ordbogsobjektnøgler og -elementer
Vis poster fra ordbog til formular
Tilføj klasseobjekter som ordbogselementer
Opdater Class Object Dictionary Element på formular