صندوق رسائل عربي هدية : صندوق رسائل عربى وملونة - مرونة فى التعامل وسهولة فى الاستخدام

[ابو جودي]

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

من منا يمل من كثرة استخدام الرسائل مثلى ويظل يفكر فى كل مرة كيف سيكتب الكود المناسب 

الان موديول واحد به الحل النهائى المرن فى التعامل مع الرسائل

وحتى لا ننسي الفضل لاصحاب هذا العمل الحقيقين

الاستاذ @أبو هادي     >>---->  تعريب الصندوق

الاستاذ @ابوخليل      >>---->  تعريب الصندوق

الاستاذ @أبو آدم       >>---->  تلوين محتوى الرسالة

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

- ملاحظة للمرة الاولى احاول التوفيق بين الأكواد التى تعمل على كل من النواتين  64 بيت والـ 32  بيت   ولا اعلم صراحة هل وفقت فى ذلك ام لا

شرح سريع لمحتوى المثال المرفق

اولا أكواد الموديول هذا الكود للاستاذ الجليل الاستاذ @أبو آدم 

'----  اللألوان   --------------------------------------------------------------------------------
#If Win64 Then
     Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
     Declare PtrSafe Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
#Else
     Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
     Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
#End If

Public DefaultColour As Long
Public Const COLOR_WINDOWTEXT As Long = 8
Public Const CHANGE_INDEX As Long = 1

 

طريقة استخدام الكود بالاستدعاء داخل اى مكان بالبرنامج

DefaultColour = GetSysColor(COLOR_WINDOWTEXT)                   '     تخزين لون ثيم النظام الافتراضي
SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbRed              '     اضبط لون ثيم النظام على اللون الأحمر 
MsgBox "you welcome in officena forums", , "welcome"            '     كود الرسالة
SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, defaultColour      '     استعادة القيمة الافتراضية بعد اغلاق الرسالة

الشرح تفصيلا لكل سطر بالكود

DefaultColour = GetSysColor(COLOR_WINDOWTEXT)

هذا السطر لحفظ تنسيق الالوان المستخدم فى ثيم الويندوز 

ثم

SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbRed

هذا يغير اعدادت ثيم الويندوز لتغير لون الكتابة الى اللون الاحمر طبعا يمكن تغيير اللون كيفما تريد بتغير    vbRed   الى ما تريده انت  

ثم نكتب الرسالة داخل الكود المخصص لها مثلا

MsgBox "you welcome in officena forums", , "welcome"

ثم بعد عرض الرسالة العودة مرة اخرى للون المفضل لثيم الويندوز والذى اختفظنا به فى الجزء الاول من الكود 

SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, DefaultColour

وبهذا انتهى جزء تلوين محتوى النص للرسالة

 

 

الجزء الثانى من الكود داخل الموديول والخاص بتعريب الأزرار  الاستاذ @ابوخليل    /  الاستاذ @أبو هادي   

#If Win64 Then
     Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
     Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
     Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
     Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
     Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
#Else
     Declare Function GetCurrentThreadId Lib "kernel32" () As Long
     Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
     Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
     Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
     Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
#End If

Private m_hHook As Long
 Const IDOK = 1
 Const IDCANCEL = 2
 Const IDABORT = 3
 Const IDRETRY = 4
 Const IDIGNORE = 5
 Const IDYES = 6
 Const IDNO = 7
 Const IDCLOSE = 8
 Const IDHELP = 9
 Const WH_CBT = 5
 Const GWL_HINSTANCE = (-6)
 Const HCBT_ACTIVATE = 5

Public Sub MessageBoxFullArabicButtons(hwndThreadOwner As Long)
 Dim hInstance As Long
 Dim hThreadId As Long
  hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
    hThreadId = GetCurrentThreadId()
      m_hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)
End Sub

Private Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If uMsg = HCBT_ACTIVATE Then
    SetDlgItemText wParam, IDOK, "موافق"
    SetDlgItemText wParam, IDCANCEL, "إلغاء"
    SetDlgItemText wParam, IDABORT, "إحباط"
    SetDlgItemText wParam, IDRETRY, "إعادة"
    SetDlgItemText wParam, IDIGNORE, "تجاهل"
    SetDlgItemText wParam, IDYES, "نعم"
    SetDlgItemText wParam, IDNO, "لا"
    SetDlgItemText wParam, IDCLOSE, "إغلاق"
    SetDlgItemText wParam, IDHELP, "مساعدة"
    UnhookWindowsHookEx m_hHook
  End If
  MsgBoxHookProc = False
End Function

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

Public Function MyMesg(Mesgtxt As String, _
                      Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
                      Optional ByVal Title As String = "تطوير صندوق الرسائل العربى من منتديات اوفيسنا", _
                      Optional ByVal HelpFile As Variant, _
                      Optional ByVal Context As Variant) As VbMsgBoxResult

MessageBoxFullArabicButtons Application.hWndAccessApp
  MyMesg = MsgBox(Mesgtxt, Buttons + vbMsgBoxRtlReading + vbMsgBoxRight + vbDefaultButton1, Title)
End Function

 

نلاحظ الاتى بوجه عام هذا الكود تم تصميمه على ان يكوم اقتراضيا بهذا الشكل

الرسالة بسيطة تحتوى على زر امر واحد     Buttons As VbMsgBoxStyle = vbOKOnly
عنوان الرسالة الإفتراضى     Title As String = "تطوير صندوق الرسائل العربى من منتديات اوفيسنا"

الجزء من الكود هذا  MessageBoxFullArabicButtons Application.hWndAccessApp   الذى يستدعى تعريب الازرار

السطر الاخير البناء الطيعى لتكوين كود الرسالة بالاضافات التى يفضلها المبرمج
MyMesg = MsgBox(Mesgtxt, Buttons + vbMsgBoxRtlReading + vbMsgBoxRight + vbDefaultButton1, Title)

طريقة استخدام الكود بالاستدعاء داخل اى مكان بالبرنامج

MyMesg "منتديات أوفيسنا ترحب بكم"

لتغيير العنوان الافتراضى

MyMesg "منتديات أوفيسنا ترحب بكم",,"العنوان الجديد كما تريد"

استخدام الاضافات لتغيير الازرار مثلا

MyMesg "هل أعجبتك هذه الترجمة و التعديلات والأفكار؟", vbYesNo

مع عنوان مخصص

MyMesg "هل أعجبتك هذه الترجمة و التعديلات والأفكار؟", vbYesNo,"عنوان جديد"

 

والان وصلنا الى نهاية الموضوع 

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

امين امين امين

 

 

Full Arabic Message Box.accdb

 

Full Arabic Message Box.mdb

تم تعديل يونيو 13, 2019 بواسطه ابا جودى

[محمد قاسم 12]

بارك الله فيك استاذى 

 

[الحلبي]

والله ازرار جميلة وافكار مبدعة جزاهم الله خير كل من شاركوا في هذا العمل

وجزاك الله خير يا بشمهندسنا ومبدعنا قاهر الاكسس / ابا جودي

[ابو فتحى]

ممكن نسخة 2003

[ابو جودي]

اتقضل

وارجوك اخبرنى النتيجة بعد التجربة على اصدار الاوفيس لديك

Full Arabic Message Box.mdb

@ابو فتحى لا تنسي ان تخبرنى بالنتيجة رجاء

[ابو فتحى]

عمل اكثر من رائع بجد جزاهم الله خير كل من شارك فى هذا العمل

[عمرو العاصى]

بارك الله فيك أخى

[SEMO.Pa3x]

طريقة جميلة, احسنت عزيزي, سبق وطرحت موضوع عن MessageBox بطريقة مختلفة.

 

الموضوع يخص Visual .NET

 

[ابو جودي]

6 دقائق مضت, SEMO.Pa3x said:

طريقة جميلة, احسنت عزيزي, سبق وطرحت موضوع عن MessageBox بطريقة مختلفة.

 

الموضوع يخص Visual .NET

  

ولكن هنا جمهورية الاكسس 

استاذ @SEMO.Pa3x 

اولا اهلا بعودتكم اطلتم علينا الغياب واشتقنا لكم كثيرا عله خيرا ان شاء الله

ثانيا ممكن طلب استاذى لو امكن

المرفق هنا الذى يخص هذا الموضوع يعمل بشكل رائه بتعريب الازرار ان كان اعداد النموذج  pop up=no

اما ان كان pop up= yes

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

 

[محمد السيد الشاطر]

عمل اكثر من رائع اخونا المبدع دائما أبا جودى لكن هل هناك تحكم بحجم خط الرسالة ونوع الخط المستخدم

[SEMO.Pa3x]

6 دقائق مضت, ابا جودى said:

ولكن هنا جمهورية الاكسس 

استاذ @SEMO.Pa3x 

اولا اهلا بعودتكم اطلتم علينا الغياب واشتقنا لكم كثيرا عله خيرا ان شاء الله

ثانيا ممكن طلب استاذى لو امكن

المرفق هنا الذى يخص هذا الموضوع يعمل بشكل رائه بتعريب الازرار ان كان اعداد النموذج  pop up=no

اما ان كان pop up= yes

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

 

 

جربت الـ pop up =yes ولم تتغير الترجمة, ضلت عربية.

لو كنت مهتم بلغة VB.NET هذا الموضوع يفيدك.

 

https://www.codeproject.com/Articles/8816/MessageBox-Translation-Hook

 

نفس الي قمت بعمله لكن بلغة NET.

[ابو جودي]

8 دقائق مضت, SEMO.Pa3x said:

 

جربت الـ pop up =yes ولم تتغير الترجمة, ضلت عربية.

لو كنت مهتم بلغة VB.NET هذا الموضوع يفيدك.

 

https://www.codeproject.com/Articles/8816/MessageBox-Translation-Hook

 

نفس الي قمت بعمله لكن بلغة NET.

انا لم اتعامل الا مع الاكسس

انا لست مبرمجا اسا

واسال فيما يخص الاكسس فقط