نوشتن کلاس ماژول و استاندارد ماژول در اکسس

Class Module Name : clsmMouseWheel

Private frm As Object

Private intCancel As Integer

Public Event MouseWheel(Cancel As Integer)

' Because Form is object use set

Public Property Set Form(frmm As Object)

Set frm=frmm

End Property

Public Property Get MouseWheelCancel() As Integer

MouseWheelCancel=intCancel

End Property

Public Sub RaiseMouseWheel()

RaiseEvent MouseWheel(intCancel)

End Sub

در استاندارد ماژول ، متغیری به صورت Public تعریف می شود که در تمام رویه ها بتوان استفاده کرد حتی در سایر استاندارد ماژول ها ( یعنی در تمام رویدادهای فرم و گزارش می توان از این متغیر استفاده کرد حتی  در کنترل تکست باکس یا قسمت تکست باکس کنترل کمبو باکس مثل ایجاد TempVars .... و این متغیر به کلاس ماژول ساخته شده متصل می شود.نام استاندارد ماژول را MouseWheel می نامیم

Public cMouse As clsmMouseWheel

در قسمت ویژوال فرم مورد نظر عبارت زیر نوشته می شود.بالاتر از هر تعداد Event که در رویه وجود دارد.

Private WithEvents clsMouseWheel As MouseWheel.clsmMouseWheel

باید متغیر های WithEvents را بعنوان متغیرهای آبجکت اعلام کنید تا بتوانند نمونه های کلاس را پذیرش کنند . با این حال نمی توان آنها را بعنوان Object اعلام کرد . باید آنها را به عنوان کلاس خاصی که می تواند رویدادها را مطرح کند ، اظهار نمائید.

شئ هایی که از روی کلاس ساخته می‌شوند را یک نمونه (Instance) از آن کلاس می‌نامند.

WithEvents مشخص میکند که یک یا چند متغیر عضو اعلام شده به نمونه ای از یک کلاس اشاره می کند که می تواند رویدادها را افزایش دهد.

فرضا می خواهید رویدادهایی ( رویدادها را می دانید ) که برای کنترل webbrowser وجود دارد را اجرا کنید با WithEvents  متغیری را تعریف می کنید که به آن کلاس ماژول متصل شود و بعد یک رویه می نویسید.

در رویداد لود فرم باید متغیر تعریف شده بالا را به کلاس ماژول نوشته شده تنظیم کرد 

Set clsMouseWheel=New MouseWheel.clsmMouseWheel

Set clsMouseWheel.Form=Me

در اینجا می توان تابعی که در استاندارد ماژول تعریف کردید را اجرا کنید مثل 

clsMouseWheel.SubMsgForm

در رویداد کلوز فرم : 

فرضا اجرای تابعی از استاندارد ماژول مثلا برای قطع زنجیره ارتباطی

Set clsMouseWheel.Form=nothing

Set clsMouseWheel=Nothing

Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)

Msgbox " Hello"

Cancel=True

End Sub

hook کردن یا به زنجیر کشیدن پنجره برای ارسال پیام های ویندوزی 

برای hook کردن پنجره از تابع SetWindowLongPtrA استفاده کنید

HookForm :

SetWindowLongPtrA

oldWndProc

frm.hwnd  GWL_WNDPROC AddressOf WndProc

Set Mouse=Me

برای قطع اتصال به پنجره باید Unhook کرد با استفاده از همان تابع  ( البته از توابع SetWindowsHookA برای تنظیم این زنجیره و قطع آن با UnHookWindowsHookEx استفاده می کنند.) که در پارامتر lparam تابع oldWndProc جایگزین می شود.

تابعی هم برای پارامتر دوم تابع SetWindowLongPtrA  می نویسید که اینجا wndProc نامیده شده یا می توانید نام آنرا WindowsHook بگذارید . که شامل چهار آرگومان hwnd Msg wParam lParam است.اولی هندل پنجره را مشخص میکند که دیتاتایپ آن در ویندوز 64 بیت LongPtr است 

Public Function WndHookProc(ByVal hWnd As LongPtr,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As Long

Select Case Msg

           Case WM_MOUSEWHEEL

WndHookProc=CallWindowProc(oldWndProc,hWnd,Msg,wParam,lParam)

         Case Else

WndHookProc=CallWindowProc(oldWndProc,hWnd,Msg,wParam,lParam)

End Select

End Function

MouseWheel ( Page , Count )        در اکسس

نوشتن کلاس ماژول

Private varPropertyName As Variant 

Property Get PropertyName() As Variant 

    If IsObject(varPropertyName) Then 

        Set PropertyName = varPropertyName 

    Else 

        PropertyName = varPropertyName 

    End If 

End Property 

Property Set PropertyName(rData As Variant) 

    Set varPropertyName = rData 

End Property 

در زیر کلاس ماژول clsStudent تعریف شده که نمره ای را می گیرد و رتبه ای را بر می گرداند. پراپرتی Let حداقل یک آرگومان می گیرد و الزامیست. با Let یک مقدار به پراپرتی اختصاص یافته همانطور که می ببینید محاسباتی انجام شده و در dblStuMarks قرار داده شده و با Get مقدار این پراپرتی را گرفته یعنی Marks را معادل dblStuMarks قرار داده و این متغیر را در تابع Grade استفاده کرده.

Private dblStuMarks As Double

Public Property Let Marks(iMarks As Double)
dblStuMarks = (iMarks / 80) * 100
End Property

Public Property Get Marks() As Double
Marks = dblStuMarks
End Property


Public Function Grade() As String
Dim strGrade As String

If dblStuMarks >= 80 Then strGrade = "A"
ElseIf dblStuMarks >= 60 Then
strGrade = "B"
ElseIf dblStuMarks >= 40 Then
strGrade = "C"
Else
strGrade = "Fail"
End If
Grade = strGrade
End Function





Sub clsStudentRun()
Dim iStudent As clsStudent
Set iStudent = New clsStudent
'Dim iStudent As New clsStudent
MsgBox iStudent.Marks
MsgBox iStudent.Grade

End Sub

کلاس ماژول تعریف شده یِ زیر 

* Property Get. Returns the value of a property.

* Property Let. Assigns a value to the property.

* Property Set. Sets the value of an object property.

پراپرتی Get مقدار پراپرتی را بر می گرداند.

پراپرتی Let یک مقدار به پراپرتی تخصیص می دهد

پراپرتی Set مقدار یک پراپرتی Object را تنظیم می کند

Private employee As Employee

Public Property Get NewEmployee() As Variant

NewEmployee = employee

End Property

Public Property Set NewEmployee(ByVal vNewValue As Employee)

employee = vNewValue

End Property

در زیر دو کلاس ماژول تعریف شده  یکی با نام clsCar و دیگری clsMotorCars که مقادیری را می گیرد و محاسباتی را برمی گرداند.

Class Module Named clsCar

Private varCar As clsMotorCars

Public Property Set Car(objCar As clsMotorCara)

Set varCar=objCar

End Property

Public Property Get Car() As MotorCar

Set Car=varCar

End Proprty

Class Module named clsMotorCars

Private strColor As String
Private strName As String
Private dMG As Double

Property Let Color(clr As String)
strColor = clr
End Property

Property Get Color() As String
Color = strColor
End Property

Property Let Name(nm As String)
strName = nm
End Property

Property Get Name() As String
Name = strName
End Property

Property Let Mileage(milesGallon As Double)
dMG = milesGallon
End Property

Property Get Mileage() As Double
Mileage = dMG
End Property

Function FuelBudget(FuelCost As Double, Distance As Double) As Double
FuelBudget = (Distance / Mileage) * FuelCost
End Function

Sub propSetCars()


Dim dDist As Double
Dim dCost As Double

Dim ownCar As clsCar
Set ownCar = New clsCar

Set ownCar.Car = New clsMotorCars

ownCar.Car.Color = "Yellow"
ownCar.Car.Name = "Ford"
ownCar.Car.Mileage = 50
dDist = InputBox("Enter Distance in miles, covered by car in a month")
dCost = InputBox("Enter Cost of Fuel per gallon")

Msgbox ownCar.Car.FuelBudget(dDist, dCost)


End Sub

ساخت کلاس ماژول

ایجاد 5 Label در فرم : 

Private click1 As New ClickLabel
Private click2 As New ClickLabel
Private click3 As New ClickLabel
Private click4 As New ClickLabel
Private click5 As New ClickLabel
Private Sub Form_Load()
Set click1.ClickLabel = Me.Label0
Set click2.ClickLabel = Me.Label1
Set click3.ClickLabel = Me.Label2
Set click4.ClickLabel = Me.Label3
Set click5.ClickLabel = Me.Label4
End Sub

کلاس ماژول به نام ClickLabel

Private withEvents mlabel as Access.Label

Public Property Get ClickLabel() As Access.Label
  Set ClickLabel = mLabel
End Property
Public Property Set ClickLabel(ByVal lblClickLabel As Access.Label)
  Set mLabel = lblClickLabel
  mLabel.OnClick = "[Event Procedure]"
  mLabel.OnMouseUp = "[Event Procedure]"
 End Property
Private Sub mLabel_Click()
  'run code here
  MsgBox "You clicked label " & mLabel.Name
  If mLabel.ForeColor = vbRed Then
    mLabel.ForeColor = vbGreen
  Else
    mLabel.ForeColor = vbRed
  End If
End Sub
Private Sub mLabel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  MsgBox "You moused up from " & mLabel.Name & "It is associated with record" & mRecordID
End Sub

عملکردش چییست؟  بعد از ایجاد 5  لیبل در فرم  زمانیکه روی لیبل کلیک کنید پیغامی حاوی نام لیبل را به شما نمایش داده و رنگ آن تغییر میکند البته   mRecordID در کدهای بالا اعمال نشده که می توان آنرا هم ساخت و برای هر لیبل ID ساخت.

Set click5.ClickLabel = Me.Label4
click5.RecordID = 5

یک متغیر بنام mRecordID با دیتا تایپ Long تعریف کرده

از Property Get برای گرفتن رویه پراپرتی ( RecordID )  استفاده کرده و از نوع لانگ 

the Property Get statement to define a property procedure that gets the value of a property

و سپس از Property Let استفاده نموده برای تخصیص مقداردر mRecordID 

the Property Let statement to define a procedure that assigns a value to a property

Private mRecordID As Long

Public Property Get RecordID() As Long 

RecordID = mRecordID

End Property 

Public Property Let RecordID(ByVal lngRecordID As Long)

mRecordID = lngRecordID

End Property

you can only use a Property Let procedure on the left side of a property assignment expression or Let statement.

Private mstrPropertyName As String 

Property Get PropertyName() As String 
    PropertyName = mstrPropertyName 
End Property 

' You would use Let because String is a value data type
Property Let PropertyName(rData As String) 
    mstrPropertyName = rData 
End Property 

IMPORTANT : 

The Set statement is used to make a reference of an object to an object variable. You don't have to use the Set keyword, if you are dealing with primitive and native built-in types such as integer, double, string and so on. 

The syntax of Property Set is parallel to the Property Let procedure. The only difference is that the argument is an object data type, and the VBA Set keyword is used for the assignment within the body of the Property Set. The following is an example of hypothetical Property Set procedure that accepts a recordset object and assigns it to a private variable named m_ Products:

PROPERTY SET همراستای PROPERTY LET است و تنها فرقی که دارد این است که دیتا تایپ آرگومان OBJECT است.

Public Property Set Products(Value As ADO.Recordset)
  If Not Value Is Nothing Then
    Set m_Products = Value
  End If
End Property