در باره Validation و Shared Logic در فرم های UnBound

**mazoolagh** · چهارشنبه 14 آبان 1404, 19:46 عصر

فرض کنید یک فرم unbound داریم که چند کنترل آن دارای کد یکسان (از نظر منطق) هستند - (معمولا در validation و محاسبات).

این فرم میتونه یک فرم data entry باشه ، یا یک فرم تعیین شرایط برای یک فرم دیگه یا یک گزارش، یا یک فرم کاملا مستقل.

تا زمانی که تعداد این فیلدهای با کد مشترک (معمولا تکس باکس برای شماره یا متن) ثابت و کم باشه، مشکلی پیش نمیاد:
مثلا برای تعیین محدوده گزارش دو فیلد تاریخ شروع و تاریخ پایان هست که همیشه همین هست و کم و زیاد نمیشه،
یا برای نام و نام خانوادگی و نام پدر و مادر و ... تعداد کم و مشخص هست،
و برای این حالت ها مشکلی در نگهداری برنامه (بابت تغییر در کدها) پیش نمیاد - دقیقا بخاطر محدود و مشخص بودن.

حالا حالتی رو فرض کنین مشابه تاپیک محاسبه میانگین بدون در نظر گرفتن صفر درچند تکست باکس در فرم
1- پست 6 و 7 همون تاپیک یک نمونه از روش ابتدایی حل مسئله اس - که ناقصه و validation نداره.

2- پست 16 همون تاپیک یک پله بالاتر هست چون محاسبات مستقل از تعداد فیلدهاست،
ولی هنوز ناقصه چون validation نداره.

4- در پست 11 همون تاپیک روش درست استفاده شده،
ولی این هم هنوز خام هست.

یک روش هم هست (روش 3) که آخر سر در موردش میگم .

اینجا برای همه اینها نمونه میذارم و خواهیم دید که چرا در بعضی مواقع حتی اگر دیتا فرم قرار نیست در دیتابیس ذخیره بشه،
باز هم bound کردن اون چقدر میتونه کدنویسی رو کمتر و راحتتر کنه.

**mazoolagh** · چهارشنبه 14 آبان 1404, 19:56 عصر

برای شروع فرض کنید که نیاز به یک فرم داریم که:
1- 8 تکسباکس داشته باشه
2- که هر یک از اونها یک عدد بین 0 تا 100 قبول کنه (double)
3- و فیلدهای خالی 0 منظور بشن (در محاسبه و نمایش)
4- یک میانگین برای همه محاسبه بشه با دقت تا 3 رقم اعشار
5- یک میانگین هم برای فقط غیر صفر ها محاسبه بشه - فقط اگر دست کم یک غیر 0 داشته باشیم
6- کاربر اجازه ورود مقادیر نادرست نداره (validation الزامی است)

**eb_1345** · چهارشنبه 14 آبان 1404, 20:23 عصر

نوشته شده توسط mazoolagh

2- پست 16 همون تاپیک یک پله بالاتر هست چون محاسبات مستقل از تعداد فیلدهاست،
ولی هنوز ناقصه چون validation نداره.

عرض سلام و خسته نباشی خدمت جناب آقای مازولاق عزیز!
لطفاً راهنمائی بفرمائید اگر در کد های پست 16 تاپیک محاسبه میانگین بدون در نظر گرفتن صفر درچند تکست باکس در فرم از طریق تابع IsNumeric اعتبار سنجی شود که اگر در یکی از تکست باکس ها غیر عدد وارد شد پیغام خطا صادر شود و بر روی تکست باکس مربوطه فوکوس شود باز هم مشکلی وجود دارد ؟
مثلاً از تابع IsNumericدر حلقه For Each بعد از IF دوم کدهای زیر بکار رود:



         If IsNumeric(ctrl.Value) Then

             CountCtrl = CountCtrl + 1

             SumCtrl = SumCtrl + ctrl.Value

         Else

            ctrl.SetFocus

            MsgBox "اطلاعات وارده معتبر نمي باشد"

            Exit Sub

         End If

**eb_1345** · چهارشنبه 14 آبان 1404, 20:29 عصر

با عرض پوزش ، با توجه به اینکه تاپیک جنبه آموزشی دارد بهتر بود سوال بالا رو در همون تاپیک مربوطه میپرسیدم

**mazoolagh** · شنبه 17 آبان 1404, 15:53 عصر

نوشته شده توسط eb_1345

عرض سلام و خسته نباشی خدمت جناب آقای مازولاق عزیز!
لطفاً راهنمائی بفرمائید اگر در کد های پست 16 تاپیک محاسبه میانگین بدون در نظر گرفتن صفر درچند تکست باکس در فرم از طریق تابع IsNumeric اعتبار سنجی شود که اگر در یکی از تکست باکس ها غیر عدد وارد شد پیغام خطا صادر شود و بر روی تکست باکس مربوطه فوکوس شود باز هم مشکلی وجود دارد ؟
مثلاً از تابع IsNumericدر حلقه For Each بعد از IF دوم کدهای زیر بکار رود:



         If IsNumeric(ctrl.Value) Then

             CountCtrl = CountCtrl + 1

             SumCtrl = SumCtrl + ctrl.Value

         Else

            ctrl.SetFocus

            MsgBox "اطلاعات وارده معتبر نمي باشد"

            Exit Sub

         End If

با سلام و آرزوی روز خوش

قانون اصلی و مهم اینه که کد درست و دقیق کار کنه،
حالا این که از بین چند کد درست کدوم بهتره بحث دیگه ای داره.

چیزی که در این تاپیک بهش میپردازیم نفس خود validation نیست که بخواهیم وارد جزئیات روش بشیم،
بلکه تمرکز روی shared logic و reusable code در بهینه سازی کدهای فرم (از جمله validation) هست که نگهداری برنامه رو خیلی ساده تر میکنه.

این که در اینجا یک پروژه با فیلدهای عددی بعنوان محور کار تعریف شده، فقط یک انتخاب بوده
وگرنه میتونه فیلدهای متنی، یا تاریخ، یا کنترل های دیگه مثل کمبوباکس باشه.

با این وجود در همین نمونه ها هم سعی شده که یک validation درست و کاربردی پیاده بشه.

=======
در تاپیک زیر (البته عنوانش مناسب نیست!) یک نمونه form validation برای چند نوع فیلد هست:
مبتدی: راهنمایی در نوشتن مسیج باکس

شاید بهتر باشه یک تاپیک جداگانه براش زده بشه و با کمک جنابعالی و دیگر دوستان یک رفرنس خوبی ازش دربیاد.

**mazoolagh** · شنبه 17 آبان 1404, 15:58 عصر

نوشته شده توسط eb_1345

با عرض پوزش ، با توجه به اینکه تاپیک جنبه آموزشی دارد بهتر بود سوال بالا رو در همون تاپیک مربوطه میپرسیدم

شما صاحب اختیارین،
دقت کرده باشین برنامه پیوست همون تاپیک هم یک شماره 1 آخرش داره،
یعنی قرار بود نمونه های دیگه هم پشت سرش بیاد،
دیگه بجاش تاپیک مستقل براش زدم (البته جزئیات validation رو اینجا نمیپردازیم).

**mazoolagh** · شنبه 17 آبان 1404, 16:30 عصر

خب،
روش اول این هست که بصورت سنتی و ساده برای هر تکسباکس یک مکانیسم مناسب validation پیاده کنیم.

مهم این که تعریف validation rule برای تکسباکس، بجز زمانی که شرایط ساده باشن (که اینجا نیست)،
چندان کارآمد نیست - بخصوص که امکان استفاده از UDF و بسیاری از توابع داخلی خود اکسس رو نداریم.
بنابراین باید از رخداد(های) مناسب استفاده کنیم که مهمترین اون before update هست.

اینجا به اینصورت عمل میکنیم:
1- در before update محدوده تعیین شده (0 تا 100) یا null بودن (چون طبق صورت مسئله فیلد خالی مجاز هست و 0 منظور میشه) اون رو چک میکنیم.
2- در exit بررسی میکنیم اگر فیلد خالی هست، اون رو 0 میکنیم.
3- چون قید نشده که اعداد از چه type هستن، پس باید اجازه ورود اعداد اعشاری رو هم بدیم.
اعداد به طور کلی میتونن با نماد علمی هم وارد بشن مثل 1.234e2 یا 4.567d-1
به همین خاطر در رخداد key press هم یک فیلتر میگذاریم که بجز 0 تا 9 و دسیمال (.) و علامت عدد (+/-) و eEdD جلوی همه رو بگیره،
هرچند این باعث جلوگیری از نوشتن عدد نادرست نمیشه - ولی ما در before update اون رو خفت میکنیم.

البته میتونیم وقت بگذارین و چنان الگوریتم دقیقی پیاده کنیم که کاربر حتی نتونه عدد اشتباه رو در تکسباکس بنویسه (پیش از beforeupdate)
ولی هدف تاپیک این نیست، گرچه میشه در تاپیک مستقلی به اینجور جزئیات هم پرداخت.

**mazoolagh** · شنبه 17 آبان 1404, 16:38 عصر

در گام اول یک روتین مینویسیم برای تشخیص valid بودن یک متن بعنوان یک عدد در محدوده مشخص شده یا خالی بودن اون:

Public Function NumberIsValid(ByVal Value As Variant) As Boolean

    Value = Nz(Trim(Value), 0)

    If IsNumeric(Value) Then

        NumberIsValid = (Val(Value) >= 0 And Val(Value) <= 100)

    Else

        NumberIsValid = (Value = "")

    End If

End Function

یک تابع هم مینویسیم برای فیلتر کردن کلیدها:

Public Function KeyIsValid(KeyAscii As Integer) As Boolean

    KeyIsValid = True

    Select Case KeyAscii

        Case vbKey0 To vbKey9

            Exit Function

        Case vbKeyBack

            Exit Function

        Case Asc("."), Asc("+"), Asc("-")

            Exit Function

        Case Asc("e"), Asc("E"), Asc("d"), Asc("D")

            Exit Function

        Case Else

            KeyIsValid = False

    End Select

End Function

و یک قاعده کلی هم برای تبدیل null به 0 و همچنین تغییر شکل اعداد علمی به نرمال مینویسیم:

Private Sub TB_Number_x_Exit(Cancel As Integer)

    If Trim(Me.TB_Number_x.Text) = "" Then

        Me.TB_Number_x = 0

    Else

        Me.TB_Number_x = CDbl(Me.TB_Number_x)

    End If

End Sub

**mazoolagh** · شنبه 17 آبان 1404, 16:40 عصر

روتین محاسبه:

Private Sub CalcAverage()

    Const count_all = 8

    Dim sum_all As Double

    Dim count_non_zero As Long

    Dim Value As Variant

    sum_all = 0

    count_non_zero = 0

        If TB_Number_1 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_1

    End If

    If TB_Number_2 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_2

    End If

    If TB_Number_3 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_3

    End If

    If TB_Number_4 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_4

    End If

    If TB_Number_5 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_5

    End If

    If TB_Number_6 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_6

    End If

    If TB_Number_7 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_7

    End If

    If TB_Number_8 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_8

    End If

    Me.TB_COUNT_ALL = count_all

    Me.TB_SUM_ALL = sum_all

    Me.TB_AVERAGE_ALL = Round(sum_all / count_all, 3)

    Me.TB_COUNT_NON_ZERO = count_non_zero

    If count_non_zero > 0 Then

        Me.TB_AVERAGE_NON_ZERO = Round(sum_all / count_non_zero, 3)

    Else

        Me.TB_AVERAGE_NON_ZERO = "Division By 0 !"

    End If

End Sub

**mazoolagh** · شنبه 17 آبان 1404, 16:41 عصر

یک باتن برای پاک کردن همه فیلدها:

Private Sub BTN_CLEAR_ALL_Click()

    Me.TB_COUNT_ALL = 8

    Me.TB_SUM_ALL = 0

    Me.TB_AVERAGE_ALL = 0

    Me.TB_COUNT_NON_ZERO = 0

    Me.TB_AVERAGE_NON_ZERO = Null

    Me.TB_Number_1 = Null

    Me.TB_Number_2 = Null

    Me.TB_Number_3 = Null

    Me.TB_Number_4 = Null

    Me.TB_Number_5 = Null

    Me.TB_Number_6 = Null

    Me.TB_Number_7 = Null

    Me.TB_Number_8 = Null





End Sub

**mazoolagh** · شنبه 17 آبان 1404, 16:47 عصر

و خود فرم :

2.png

1.png

Option Compare Database

Option Explicit



Private Sub CalcAverage()

    Const count_all = 8

    Dim sum_all As Double

    Dim count_non_zero As Long

    Dim Value As Variant

    sum_all = 0

    count_non_zero = 0

        If TB_Number_1 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_1

    End If

    If TB_Number_2 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_2

    End If

    If TB_Number_3 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_3

    End If

    If TB_Number_4 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_4

    End If

    If TB_Number_5 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_5

    End If

    If TB_Number_6 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_6

    End If

    If TB_Number_7 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_7

    End If

    If TB_Number_8 <> 0 Then

        count_non_zero = count_non_zero + 1

        sum_all = sum_all + TB_Number_8

    End If

    Me.TB_COUNT_ALL = count_all

    Me.TB_SUM_ALL = sum_all

    Me.TB_AVERAGE_ALL = Round(sum_all / count_all, 3)

    Me.TB_COUNT_NON_ZERO = count_non_zero

    If count_non_zero > 0 Then

        Me.TB_AVERAGE_NON_ZERO = Round(sum_all / count_non_zero, 3)

    Else

        Me.TB_AVERAGE_NON_ZERO = "Division By 0 !"

    End If

End Sub



Private Sub BTN_CLEAR_ALL_Click()

    Me.TB_COUNT_ALL = 8

    Me.TB_SUM_ALL = 0

    Me.TB_AVERAGE_ALL = 0

    Me.TB_COUNT_NON_ZERO = 0

    Me.TB_AVERAGE_NON_ZERO = Null

    Me.TB_Number_1 = Null

    Me.TB_Number_2 = Null

    Me.TB_Number_3 = Null

    Me.TB_Number_4 = Null

    Me.TB_Number_5 = Null

    Me.TB_Number_6 = Null

    Me.TB_Number_7 = Null

    Me.TB_Number_8 = Null



End Sub



Private Sub Form_Load()

    BTN_CLEAR_ALL_Click



End Sub



Private Sub TB_Number_1_BeforeUpdate(Cancel As Integer)

    If (Not NumberIsValid(Me.TB_Number_1.Text)) Then

        MsgBox _

            prompt:="Enter a number between 0 and 100," & vbCrLf & "or leave the field blank (means 0)", _

            buttons:=vbCritical, _

            title:=Me.LBL_Number_1.caption

            Cancel = True

    End If



End Sub



Private Sub TB_Number_1_Exit(Cancel As Integer)

    If Trim(Me.TB_Number_1.Text) = "" Then

        Me.TB_Number_1 = 0

    Else

        Me.TB_Number_1 = CDbl(Me.TB_Number_1)

    End If

    CalcAverage



End Sub



Private Sub TB_Number_1_KeyPress(KeyAscii As Integer)

    If Not KeyIsValid(KeyAscii) Then KeyAscii = 0



End Sub



Private Sub TB_Number_2_BeforeUpdate(Cancel As Integer)

    If (Not NumberIsValid(Me.TB_Number_2.Text)) Then

        MsgBox _

            prompt:="Enter a number between 0 and 100," & vbCrLf & "or leave the field blank (means 0)", _

            buttons:=vbCritical, _

            title:=Me.LBL_Number_2.caption

            Cancel = True

    End If



End Sub



Private Sub TB_Number_2_Exit(Cancel As Integer)

    If Trim(Me.TB_Number_2.Text) = "" Then

        Me.TB_Number_2 = 0

    Else

        Me.TB_Number_2 = CDbl(Me.TB_Number_2)

    End If

    CalcAverage



End Sub



Private Sub TB_Number_2_KeyPress(KeyAscii As Integer)

    If Not KeyIsValid(KeyAscii) Then KeyAscii = 0



End Sub



Private Sub TB_Number_3_BeforeUpdate(Cancel As Integer)

    If (Not NumberIsValid(Me.TB_Number_3.Text)) Then

        MsgBox _

            prompt:="Enter a number between 0 and 100," & vbCrLf & "or leave the field blank (means 0)", _

            buttons:=vbCritical, _

            title:=Me.LBL_Number_3.caption

            Cancel = True

    End If



End Sub



Private Sub TB_Number_3_Exit(Cancel As Integer)

    If Trim(Me.TB_Number_3.Text) = "" Then

        Me.TB_Number_3 = 0

    Else

        Me.TB_Number_3 = CDbl(Me.TB_Number_3)

    End If

    CalcAverage



End Sub



Private Sub TB_Number_3_KeyPress(KeyAscii As Integer)

    If Not KeyIsValid(KeyAscii) Then KeyAscii = 0



End Sub



Private Sub TB_Number_4_BeforeUpdate(Cancel As Integer)

    If (Not NumberIsValid(Me.TB_Number_4.Text)) Then

        MsgBox _

            prompt:="Enter a number between 0 and 100," & vbCrLf & "or leave the field blank (means 0)", _

            buttons:=vbCritical, _

            title:=Me.LBL_Number_4.caption

            Cancel = True

    End If



End Sub



Private Sub TB_Number_4_Exit(Cancel As Integer)

    If Trim(Me.TB_Number_4.Text) = "" Then

        Me.TB_Number_4 = 0

    Else

        Me.TB_Number_4 = CDbl(Me.TB_Number_4)

    End If

    CalcAverage



End Sub



Private Sub TB_Number_4_KeyPress(KeyAscii As Integer)

    If Not KeyIsValid(KeyAscii) Then KeyAscii = 0



End Sub



Private Sub TB_Number_5_BeforeUpdate(Cancel As Integer)

    If (Not NumberIsValid(Me.TB_Number_5.Text)) Then

        MsgBox _

            prompt:="Enter a number between 0 and 100," & vbCrLf & "or leave the field blank (means 0)", _

            buttons:=vbCritical, _

            title:=Me.LBL_Number_5.caption

            Cancel = True

    End If



End Sub



Private Sub TB_Number_5_Exit(Cancel As Integer)

    If Trim(Me.TB_Number_5.Text) = "" Then

        Me.TB_Number_5 = 0

    Else

        Me.TB_Number_5 = CDbl(Me.TB_Number_5)

    End If

    CalcAverage



End Sub



Private Sub TB_Number_5_KeyPress(KeyAscii As Integer)

    If Not KeyIsValid(KeyAscii) Then KeyAscii = 0



End Sub



Private Sub TB_Number_6_BeforeUpdate(Cancel As Integer)

    If (Not NumberIsValid(Me.TB_Number_6.Text)) Then

        MsgBox _

            prompt:="Enter a number between 0 and 100," & vbCrLf & "or leave the field blank (means 0)", _

            buttons:=vbCritical, _

            title:=Me.LBL_Number_6.caption

            Cancel = True

    End If



End Sub



Private Sub TB_Number_6_Exit(Cancel As Integer)

    If Trim(Me.TB_Number_6.Text) = "" Then

        Me.TB_Number_6 = 0

    Else

        Me.TB_Number_6 = CDbl(Me.TB_Number_6)

    End If

    CalcAverage



End Sub



Private Sub TB_Number_6_KeyPress(KeyAscii As Integer)

    If Not KeyIsValid(KeyAscii) Then KeyAscii = 0



End Sub



Private Sub TB_Number_7_BeforeUpdate(Cancel As Integer)

    If (Not NumberIsValid(Me.TB_Number_7.Text)) Then

        MsgBox _

            prompt:="Enter a number between 0 and 100," & vbCrLf & "or leave the field blank (means 0)", _

            buttons:=vbCritical, _

            title:=Me.LBL_Number_7.caption

            Cancel = True

    End If



End Sub



Private Sub TB_Number_7_Exit(Cancel As Integer)

    If Trim(Me.TB_Number_7.Text) = "" Then

        Me.TB_Number_7 = 0

    Else

        Me.TB_Number_7 = CDbl(Me.TB_Number_7)

    End If

    CalcAverage



End Sub



Private Sub TB_Number_7_KeyPress(KeyAscii As Integer)

    If Not KeyIsValid(KeyAscii) Then KeyAscii = 0



End Sub



Private Sub TB_Number_8_BeforeUpdate(Cancel As Integer)

    If (Not NumberIsValid(Me.TB_Number_8.Text)) Then

        MsgBox _

            prompt:="Enter a number between 0 and 100," & vbCrLf & "or leave the field blank (means 0)", _

            buttons:=vbCritical, _

            title:=Me.LBL_Number_8.caption

            Cancel = True

    End If



End Sub



Private Sub TB_Number_8_Exit(Cancel As Integer)

    If Trim(Me.TB_Number_8.Text) = "" Then

        Me.TB_Number_8 = 0

    Else

        Me.TB_Number_8 = CDbl(Me.TB_Number_8)

    End If

    CalcAverage



End Sub



Private Sub TB_Number_8_KeyPress(KeyAscii As Integer)

    If Not KeyIsValid(KeyAscii) Then KeyAscii = 0



End Sub

**mazoolagh** · شنبه 17 آبان 1404, 16:51 عصر

این روش درست هست و کار میکنه
ولی از نظر نگهداری برنامه و کدهای تکراری مشکل داره
که در پست های بعدی همین مشکل رو میبینیم که چجوری میشه برطرف کرد.

**mazoolagh** · دوشنبه 19 آبان 1404, 18:49 عصر

خب،

در برنامه قبلی دیدیم که برای یک دسته از تکسباکس ها 3 روتین با کد (logic یا منطق) یکسان هست (beforeupdate, onexit, onkeypress)
و اینجور بنظر میرسه که باید به نحوی اینها رو یک کاسه کنیم به شکلی که فقط یک نسخه از هر یک از اینها باشه
ولی کاری کنیم که تکسباکس ها بطور خودکار در هر کدوم از رویدادها از کد مشترک استفاده کنن.

این همون چیزی هست که بهش میگن shared code یا shared logic و یک تکنیک کاملا متداول هست.

در اکسس میتونیم بجای اینکه در یک رویداد یک event procedure (که به کد موجود در ماجول خود فرم اشاره داره) یا macro رو سدا بزنیم،
اون رو به یک فانکشن که خودمون نوشتیم هدایت کنیم.
کافی هست پراپرتی متناسب با رویداد رو به شکل مناسب بنویسیم:

Btn.OnClick = "=L1_Click('" + Btn.Name + "')"   



Private Function L1_Click(Btn_Name As String)

...

...

End Function

کدها و برنامه نمونه برای این رو میتونین در تاپیک زیر پیدا کنین:

طراحی فرم منو اصلی پویا در اکسس (Dynamic Form)

باید در نظر داشت این رو همیشه و برای همه رویدادها نمیشه استفاده کرد،
چون بعضی ها مثل OnKeyPress یک پارامتر byref دارن (keyascii).

البته رویدادهایی مثل BeforeUpdate هم این نوع پارامتر رو دارن (cancel)،
ولی خوشبختانه میتونیم در روتین مشترک از cancelevent استفاده کنیم (بجای cancel=true)

در پست بعدی به راهکاری میپردازیم که چجوری هر رویدادی با هر میزان پیچیدگی رو
میشه بصورت مشترک برای تعداد زیادی کنترل بصورت مشترک (حتی در چند فرم) متعدد استفاده کرد.

**mazoolagh** · سه شنبه 20 آبان 1404, 19:06 عصر

روش کارآمدی که به ما اجازه بده یک کنترل custom داشته باشیم
که خودکار در رخدادها به کدهای ما هدایت بشه اینه که یک کلاس از روی کنترل بسازیم.

تاپیک مربوط:
آموزش: در باره Class و User Defined Type (UDT)

پیش از ادامه صورت مسئله اولیه رو تغییر میدیم
تا بیشتر به اهداف ما کمک کنه:

1- تعداد تکسباکس ها = 100 (20 ردیف 5 ستونی)
2- محدوده مجاز :

minimum = -1E+6 = -1,000,000

maximum = +1E+6 = 1,000,000

3- فیلد میتونه خالی باشه ولی 0 حساب نمیشه - مقدار 0 باید حتما 0 وارد بشه
4- برای هر دسته از مقادیر (همه، مثبت ها، منفی ها) آمار زیر باید محاسبه بشه:
تعداد، جمع، میانگین، ماکزیمم، مینیمم
به همین دلیل هست که مقدار خالی 0 منظور نمیشه
5- پس از ثبت یا آپدیت هر یک از این 100 مقدار، آمار هم باید خودکار آپدیت بشه.

**mazoolagh** · سه شنبه 20 آبان 1404, 19:14 عصر

ابتدا کلاس MazooTextBox رو درست میکنیم:

Option Compare Database

Option Explicit



Public WithEvents Txt As Access.TextBox



Private Sub Txt_KeyPress(KeyAscii As Integer)

    If Not KeyIsValid(KeyAscii) Then KeyAscii = 0

End Sub



Public Sub Init(ByRef txtbx As Access.TextBox)

    Set Txt = txtbx

End Sub

البته اینجا فقط رویداد KeyPress رو هندل کردیم،
ولی میشد BeforeUpdate و Exit رو هم بیاریم،
ولی اینجا برای اهداف آموزشی به شکل دیگه ای هندل میکنیم.

**mazoolagh** · سه شنبه 20 آبان 1404, 19:23 عصر

بعد توابعی رو که برای validation نیاز داریم در یک ماجول میریزیم:

Public Function NumberIsValid(ByVal Value As Variant) As Boolean

    Value = Nz(Trim(Value), 0)

    If IsNumeric(Value) Then

        NumberIsValid = (Val(Value) >= -1000000# And Val(Value) <= 1000000#)

    Else

        NumberIsValid = (Value = "")

    End If

End Function



Public Function KeyIsValid(KeyAscii As Integer) As Boolean

    KeyIsValid = True

    Select Case KeyAscii

        Case vbKey0 To vbKey9

            Exit Function

        Case vbKeyBack

            Exit Function

        Case Asc("."), Asc("+"), Asc("-")

            Exit Function

        Case Asc("e"), Asc("E"), Asc("d"), Asc("D")

            Exit Function

        Case Else

            KeyIsValid = False

    End Select

End Function

**mazoolagh** · سه شنبه 20 آبان 1404, 19:43 عصر

3.png

در طراحی فرم اینجور قرارداد میکنیم که:
1- تکسباکس های مقادیر با اسامی TB_Number_x و لیبل های متنظر اونها با با LBL_Number_x ساخته بشن (x از 1 تا 100)
2- برای مقادیر آماری (که در footer نمایش میدیم) مشابه همین قرارداد رو داریم: مثلا TB_AVERAGE_NEG برای میانگین مقادیر منفی

برای اینکه در هر محاسبه آماری، هر بار در بین همه کنترل های نچرخیم که کنترل های مقدار رو پیدا کنیم،
دو collection تعریف میکنیم : یکی برای کنترل های مقدار و دیگری برای کنترل های فوتر.
و در form load این دو رو پر میکنیم.

پس از این در بخش محاسبات مستقیم از این 2 کالکشن استفاده میکنیم:

Private MazooTextBoxes As Collection

Private FooterTextBoxes As Collection



Private Sub Form_Load()

    Set MazooTextBoxes = New Collection

    Set FooterTextBoxes = New Collection

    

    Dim ctl As Control

    Dim mztb As MazooTextBox

    

    For Each ctl In Controls

        If ctl.ControlType = acTextBox Then

            If ctl.Name Like "TB_NUMBER_*" And ctl.Properties("Section") = 0 Then

                Set mztb = New MazooTextBox

                mztb.Init ctl

                MazooTextBoxes.Add mztb, ctl.Name

            ElseIf ctl.Properties("Section") = 2 Then

                FooterTextBoxes.Add ctl

            End If

        End If

    Next

    BTN_CLEAR_ALL_Click

End Sub

**mazoolagh** · سه شنبه 20 آبان 1404, 19:52 عصر

برای هر تکسباکس مقدار (TB_Number) ، پراپرتی های BeforeUpdate و OnKeypress و OnExit رو به شکل زیر تعریف میکنیم:

4.png

و کدشون رو به فرم اضافه میکنیم:

Private Function OnExit()

    Dim tb As TextBox

    Set tb = CodeContextObject.ActiveControl

    If Trim(tb.Text) <> "" Then

        tb = CDbl(tb)

    End If

    Set tb = Nothing

    Calc_Statistics

End Function





Private Function ValidateNumberBox()

    Dim tb As TextBox

    Set tb = CodeContextObject.ActiveControl

    

    If (Not NumberIsValid(tb)) Then

        MsgBox _

            prompt:="Enter a number between -1E+6 and 1E+6," & vbCrLf & "or leave the field blank", _

            buttons:=vbCritical, _

            title:=CodeContextObject.Controls(tb.Properties("L  abelName")).caption

        DoCmd.CancelEvent

    End If

    Set tb = Nothing

End Function

**mazoolagh** · سه شنبه 20 آبان 1404, 19:54 عصر

و کد محاسبات آماری:

Const MIN = -1E+100

Const MAX = 1E+100



Private Sub Calc_Statistics()

    Dim count_all As Integer, sum_all As Double, min_all As Double, max_all As Double

    Dim count_pos As Integer, sum_pos As Double, min_pos As Double, max_pos As Double

    Dim count_neg As Integer, sum_neg As Double, min_neg As Double, max_neg As Double

    Dim Value As Variant

    

    min_all = MAX: max_all = MIN

    min_pos = MAX: max_pos = MIN

    min_neg = MAX: max_neg = MIN

    

    Clear_Footer

    

    Dim tb As Variant

    For Each tb In MazooTextBoxes

        If IsNull(tb.Txt) Then GoTo skip

        count_all = count_all + 1

        Value = tb.Txt

        sum_all = sum_all + Value

        If Value < min_all Then min_all = Value

        If Value > max_all Then max_all = Value

        If Value > 0 Then

            count_pos = count_pos + 1

            sum_pos = sum_pos + Value

            If Value < min_pos Then min_pos = Value

            If Value > max_pos Then max_pos = Value

        ElseIf Value < 0 Then

            count_neg = count_neg + 1

            sum_neg = sum_neg + Value

            If Value < min_neg Then min_neg = Value

            If Value > max_neg Then max_neg = Value

        End If

skip:

    Next

    

    Me.TB_COUNT_ALL = count_all

    If count_all > 0 Then

        Me.TB_SUM_ALL = sum_all

        Me.TB_AVERAGE_ALL = Round(sum_all / count_all, 3)

        If min_all < MAX Then Me.TB_MIN_ALL = min_all

        If max_all > MIN Then Me.TB_MAX_ALL = max_all

    End If



    Me.TB_COUNT_POS = count_pos

    If count_pos > 0 Then

        Me.TB_SUM_POS = sum_pos

        Me.TB_AVERAGE_POS = Round(sum_pos / count_pos, 3)

        If min_pos < MAX Then Me.TB_MIN_POS = min_pos

        If max_pos > MIN Then Me.TB_MAX_POS = max_pos

    End If



    Me.TB_COUNT_NEG = count_neg

    If count_neg > 0 Then

        Me.TB_SUM_NEG = sum_neg

        Me.TB_AVERAGE_NEG = Round(sum_neg / count_neg, 3)

        If min_neg < MAX Then Me.TB_MIN_NEG = min_neg

        If max_neg > MIN Then Me.TB_MAX_NEG = max_neg

    End If

End Sub

**mazoolagh** · سه شنبه 20 آبان 1404, 19:57 عصر

و دست آخر کد ریست کردن فرم:

Private Sub Clear_Footer()

    Dim tb As Variant

    For Each tb In FooterTextBoxes

        If tb.Name Like "TB_COUNT_*" Then

            tb.Value = 0

        Else

            tb.Value = Null

        End If

    Next

End Sub





Private Sub BTN_CLEAR_ALL_Click()

    Dim tb As Variant

    For Each tb In MazooTextBoxes

        tb.Txt.Value = Null

    Next

    Calc_Statistics

End Sub

**mazoolagh** · سه شنبه 20 آبان 1404, 20:11 عصر

در برنامه پیوست، هیچ بخش از کدها (فرم، کلاس، ماجول) وابستگی به تعداد تکسباکس های مقادیر نداره و از 1 تا جایی که خود اکسس اجازه بده میشه تکسباکس ها رو کم و زیاد کرد
بدون این که لازم باشه کد رو ویرایش کنیم.

این نتیجه مستقیم پیاده سازی shared logic و centralized event handling در validation هست.

**mazoolagh** · سه شنبه 20 آبان 1404, 20:17 عصر

روش سوم بطور دقیق یک روش مستقل نیست،
بلکه نتیجه اش یکی از این 2 روشی هست که گفته شد
و البته یک آموزش جداگانه هم نیاز داره پس میذاریم برای آخر کار.

از پست بعدی به روش چهارم که استفاده از bound form هست میپردازیم و مزایا و معایبش رو با اینها که گفته شد بررسی میکنیم.

نام تاپیک: در باره Validation و Shared Logic در فرم های UnBound

ابزار های تاپیک

نمایش

در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

نقل قول: در باره Validation و Shared Logic در فرم های UnBound

تاپیک های مشابه

کدهای logic در کدام بخش از فایلها قرار می‌گیرید؟

web logic

سوال: جدا سازی Logic از GUI

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار