نظام تقييم النجوم

[Debug Ace]

هل يمكن تصميم نظام للتقيم بالنجوم مثل

 -المنتجات والخدمات
- أداء الموظفين
- المحتوى والمقالات

صورة للتوضيح :

 

هل يمكن أن نرى ابداع رواد المنتدى المحترمين فى الافكار  و التنفيذ ....

 

تم تعديل الأحد at 20:22 بواسطه Debug Ace

[Foksh]

وعليكم السلام ورحمة الله وبركاته..

هل تقصد كهذه الفكرة على سبيل المثال :-

[Debug Ace]

5 دقائق مضت, Foksh said:

هل تقصد كهذه الفكرة على سبيل المثال :-

 

نعم 

[Foksh]

16 دقائق مضت, Debug Ace said:

نعم 

تحفيزاً ..

سأقوم بطرح فكرتي التي تمت من خلال مجموعة التحديات التي تقام كل فترة بين أعضاء مجموعة "مجتمع آكسيس جروب" على الواتس أب ..

التحدي 10 _ التقييم 5 نجوم.zip

[Debug Ace]

حلوة فكرتك يا فنان عجبتنى

بس لو عاوزين ننفذها بنفس شكل الصورة اللى انا ارفقتها ممكن ؟

[Foksh]

1 دقيقه مضت, Debug Ace said:

بس لو عاوزين ننفذها بنفس شكل الصورة اللى انا ارفقتها ممكن ؟

ارفق ملف للعمل عليه ، ومتأكد أنك ستجد أفكار أخرى جميلة وكثيرة أكثر من فكرتي المتواضعة ..

[ابوخليل]

15 ساعات مضت, Debug Ace said:

حلوة فكرتك يا فنان عجبتنى

بس لو عاوزين ننفذها بنفس شكل الصورة اللى انا ارفقتها ممكن ؟

ينفع كذا باش مهندس ؟

 

[Debug Ace]

21 دقائق مضت, ابوخليل said:

ينفع كذا باش مهندس ؟

 

ايون يا افندم ينفع طبعا طبعا وهو المطلوب تحديدا

نتشارك الافكار والاكواد ونشوف مرفقات وحركات

[ابوخليل]

تفضل  

لتقييم 5 نجوم.rar

[Debug Ace]

ممتاز ولكن 

مثلا اعطيت احد المنتجات تقييم نجمه واحدة بعد ذلك اريد ازالة النجمة فأريد عند الضغط عليها مرة اخرى يتم الغاء التقييم 

 

ومثال اخر مثلا اعطيت احد المنتجات ثلاث نجمات تقييم اريد ان اعيد التقيم الى 2 نجمه فقط فاريد ان يتم ذلك من خلال الضغط على النجمة الثالثة اذا كانت معطاة بالفعل ليتم الغائها و أعرف انه اذا تم الضغط على النجمة الثانية بالفعل سوف يتم عمل وتطبيق نفس السيناريو ولكن انا رخم اريد اقصى درجات المرونة الممكنة 

 

[Barna]

4 ساعات مضت, Debug Ace said:

ثلا اعطيت احد المنتجات تقييم نجمه واحدة بعد ذلك اريد ازالة النجمة فأريد عند الضغط عليها مرة اخرى يتم الغاء التقييم 

 

ومثال اخر مثلا اعطيت احد المنتجات ثلاث نجمات تقييم اريد ان اعيد التقيم الى 2 نجمه فقط فاريد ان يتم ذلك من خلال الضغط على النجمة الثالثة اذا كانت معطاة بالفعل ليتم الغائها و أعرف انه اذا تم الضغط على النجمة الثانية بالفعل سوف يتم عمل وتطبيق نفس السيناريو ولكن انا رخم اريد اقصى درجات المرونة الممكنة 

استخدم هذا <><><><><><><>

Private Sub btnStar1_Click()
    If Me.MyRating = 1 Then
        Me.MyRating = 0
    Else
        Me.MyRating = 1
    End If
    
    Me.Dirty = False
End Sub

Private Sub btnStar2_Click()
    If Me.MyRating = 2 Then
        Me.MyRating = 1
    Else
        Me.MyRating = 2
    End If
    
    Me.Dirty = False
End Sub

Private Sub btnStar3_Click()
    If Me.MyRating = 3 Then
        Me.MyRating = 2
    Else
        Me.MyRating = 3
    End If
    
    Me.Dirty = False
End Sub

Private Sub btnStar4_Click()
    If Me.MyRating = 4 Then
        Me.MyRating = 3
    Else
        Me.MyRating = 4
    End If
    
    Me.Dirty = False
End Sub

Private Sub btnStar5_Click()
    If Me.MyRating = 5 Then
        Me.MyRating = 4
    Else
        Me.MyRating = 5
    End If
    
    Me.Dirty = False
End Sub

 

[ابوخليل]

4 ساعات مضت, Debug Ace said:

ممتاز ولكن 

مثلا اعطيت احد المنتجات تقييم نجمه واحدة بعد ذلك اريد ازالة النجمة فأريد عند الضغط عليها مرة اخرى يتم الغاء التقييم 

ومثال اخر مثلا اعطيت احد المنتجات ثلاث نجمات تقييم اريد ان اعيد التقيم الى 2 نجمه فقط فاريد ان يتم ذلك من خلال الضغط على النجمة الثالثة اذا كانت معطاة بالفعل ليتم الغائها و أعرف انه اذا تم الضغط على النجمة الثانية بالفعل سوف يتم عمل وتطبيق نفس السيناريو ولكن انا رخم اريد اقصى درجات المرونة الممكنة 

 

اعتقد العمل ادناه ( نموذجي / مرن )  هذا ما امكنني الوصول اليه 

Private Sub SetRating(v As Integer)
    If Me.MyRating = v Then
        Me.MyRating = 0
    Else
        Me.MyRating = v
    End If
    Me.Dirty = False
End Sub

Private Sub btnStar1_Click()
SetRating 1
End Sub

Private Sub btnStar2_Click()
SetRating 2
End Sub

Private Sub btnStar3_Click()
SetRating 3
End Sub

Private Sub btnStar4_Click()
SetRating 4
End Sub

Private Sub btnStar5_Click()
SetRating 5
End Sub

 

لتقييم النجوم2.rar

[Moosak]

قد تستفيد من هذ الملف 🙂 :
(( للعلم وكما ذكر الباش مهندس فادي @Foksh كان هذا الموضوع هو عنوان تحدي مجموعة الأكسس ، وكانت هناك عدة مشاركات لمختلف الأعضاء وكانت هذه مشاركتي المتواضعة 🙂 ))

موسى الكلباني- التتحدي 10 _ التقييم 5 نجوم.accdb

[Debug Ace]

السلام عليكم ورحمة الله تعالى 

اولا كل الشكر وكل التقدير والاحترام لكل رواد المنتدى المحترمين

الافكار جميعها ولا اروع

والان حان وقت مشاركتى 

فكرتى تعتمد على عمل التالى 

كلاس موديول 

عارف ان فى اجابات احتوت على افكار بسيطة جدا جدا جدا وفعالةوفكرتى هى كالاتى 
امكانية عمل نماذج تقييم متعددة ليحتوى احد النماذج على تقييم لا يتعدى الثلاث نجوم
ونموذج اخر مثلا 5 نجوم
وممكن نموذج كمان يحتوى على 10 نجوم

فكرتى كود مركزى واحد يعمل على الجميع 
امكانية اعطاء نفس النجمة او ازالتها اما من نفس النجمة او بالنجمة التى تسبقها 

نبدأ شرح المنهج المتبع والفكرة والاكواد


انشاء وحدة نمطية عامة من النوع كلاسس باسم: clsStarRating
الكود سوف يكون:
 

Option Compare Database
Option Explicit

' ==========================================
' الثوابت الافتراضيةالخاصة
' ==========================================
Private Const DEFAULT_SOLID_STAR As Long = &H2605     ' رمز النجمة المصمتة
Private Const DEFAULT_HOLLOW_STAR As Long = &H2606    ' رمز النجمة المفرغة
Private Const DEFAULT_TOTAL_STARS As Integer = 6
Private Const MAX_STARS As Integer = 20

' ==========================================
' المتغيرات الخاصة
Private mStarCount As Integer
Private mRating As Integer
Private mSolidSymbol As Long
Private mHollowSymbol As Long
Private mLastForm As Form
Private mLastRatingField As String
Private mStarsExpression As String

' ==========================================
' التهيئة
' ==========================================
Public Sub Initialize(Optional ByVal starCount As Integer = DEFAULT_TOTAL_STARS, _
                      Optional ByVal SolidSymbol As Long = DEFAULT_SOLID_STAR, _
                      Optional ByVal HollowSymbol As Long = DEFAULT_HOLLOW_STAR)
    
    mStarCount = IIf(starCount >= 1 And starCount <= MAX_STARS, starCount, DEFAULT_TOTAL_STARS)
    mSolidSymbol = SolidSymbol
    mHollowSymbol = HollowSymbol
    mRating = 0
    ClearCache
    
End Sub

' ==========================================
' تبديل حالة التقييم
' ==========================================
Public Sub StarClick(ByVal index As Integer)
    If index < 1 Or index > mStarCount Then Exit Sub
    mRating = IIf(index = mRating, IIf(index = 1, 0, index - 1), index)
End Sub

' ==========================================
' تحميل/حفظ >-->> فائق الكفاءة
' ==========================================
Public Sub LoadFromForm(Form As Form, ratingControl As String, Optional ByVal showMessage As Boolean = False)
    On Error GoTo ErrHandler
    
    mRating = Nz(Form.Controls(ratingControl).value, 0)

CleanExit:
    Exit Sub
ErrHandler:
    Debug.Print "LoadFromForm Error #" & Err.Number & ": " & Err.Description
    If showMessage Then MsgBox Err.Description, vbCritical
    Resume CleanExit
End Sub

Public Sub SaveToForm(Form As Form, ratingControl As String, Optional ByVal showMessage As Boolean = False)
    On Error GoTo ErrHandler
    
    If Form.NewRecord Then Exit Sub
    
    Form.Controls(ratingControl).value = mRating
    If Form.Dirty Then Form.Dirty = False
    
CleanExit:
    Exit Sub
ErrHandler:
    Debug.Print "SaveToForm Error #" & Err.Number & ": " & Err.Description
    If showMessage Then MsgBox Err.Description, vbCritical
    Resume CleanExit
End Sub

' ==========================================
' محرك مركزى لتحديث عرض التقييم فى النموذج
' ==========================================
Public Sub UpdateStarsForForm(FormObj As Form, ratingFieldName As String, _
                              Optional starPrefix As String = "txtStar", _
                              Optional textBoxName As String = "txtRatingText")
    
    On Error GoTo ErrHandler
    
    Static lastForm As Form, lastField As String
    If Not lastForm Is Nothing Then
        If lastForm Is FormObj And lastField = ratingFieldName Then Exit Sub
    End If
    
    Dim i As Integer, textExpr As String
    
    For i = 1 To mStarCount
        With FormObj.Controls(starPrefix & i)
            .ControlSource = "=Switch([" & ratingFieldName & "]>=" & i & _
                             ",ChrW(" & mSolidSymbol & "),True,ChrW(" & mHollowSymbol & "))"
        End With
    Next i
    
    ' نص التقييم (مرة واحدة)
    If Len(textBoxName) > 0 Then
        textExpr = "=Switch([" & ratingFieldName & "]=0,'بدون تقييم'," & _
                   "[" & ratingFieldName & "]=1,'نجمة'," & _
                   "[" & ratingFieldName & "]=2,'نجمتان'," & _
                   "True,[" & ratingFieldName & "] & ' نجوم')"
        FormObj.Controls(textBoxName).ControlSource = textExpr
    End If
    
    ' تحديث ذاكرة الكاش
    Set lastForm = FormObj
    lastField = ratingFieldName
    
CleanExit:
    Exit Sub
ErrHandler:
    Debug.Print "UpdateStars Error: " & Err.Description
    Resume CleanExit
End Sub


' ==========================================
' تنظيف ذاكرة الكاش
' ==========================================
Private Sub ClearCache()
    Set mLastForm = Nothing
    mLastRatingField = ""
End Sub

----

اولا نبدأ بـــ :دليل التشغيل السريع  لنظام تقييم النجوم

أعداد اى نموذج
مربعات النص المطلوبة:

txtRatingValue  ← مرتبط بحقل فى الجدول نوع الحقل رقمى ليسجل قيمة التقييم مثل ←  (التقييم 0-10)

txtRatingText  ← (غير منضم ولا يرتبط بأى حقول فى الجدول) يعرض نص مثل ←  "3 نجوم"

مربعات نص txtStarX 
تبدأ من txtStar1  الى عدد النجوم التى تريد وضعها فى النموذج   مثلا ← txtStar10 (غير منضمة جميعها ولا ترتبط بأى حقول فى الجدول)  ← عرض نجوم التقييم ⭐

الأزرار btnStarX
خصائصها شفافة وتكون بنفس عدد مربعات النص السابقة وتكون مواضعها فوق مربعات النص فى المقدمة 

كود النموذج
 

Option Compare Database
Option Explicit

' ==========================================
' إعدادات النموذج الثابتة (Configuration)
' ==========================================

' عدد النجوم
Private Const cintTotalStars As Integer = 10
' حقل التقييم
Private Const cstrRatingControl As String = "txtRatingValue"
' بادئة أزرار النجوم
Private Const cstrButtonPrefix As String = "btnStar"
' بادئة مربعات نص النجوم
Private Const cstrStarPrefix As String = "txtStar"
' نص التقييم
Private Const cstrTextControl As String = "txtRatingText"

Private StarEngine As clsStarRating

' ==========================================
' فتح النموذج - التهيئة الكاملة
' ==========================================
Private Sub Form_Open(Cancel As Integer)
    On Error GoTo ErrHandler

    Dim ctl As Control

    ' إنشاء محرك النجوم
    Set StarEngine = New clsStarRating
    StarEngine.Initialize cintTotalStars

    ' تحميل التقييم الحالي
    If Not Me.NewRecord Then
        StarEngine.LoadFromForm Me, cstrRatingControl
    End If

    ' ربط أزرار النجوم ديناميكيا
    For Each ctl In Me.Controls
        If ctl.ControlType = acCommandButton And ctl.Name Like cstrButtonPrefix & "*" Then
            ctl.OnClick = "=HandleStarClick(""" & ctl.Name & """)"
        End If
    Next ctl

    ' تحديث العرض
    StarEngine.UpdateStarsForForm Me, cstrRatingControl, cstrStarPrefix, cstrTextControl

CleanExit:
    Exit Sub
ErrHandler:
    Debug.Print "Form_Open Error #" & Err.Number & ": " & Err.Description
    MsgBox "خطأ في التهيئة: " & Err.Description, vbCritical, "Star Rating"
    Resume CleanExit
End Sub

' ==========================================
' معالج ربط أحداث أزرار تقييم النجوم الديناميكي (مركزي)
' ==========================================
Public Function HandleStarClick(ByVal strButtonName As String) As Variant
    On Error GoTo ErrHandler

    Dim intStarIndex As Integer
    intStarIndex = Val(Mid(strButtonName, Len(cstrButtonPrefix) + 1))

    ' التحقق من صحة النجمة
    If intStarIndex < 1 Or intStarIndex > cintTotalStars Then
        HandleStarClick = False
        Exit Function
    End If

    ' تسلسل العمليات: Load >> Click >> Save >> Refresh
    StarEngine.LoadFromForm Me, cstrRatingControl
    StarEngine.StarClick intStarIndex
    StarEngine.SaveToForm Me, cstrRatingControl, False  ' False = no message (بدون رسائل)

    HandleStarClick = True

CleanExit:
    Exit Function
ErrHandler:
    Debug.Print "HandleStarClick Error [" & strButtonName & "] #" & Err.Number & ": " & Err.Description
    HandleStarClick = False
    Resume CleanExit
End Function

' ==========================================
' إغلاق آمن
' ==========================================
Private Sub Form_Unload(Cancel As Integer)
    Set StarEngine = Nothing
End Sub

وطبعا يتم تعديل الاعدادت فى اعلى كود النموذج حسب المسميات ان اردت تغييرها فى النموذج بما يناسبك انت
' عدد النجوم
Private Const cintTotalStars As Integer = 10
' حقل التقييم
Private Const cstrRatingControl As String = "txtRatingValue"
' بادئة أزرار النجوم
Private Const cstrButtonPrefix As String = "btnStar"
' بادئة مربعات نص النجوم
Private Const cstrStarPrefix As String = "txtStar"
' نص التقييم
Private Const cstrTextControl As String = "txtRatingText"

وبكده يكون معانا فكرة وتنفيذ لكود مرن لا يتطلب اى تدخل منك فى المستقبل 
ان اردت زيادة اعداد عناصر التقييم الا فقط باتباع نهج المواضع والمسميات
لا تعديل فى الكود ولن تحتاج الى اضافة اى اكواد فى النموذج
امكانية عمل اكثر من نموذج للتقييم فى نفس قاعدة البيانات على ان يكون لكل نموذج عدد تقييمات خاصة به وتختلف عن غيره


وأخيرا اليكم مرفقا للتجربة والتقييم للفكرة وألية العمل 

الاستاذ الفاضل @ابوخليل اترك لكم حرية اختيار افضل اجابة  لتكون مرجعا لرواد المنتدى ولكم خالص الشكر والتقدير  
 

لتقييم النجوم ( V1.2).accdb.zip

تم تعديل منذ 56 دقائق بواسطه Debug Ace

[Foksh]

بهذه الإجابة .. ثبتت الرؤية 1000000% 

حد فاهمني 

[Debug Ace]

1 دقيقه مضت, Foksh said:

بهذه الإجابة .. ثبتت الرؤية 1000000% 

حد فاهمني 

رؤية اية معذرة انا مش فاهم حاجة هل فى اى مشكلة