Chuyển đổi chức năng lớp bọc

Giới thiệu.

Tuần trước, chúng tôi đã tạo ClsTiles lớp Wrapper mới, sử dụng Lớp ClsArea hai lần trong Mô-đun lớp mới, một bản cho Tầng giá trị thứ nguyên và trường hợp thứ hai cho Ngói sàn kích thước, để tính toán số lượng Gạch cho căn phòng.

Trong Mô-đun lớp gói mới, chúng tôi sẽ chuyển đổi Lớp khối lượng (ClsVolume2) thành Lớp bán hàng (ClsSales). Với một số thay đổi về mỹ phẩm, chúng tôi sẽ nâng cấp toàn diện cho nó trong Lớp bọc, che giấu danh tính thực sự của nó là Lớp tính khối lượng và sử dụng nó để tính Giá bán của sản phẩm có chiết khấu.

Đúng vậy, Lớp ClsVolume2 của chúng tôi có tất cả các thuộc tính cần thiết để nhập các giá trị dữ liệu Bán hàng được yêu cầu như Mô tả, Số lượng, Đơn giá và Phần trăm chiết khấu, sẽ đi vào Thuộc tính Lớp Khối lượng strDesc, dblLength, dblWidth, dblHeight tương ứng.

Chúng ta không nên quên rằng Lớp ClsVolume2 là một Lớp có nguồn gốc , được xây dựng bằng cách sử dụng ClsArea làm Lớp cơ sở.

Đã thăm lại lớp ClsVolume2.

Tuy nhiên, trước tiên, Mã VBA của Mô-đun lớp ClsVolume2 (Lớp cơ sở cho Mô-đun lớp ClsSales mới của chúng tôi) được sao chép bên dưới để tham khảo:

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

Sự cố duy nhất ngăn chúng tôi sử dụng ClsVolume2 Class trực tiếp cho Bán hàng nhập dữ liệu là các tên của thuộc tính Thủ tục thuộc tính dblLength, dblWidth, dblHeight không khớp với các giá trị thuộc tính Bán hàng Số lượng, Giá đơn vị, Phần trăm chiết khấu. Các kiểu dữ liệu số của Lớp ClsVolume2 đều là số chính xác kép và chúng phù hợp với Lớp Bán hàng của chúng tôi và có thể được sử dụng mà không cần thay đổi kiểu dữ liệu. Các hàm công cộng Tên khu vực () và Khối lượng () cũng không phù hợp nhưng công thức tính toán của chúng có thể được sử dụng để tính Doanh số mà không cần thay đổi.

a) Diện tích =dblLength * dblWidth phù hợp với TotalPrice =Quantity * UnitPrice

b) Khối lượng =Diện tích * dbl Chiều cao phù hợp với Chiết khấu Số tiền =Tổng Giá * Phần trăm chiết khấu

Ở đây, chúng tôi có hai lựa chọn để sử dụng ClsVolume2 Class làm ClsSales Class.

Cách dễ nhất là tạo một bản sao của Lớp ClsVolume2 và lưu nó trong một Mô-đun lớp mới với tên ClsSales. Thực hiện các thay đổi thích hợp đối với các tên thuộc tính và chức năng công khai phù hợp với các giá trị và tính toán bán hàng. Thêm các chức năng khác, nếu cần, trong mô-đun lớp mới.
Tạo Lớp bao bọc bằng cách sử dụng ClsVolume2 làm Lớp cơ sở và tạo các thủ tục thuộc tính phù hợp và thay đổi tên chức năng công khai, che đi các tên chức năng và Thủ tục thuộc tính của Lớp cơ sở. Tạo các hàm mới trong Lớp gói, nếu cần.

Tùy chọn đầu tiên có phần thẳng thắn và dễ thực hiện. Tuy nhiên, chúng tôi sẽ chọn tùy chọn thứ hai để tìm hiểu cách giải quyết các Thuộc tính của Lớp cơ sở trong Lớp trình bao bọc mới và cách che tên thuộc tính ban đầu của nó với các tên thuộc tính mới.

Lớp ClsVolume2 được Biến đổi.

Mở Cơ sở dữ liệu của bạn và hiển thị Cửa sổ chỉnh sửa VBA (Alt + F11).
Chọn Mô-đun lớp từ Chèn Menu, để chèn Mô-đun lớp mới.
Thay đổi Giá trị thuộc tính Tên của Mô-đun lớp từ Class1 thành ClsSales .

Sao chép và Dán Mã VBA sau vào Mô-đun và Lưu Mã:

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

Chúng tôi đã làm gì trong Lớp học gói? Đã tạo một phiên bản của Lớp ClsVolume2 và thay đổi Tên thuộc tính, Tên chức năng và bổ sung kiểm tra Xác thực với các thông báo lỗi thích hợp và ngăn chặn việc rơi vào kiểm tra xác thực của Lớp cơ sở với các thông báo lỗi không phù hợp, như 'Giá trị trong dblLength thuộc tính không hợp lệ 'có thể bật lên từ Lớp khối lượng.

Kiểm tra các dòng tôi đã đánh dấu trong Mã trên và tôi hy vọng bạn sẽ có thể tìm ra cách các giá trị thuộc tính được gán / truy xuất đến / từ Lớp cơ sở ClsVolume2.

Bạn có thể xem qua Mô-đun lớp ClsArea trước và bên cạnh Mô-đun lớp ClsVolume2 - Lớp dẫn xuất sử dụng Lớp ClsArea làm Lớp cơ sở. Sau khi xem qua cả hai Mã này, bạn có thể xem lại Mã trong Lớp gói này.

Chương trình Kiểm tra cho Lớp ClsSales trong Mô-đun Tiêu chuẩn.

Hãy để chúng tôi viết Chương trình thử nghiệm để dùng thử Lớp gói.

Sao chép và dán mã VBA sau vào một mô-đun tiêu chuẩn.

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

Chạy mã.

Luôn mở Cửa sổ gỡ lỗi (Ctrl + G).
Nhấp vào một nơi nào đó ở giữa Mã và nhấn F5 để Chạy mã và in đầu ra trong Cửa sổ gỡ lỗi.
Bạn có thể kiểm tra Mã thêm bằng cách nhập bất kỳ giá trị đầu vào nào có số Âm và chạy mã để kích hoạt Thông báo Lỗi mới. Tắt bất kỳ dòng nhập nào, có ký hiệu nhận xét ('), chạy mã và xem điều gì sẽ xảy ra.

Tính giá / chiết khấu cho một mảng sản phẩm.

Mã kiểm tra sau tạo một mảng gồm ba Sản phẩm và Giá trị Bán hàng bằng cách nhập trực tiếp từ Bàn phím.

Sao chép và dán mã sau vào một mô-đun tiêu chuẩn và chạy để kiểm tra thêm Lớp gói.

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

Sau khi nhập thành công các giá trị chính xác vào Mảng, tên sản phẩm và giá trị bán hàng được in trong cửa sổ Gỡ lỗi.

CÁC CHẾ ĐỘ LỚP.

Mô-đun lớp MS-Access và VBA
Mảng đối tượng lớp VBA MS-Access
Lớp cơ sở MS-Access và các đối tượng có nguồn gốc
Lớp cơ sở VBA và các đối tượng có nguồn gốc-2
Lớp cơ sở và các biến thể đối tượng có nguồn gốc
Tập bản ghi Ms-Access và Mô-đun lớp
Truy cập mô-đun lớp và các lớp gói
Chuyển đổi chức năng lớp bao bọc

ĐỐI TƯỢNG THU.

Thông tin cơ bản về Ms-Access và Đối tượng Bộ sưu tập
Mô-đun lớp Ms-Access và Đối tượng Bộ sưu tập
Bản ghi Bảng trong Đối tượng và Biểu mẫu Bộ sưu tập

ĐỐI TƯỢNG TỪ ĐIỂN.

Khái niệm cơ bản về đối tượng từ điển
Khái niệm cơ bản về đối tượng từ điển-2
Sắp xếp các Mục và Khoá Đối tượng Từ điển
Hiển thị Bản ghi từ Từ điển sang Biểu mẫu
Thêm các đối tượng lớp dưới dạng các mục từ điển
Cập nhật Mục Từ điển Đối tượng Lớp trên Biểu mẫu