Transformasi Fungsionalitas Kelas Pembungkus

Pengantar.

Minggu lalu kami telah membuat ClsTiles Kelas Pembungkus baru, menggunakan Kelas ClsArea dua kali di Modul Kelas baru, satu contoh untuk Lantai nilai dimensi, dan contoh kedua untuk Ubin Lantai dimensi, untuk menghitung jumlah Ubin untuk ruangan.

Dalam Modul Kelas Pembungkus yang baru, kita akan mengubah Kelas Volume (ClsVolume2) menjadi Kelas Penjualan (ClsSales). Dengan beberapa perubahan kosmetik, kami akan memberikan facelift total di Kelas Wrapper, menyembunyikan identitas aslinya sebagai Kelas penghitungan Volume dan menggunakannya untuk menghitung Harga Jual Produk dengan Diskon.

Itu benar, Kelas ClsVolume2 kami memiliki semua properti yang diperlukan untuk memasukkan nilai data Penjualan yang diperlukan seperti Deskripsi, Kuantitas, Harga Satuan, dan Persentase Diskon, yang masing-masing akan masuk ke Properti Kelas Volume strDesc, dblLength, dblWidth, dblHeight.

Kita tidak boleh lupa bahwa Kelas ClsVolume2 adalah Kelas Turunan , dibangun menggunakan ClsArea sebagai Kelas Dasar.

Kelas ClsVolume2 Dikunjungi Kembali.

Tapi, pertama-tama, Kode VBA dari Modul Kelas ClsVolume2 (Kelas Dasar untuk Modul Kelas ClsSales baru kami) direproduksi di bawah ini untuk referensi:

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

Satu-satunya masalah yang mencegah kami menggunakan Kelas ClsVolume2 secara langsung untuk Penjualan entri data adalah bahwa Nama Prosedur Properti dblLength, dblWidth, dblHeight tidak cocok untuk nilai properti Penjualan Kuantitas, Harga Satuan, Persentase Diskon. Tipe data numerik Kelas ClsVolume2 semuanya merupakan angka presisi ganda dan cocok untuk Kelas Penjualan kami dan dapat digunakan tanpa perubahan tipe data. Nama Area() dan Volume() fungsi publik juga tidak cocok tetapi rumus perhitungannya dapat digunakan untuk perhitungan Penjualan tanpa perubahan.

a) Area =dblLength * dblWidth cocok untuk TotalPrice =Quantity * UnitPrice

b) Volume =Area * dblHeight baik untuk DiscountAmount =TotalPrice * DiscountPercentage

Di sini, kita memiliki dua pilihan untuk menggunakan Kelas ClsVolume2 sebagai Kelas ClsSales.

Cara termudah adalah dengan membuat salinan Kelas ClsVolume2 dan menyimpannya di Modul kelas baru dengan nama ClsSales. Buat perubahan yang sesuai pada Prosedur Properti dan nama Fungsi publik yang sesuai untuk nilai dan perhitungan penjualan. Tambahkan lebih banyak fungsi, jika diperlukan, di modul kelas baru.
Buat Kelas Pembungkus menggunakan ClsVolume2 sebagai Kelas Dasar dan buat prosedur properti yang sesuai dan perubahan nama fungsi publik, menutupi Prosedur Properti dan Nama Fungsi Kelas Dasar. Buat Fungsi baru di Kelas Wrapper, jika perlu.

Opsi pertama agak lurus ke depan dan mudah diterapkan. Namun, kita akan memilih opsi kedua untuk mempelajari cara mengatasi Properti Kelas Dasar di Kelas pembungkus baru dan cara menutupi nama properti aslinya dengan yang baru.

Kelas ClsVolume2 yang Diubah.

Buka Database Anda dan tampilkan Jendela Pengeditan VBA (Alt+F11).
Pilih Modul Kelas dari Sisipkan Menu, untuk menyisipkan Modul Kelas baru.
Ubah Nilai properti Nama Modul Kelas dari Kelas1 menjadi ClsSales .

Salin dan Tempel Kode VBA berikut ke dalam Modul dan Simpan Kode:

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

Apa yang kami lakukan di Kelas Pembungkus? Membuat turunan dari Kelas ClsVolume2 dan mengubah Nama Properti, Nama Fungsi, dan menambahkan pemeriksaan Validasi dengan pesan kesalahan yang sesuai dan mencegah agar tidak masuk ke pemeriksaan validasi kelas Dasar dengan pesan kesalahan yang tidak sesuai, seperti 'Nilai dalam dblLength properti tidak valid' mungkin muncul dari Kelas Volume.

Periksa baris yang saya soroti dalam Kode di atas dan saya harap Anda dapat mengetahui bagaimana nilai properti ditetapkan/diambil ke/dari Kelas Dasar ClsVolume2.

Anda dapat melalui Modul Kelas ClsArea terlebih dahulu dan di sebelah Modul Kelas ClsVolume2 – Kelas turunan menggunakan Kelas ClsArea sebagai Kelas Dasar. Setelah mempelajari kedua Kode ini, Anda dapat melihat kedua Kode di Kelas Pembungkus ini.

Program Uji untuk Kelas ClsSales di Modul Standar.

Mari kita menulis Program Tes untuk mencoba Kelas Pembungkus.

Salin dan Tempel Kode VBA berikut ke dalam Modul Standar.

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

Jalankan Kode.

Biarkan Jendela Debug tetap terbuka (Ctrl+G).
Klik di suatu tempat di tengah Kode dan tekan tombol F5 kunci untuk Menjalankan Kode dan mencetak output di Jendela Debug.
Anda dapat menguji Kode lebih lanjut dengan memasukkan salah satu nilai input dengan angka Negatif dan menjalankan kode untuk memicu Pesan Kesalahan baru. Nonaktifkan salah satu baris input, dengan simbol komentar ('), jalankan kode, dan lihat apa yang terjadi.

Hitung Harga/Diskon untuk Array Produk.

Kode pengujian berikut membuat larik tiga Produk dan Nilai Penjualan dengan memasukkan langsung dari Keyboard.

Salin dan Tempel Kode berikut ke dalam Modul Standar dan Jalankan untuk menguji Kelas Pembungkus lebih lanjut.

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

Setelah berhasil memasukkan nilai yang benar ke dalam Array, nama produk dan nilai penjualan dicetak di jendela Debug.

MODUL KELAS.

Modul Kelas MS-Access dan VBA
Array Objek Kelas VBA MS-Access
Kelas Dasar MS-Access dan Objek Turunannya
Kelas Dasar VBA dan Objek Turunan-2
Varian Kelas Dasar dan Objek Turunan
Set Rekaman Ms-Access dan Modul Kelas
Mengakses Modul Kelas dan Kelas Pembungkus
Transformasi Fungsionalitas Kelas Wrapper

OBYEK KOLEKSI.

Dasar-dasar Ms-Access dan Objek Koleksi
Modul Kelas Ms-Access dan Objek Koleksi
Rekaman Tabel dalam Objek dan Formulir Koleksi

OBJEK KAMUS.

Dasar-dasar Objek Kamus
Dasar-Dasar Objek Kamus-2
Mengurutkan Kunci Objek dan Item Kamus
Menampilkan Rekaman dari Kamus ke Formulir
Menambahkan Objek Kelas sebagai Item Kamus
Memperbarui Item Kamus Objek Kelas pada Formulir