شخابيط ابو جودي : استبدال كود الرسائل بنموذج مخصص للرسائل

[ابو جودي]

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

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

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

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

مثال لكى تكون الصورة اكثر وضوحا

الرسالة بالعربى وهنا يريد المصمم ان تكون لغة الازرار كذلك بالعربى ولكن لغة واجهة الاستخدام انجليزية وعنوان الزر يظهر تبعا للغة الويندوز

تم التغلب عليها مسبقا باستخدام دوال الـ API ولست بصدد الحديث عنها لان بها قيد وهو

- شرط لان يتم تغيير اسماء الازرار فى صندوق الرسائل بالاسماء التى يرغب بها المستخدم ان تكوت الخصيصة pop up  للنموج = No

وهذا فيه تقييد للمصمم وخاصة ان كان يستخدم هذه الخصيصة بالشكل التالى pop up  للنموج = Yes

وكان الحل البديل هو عمل نموذج للرسائل بدلا من استخدام صندوق الرسائل

واعتقد تم عمل ذلك مسبقا فى المنتدى ولكن انا الان اقدمه بافضل اسلوب احترافى واكثر مرونه.

لعمل ذلك اولا قم بتصميم نموذج للرسائل واعطه الاسم  : frmCustomMessageBox

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

الان افتح نموذج الرسائل "frmCustomMessageBox" فى وضع التصميم

اضف العناصر التاليه 

عدد 5 عنصر "Buttons" أزرار أوامر على ان تكون الاسماء للازرار كالتالى  : Button0 , Button1 , Button2 , Button3 , Button4

عدد 1 عنصر "Labels" عنوان : على ان يكون اسمه كالتالى   : MessageLabel
عدد 1 عنصر "Image" صورة  : على ان يكون اسمه كالتالى : IconImage

والان اضف وحدة نمطية عامة واعطها مثلا الاسم : basCustomMessageBox

اضف اليها الكود التالى 

' متغير لتخزين رقم الزر الذي تم الضغط عليه في نموذج الرسائل المخصص.
Private intPressedButton As Integer

' دالة لعرض صندوق رسائل مخصص
' Parameters:
'   - arrMessageLines: مصفوفة تحتوي على أسطر الرسالة.
'   - strTitle: عنوان صندوق الرسائل.
'   - strButtons: قائمة أزرار مفصولة بفواصل.
'   - arrTooltips: مصفوفة تحتوي على تلميحات للأزرار (اختياري).
'   - strIconPath: مسار الأيقونة (اختياري).
' Returns:
'   - رقم الزر الذي تم الضغط عليه (بدءًا من 0 إلى 4)، أو -1 في حالة حدوث خطأ.
Function MsgBx(arrMessageLines As Variant, strTitle As String, strButtons As String, Optional arrTooltips As Variant = Null, Optional strIconPath As String = "") As Integer
    On Error GoTo ErrorHandler

    Dim frmCustomMsgBox As Form
    Dim ctrlCurrent As Control
    Dim strButtonCaption As Variant
    Dim intButtonIndex As Integer
    Dim arrButtonCaptions As Variant
    Dim strMessage As String
    Dim strLine As Variant
    Dim strFormName As String
    
    strFormName = "frmCustomMessageBox"
    
    ' بناء الرسالة من الأسطر الممررة
    strMessage = ""
    For Each strLine In arrMessageLines
        If strMessage <> "" Then
            strMessage = strMessage & vbCrLf ' إضافة سطر جديد بين الأسطر
        End If
        strMessage = strMessage & strLine
    Next strLine

    ' التحقق إذا كان النموذج مفتوحًا
    If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> 0 Then
        ' إذا كان النموذج مفتوحًا، فقط استعد المرجع إليه
        Set frmCustomMsgBox = Forms(strFormName)
    Else
        ' إذا لم يكن مفتوحًا، افتحه
        DoCmd.OpenForm strFormName, acNormal, , , , acHidden
        Set frmCustomMsgBox = Forms(strFormName)
    End If

    ' إعداد خصائص النموذج
    With frmCustomMsgBox
        .Caption = strTitle
        .Controls("MessageLabel").Caption = strMessage

        ' إظهار التسمية فقط إذا كان هناك نص
        .Controls("MessageLabel").Visible = (strMessage <> "")

        ' إضافة الأزرار الجديدة بناءً على strButtons
        intButtonIndex = 0
        arrButtonCaptions = Split(strButtons, ",")
        For Each strButtonCaption In arrButtonCaptions
            With .Controls("Button" & intButtonIndex)
                .Caption = strButtonCaption
                .Visible = True
                .OnClick = "=PressedButton(" & intButtonIndex & ")"
                
                ' تعيين التلميحات للأزرار إذا تم تمريرها
                If Not IsNull(arrTooltips) And IsArray(arrTooltips) Then
                    If intButtonIndex <= UBound(arrTooltips) Then
                        .ControlTipText = arrTooltips(intButtonIndex)
                    End If
                End If
            End With
            intButtonIndex = intButtonIndex + 1
        Next strButtonCaption

        ' تعيين الأيقونة إذا كان مسارها موجودًا
        If strIconPath <> "" Then
            If Dir(strIconPath) <> "" Then
                ' إذا كانت الأيقونة موجودة، قم بتعيينها
                On Error Resume Next ' تجاهل الخطأ إذا حدث
                .Controls("IconImage").Picture = strIconPath
                If Err.Number <> 0 Then
                    ' إذا حدث خطأ، أخفي عنصر التحكم
                    .Controls("IconImage").Visible = False
                    Err.Clear
                Else
                    .Controls("IconImage").Visible = True
                End If
                On Error GoTo ErrorHandler ' العودة إلى إدارة الأخطاء العادية
            Else
                ' إذا لم تكن الأيقونة موجودة، أخفي عنصر التحكم
                .Controls("IconImage").Visible = False
            End If
        Else
            ' إذا لم يتم تمرير أيقونة، أخفي عنصر التحكم
            .Controls("IconImage").Visible = False
        End If
    End With

    ' إظهار النموذج كمودال
    DoCmd.OpenForm strFormName, acNormal
    intPressedButton = -1

    ' انتظار المستخدم لتحديد زر
    Do
        DoEvents
    Loop Until intPressedButton > -1

    ' إرجاع القيمة وإغلاق النموذج
    DoCmd.Close acForm, strFormName, acSaveNo
    MsgBx = intPressedButton

    Exit Function

ErrorHandler:
    ' إرجاع قيمة تشير إلى فشل العملية
    MsgBx = -1
    MsgBox "حدث خطأ: " & Err.Number & " | " & Err.Description
    Debug.Print "حدث خطأ: " & Err.Number & " | " & Err.Description
    Exit Function
End Function

Function PressedButton(intButtonIndex As Integer)
    ' تسجيل الرقم الخاص بالزر المضغوط
    intPressedButton = intButtonIndex
End Function

 

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

' تعريف متغير لتخزين نتيجة اختيار المستخدم من النافذة المنبثقة
Dim Result As Integer
Result = MsgBx(Array("سيتم حذف جميع البيانات", "هل أنت متأكد من المتابعة؟"), "تحذير", "نعم,لا", Array("اضغط هنا للموافقة", "اضغط هنا للإلغاء"), "Full-Path\error.png")

If Result = 0 Then
    MsgBox "تم اختيار موافق"
ElseIf Result = 1 Then
    MsgBox "تم اختيار إلغاء"
End If

ولكن الطريقة الأمثل لسهولة التعديل والاضافة والصيانة فى المستقبل يكون الاستدعاء بالشكل التالى 

' تعريف المتغيرات المستخدمة
Dim MessageLines As Variant    ' تخزين سطور الرسالة (نص رئيسي وفرعي)
Dim TitleText As String        ' عنوان النافذة المنبثقة
Dim ButtonsText As String      ' نص الأزرار (مفصولة بفواصل)
Dim Result As Integer          ' نتيجة اختيار المستخدم
Dim IconPath As String         ' مسار ملف أيقونة التحذير
Dim Tooltips As Variant        ' تلميحات توضيحية عند التمرير على الأزرار

' تعيين مسار ملف الأيقونة التحذيرية (يجب التأكد من صحة المسار)
IconPath = "Full-Path\error.png"

    ' تهيئة محتوى الرسالة:
    MessageLines = Array("سيتم حذف جميع البيانات", "هل أنت متأكد من المتابعة؟")
    
    TitleText = "تحذير"  ' عنوان النافذة المنبثقة
    ButtonsText = "نعم,لا"  ' خيارات الأزرار (الزر الأول: نعم، الزر الثاني: لا)
    
    ' تعيين التلميحات التوضيحية عند تمرير الماوس على الأزرار:
    ' تلميح للزر الأول (نعم)
    ' تلميح للزر الثاني (لا)
    Tooltips = Array("اضغط هنا للموافقة", "اضغط هنا للإلغاء")
    
    ' استدعاء الدالة المخصصة لعرض الرسالة:
    ' محتوى الرسالة -العنوان - اسماء الأزرار - التلميحات - مسار الأيقونة
    Result = MsgBx(MessageLines, TitleText, ButtonsText, Tooltips, IconPath)
    
    ' معالجة النتيجة المرجعة من الدالة:
    If Result = -1 Then
        ' حالة الخطأ (-1 تعني فشل في عرض الرسالة)
        MsgBox "حدث خطأ أثناء عرض الرسالة."
    ElseIf Result = 0 Then
        ' الزر الأول (نعم) تم اختياره
        MsgBox "تم اختيار نعم"
    ElseIf Result = 1 Then
        ' الزر الثاني (لا) تم اختياره
        MsgBox "تم اختيار لا"
    End If

لتكون النتيجة كما بالشكل التالى من النموج بدلا من صندوق الرسائل التقليدى 

طبعا يمكن تغيير اسماء الازرار عند الاستدعاء من السطر : ButtonsText = "نعم, لا"  
ليكون مثلا 
ButtonsText = "موافق , الغاء"  

وطبعا تغير السطر : MsgBox "تم اختيار نعم"
باضافة الكود الذى تريده عند الضغط على الزر انا فقط كتبت الرسالة فى كود الاستدعاء لتوضيح انه سوف يتم تنفيذ الامر 

 

ملحوظة :

استخدام : Tooltips وهو التلميح عندما يحوم الماوس فوق الازرار فى النموذج اختيارى ممكن عدم استخدامه
كذلك 
استخدام : IconPath وهو مسار لصورة ايقونة تدل على الرسالة اختيارى ممكن عدم استخدامه 

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

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

تحياتى الحارة 

 

CustomMessageBox.zip

تم تعديل يناير 25, 2025 بواسطه ابو جودي
اضافة مرفق

[ابو ياسين المشولي]

دائمك مبدع

ولو اضفنا هطذا كيف
Dim MessageLines As Variant    ' تخزين سطور الرسالة (نص رئيسي وفرعي)
Dim TitleText As String        ' عنوان النافذة المنبثقة
Dim ButtonsText As String      ' نص الأزرار (مفصولة بفواصل)
Dim Result As Integer          ' نتيجة اختيار المستخدم
Dim IconPath As String         ' مسار ملف أيقونة التحذير
Dim Tooltips As Variant        ' تلميحات توضيحية عند التمرير على الأزرار
Dim MessageLines2 As Variant    ' تخزين سطور الرسالة (نص رئيسي وفرعي)
Dim Tooltips2 As Variant        ' تلميحات توضيحية عند التمرير على الأزرار
Dim ButtonsText2 As String      ' نص الأزرار (مفصولة بفواصل)

' تعيين مسار ملف الأيقونة التحذيرية (يجب التأكد من صحة المسار)
IconPath = "C\Resources\Fav Ico\error.png"

    ' تهيئة محتوى الرسالة:
    MessageLines = Array("سيتم حذف جميع البيانات", "هل أنت متأكد من المتابعة؟")
    MessageLines2 = Array("تم اختيار ", "نعم")
    TitleText = "تحذير"  ' عنوان النافذة المنبثقة
    ButtonsText = "موافق , الغاء"  ' خيارات الأزرار (الزر الأول: نعم، الزر الثاني: لا)
    
    ' تعيين التلميحات التوضيحية عند تمرير الماوس على الأزرار:
    ' تلميح للزر الأول (نعم)
    ' تلميح للزر الثاني (لا)
    Tooltips = Array("اضغط هنا للموافقة", "اضغط هنا للإلغاء")
    
    ' استدعاء الدالة المخصصة لعرض الرسالة:
    ' محتوى الرسالة -العنوان - اسماء الأزرار - التلميحات - مسار الأيقونة
    Result = MsgBx(MessageLines, TitleText, ButtonsText, Tooltips, IconPath)
    
    ' معالجة النتيجة المرجعة من الدالة:
    If Result = -1 Then
        ' حالة الخطأ (-1 تعني فشل في عرض الرسالة)
        MsgBox "حدث خطأ أثناء عرض الرسالة."
    ElseIf Result = 0 Then
        ' الزر الأول (نعم) تم اختياره
IconPath = "C\Resources\Fav Ico\error.png"
    ButtonsText2 = "موافق  "  ' خيارات الأزرار (الزر الأول: نعم، الزر الثاني: لا)

    ' تهيئة محتوى الرسالة:
'    MessageLines = Array("سيتم حذف جميع البيانات", "هل أنت متأكد من المتابعة؟")
    
    TitleText = "تحذير"  ' عنوان النافذة المنبثقة
    ButtonsText = "موافق , الغاء"  ' خيارات الأزرار (الزر الأول: نعم، الزر الثاني: لا)
    
    ' تعيين التلميحات التوضيحية عند تمرير الماوس على الأزرار:
    ' تلميح للزر الأول (نعم)
    ' تلميح للزر الثاني (لا)
    Tooltips2 = Array("تم اختيار", "نعم")
    
    ' استدعاء الدالة المخصصة لعرض الرسالة:
    ' محتوى الرسالة -العنوان - اسماء الأزرار - التلميحات - مسار الأيقونة
    Result = MsgBx(MessageLines2, TitleText, ButtonsText2, Tooltips2, IconPath)
    ElseIf Result = 1 Then
        ' الزر الثاني (لا) تم اختياره
        MsgBox "تم اختيار لا"
    End If