ラッパークラスの機能変換

はじめに。

先週、新しいクラスモジュールでClsAreaクラスを2回使用して、新しいラッパークラスClsTilesを作成しました。1つは Floor 寸法値、および床タイルの2番目のインスタンス 寸法、部屋のタイル数を計算します。

新しいラッパークラスモジュールでは、ボリュームクラス（ClsVolume2）をセールス（ClsSales）クラスに変換します。いくつかの外観上の変更を加えて、ラッパークラスで全体的なフェイスリフトを行い、ボリューム計算クラスとしての真のアイデンティティを隠し、割引付きの製品の販売価格の計算に使用します。

そうです、ClsVolume2クラスには、説明、数量、単価、割引率などの必要な販売データ値を入力するために必要なすべてのプロパティがあり、それぞれボリュームクラスのプロパティstrDesc、dblLength、dblWidth、dblHeightに入力されます。

ClsVolume2クラスが派生クラスであることを忘れてはなりません。 、基本クラスとしてClsAreaを使用して構築されています。

ClsVolume2クラスの再訪問

ただし、最初に、ClsVolume2クラスモジュール（新しいClsSalesクラスモジュールの基本クラス）のVBAコードを参照用に以下に複製します。

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、DiscountPercentageと一致しないことです。 ClsVolume2クラスの数値データ型はすべて倍精度の数値であり、セールスクラスに適しており、データ型を変更せずに使用できます。パブリック関数Area（）およびVolume（）の名前も適切ではありませんが、それらの計算式は変更なしで売上計算に使用できます。

a）面積=dblLength*dblWidthはTotalPrice=数量*UnitPrice

b）ボリューム=面積*dblHeightはDiscountAmount=TotalPrice * DiscountPercentage

ここでは、ClsVolume2クラスをClsSalesクラスとして使用するための2つの選択肢があります。

1. 最も簡単な方法は、ClsVolume2クラスのコピーを作成し、それをClsSalesという名前の新しいクラスモジュールに保存することです。販売額と計算に適したプロパティプロシージャとパブリック関数名に適切な変更を加えます。必要に応じて、新しいクラスモジュールに関数を追加します。
2. ClsVolume2を基本クラスとして使用してラッパークラスを作成し、適切なプロパティプロシージャとパブリック関数名の変更を作成して、基本クラスのプロパティプロシージャと関数名をマスクします。必要に応じて、ラッパークラスに新しい関数を作成します。

最初のオプションはやや単純で、実装が簡単です。ただし、2番目のオプションを選択して、新しいラッパークラスで基本クラスのプロパティをアドレス指定する方法と、元のプロパティ名を新しいプロパティ名でマスクする方法を学習します。

変換されたClsVolume2クラス。

1. データベースを開き、VBA編集ウィンドウ（Alt + F11）を表示します。
2. クラスモジュールを選択します 挿入から メニュー、新しいクラスモジュールを挿入します。
3. クラスモジュールのNameプロパティの値をClass1からClsSalesに変更します 。
4. 次の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
    

ラッパークラスで何をしましたか？ ClsVolume2クラスのインスタンスを作成し、そのプロパティ名、関数名を変更し、適切なエラーメッセージを含む検証チェックを追加し、「dblLength プロパティが無効です'ボリュームクラスからポップアップする場合があります。

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