هدية: من اليمين الى اليسار، مربع القائمة ListBox والشجرة TreeView

[jjafferr]

السلام عليكم

 

1.

من المعروف ان تنسيق النص في مربع القائمة ListBox هو من اليسار الى اليمين ،

مشكلة كانت تصادفني دائما ، وهو تنسيق القيم في مربع القائمة لتكون من اليمين الى اليسار بالنسبة للغة العربية (طريقة تغيير مربع القائمة الى مربع تحرير ونص ، ثم عمل التنسيق عليه من اليمين الى اليسار ، ثم اعادته الى مربع قائمة لا يعمل معظم الوقت) ،

موقع http://www.lebans.com  والذي يحتوي على مالذ وطاب عنده طريقه لهذا التنسيق: http://www.lebans.com/justicombo.htm كذلك.

 

 

2.

ونفس المشكلة مع موضوع تنسيق الشجرة TreeView من اليمين الى اليسار.

 

 

النتيجة:

 

 

و

 

 

وطريقة العمل ،

يوضع هذا الكود في وحدة نمطية:

Option Compare Database
Option Explicit

#If VBA7 And Win64 Then
    '64 bits
  Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
  Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Public Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Long, ByVal bErase As Long) As Long
  Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
  Public Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
  Public Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
  
  Dim hwnd As LongPtr
  
#Else
    '32 bits
  Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long
  Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
  Public Declare Function GetFocus Lib "user32" () As Long
  Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  
  Dim hwnd As Long
  
#End If

Public Const GW_CHILD = 5
Public Const WS_EX_LAYOUTRTL = &H400000
Public Const GWL_EXSTYLE = (-20)



Function RTL_Set(frm As Form, ctl As Control)
    
    Dim varHwnd As Variant
    Dim OldLong As Long
    
    frm.SetFocus
    ctl.SetFocus
    varHwnd = GetFocus()
    OldLong = GetWindowLong(varHwnd, GWL_EXSTYLE)
    SetWindowLong varHwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
    InvalidateRect hwnd, 0, False
    
End Function

Function RTL_SetTree(frm As Form, ctl As Control)

    Dim OldLong As Long
    
    OldLong = GetWindowLong(ctl.hwnd, GWL_EXSTYLE)
    SetWindowLong ctl.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
    InvalidateRect hwnd, 0, False
    
End Function



'
' From http://www.microsoft.com/middleeast/msdn/faq.aspx
'
'Place OnLoad of the Form

'    Dim OldLong As Long
    'For Form
'    OldLong = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
'    SetWindowLong Me.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
'    InvalidateRect hwnd, 0, False
    'For List
'    OldLong = GetWindowLong(List1.hwnd, GWL_EXSTYLE)
'    SetWindowLong List1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
'    InvalidateRect hwnd, 0, False
    'For The StatusBar
'    OldLong = GetWindowLong(StatusBar1.hwnd, GWL_EXSTYLE)
'    SetWindowLong StatusBar1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
'    InvalidateRect hwnd, 0, False
    'For TreeView
'    Dim nodX As Node
'    Set nodX = TreeView1.Nodes.Add(, , "R", "Root")
'    Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1")
'    Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2")
'    Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3")
'    Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4")
'    nodX.EnsureVisible
'    OldLong = GetWindowLong(TreeView1.hwnd, GWL_EXSTYLE)
'    SetWindowLong TreeView1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
'    InvalidateRect hwnd, 0, False
    'For ListView
'    OldLong = GetWindowLong(ListView1.hwnd, GWL_EXSTYLE)
'    SetWindowLong ListView1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
'    InvalidateRect hwnd, 0, False
    'For ProgressBar
'    ProgressBar1.Value = 50
'    OldLong = GetWindowLong(ProgressBar1.hwnd, GWL_EXSTYLE)
'    SetWindowLong ProgressBar1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
'    InvalidateRect hwnd, 0, False
    'For ToolBar
'    mhwnd = GetWindow(Toolbar1.hwnd, GW_CHILD)
'    OldLong = GetWindowLong(mhwnd, GWL_EXSTYLE)
'    SetWindowLong mhwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
'    InvalidateRect hwnd, 0, False
    

في اسفل الكود انا تركت الكود لبقية الاشياء اللي يمكن عملها من اليمين الى اليسار.

 

 

اما تنفيذ التنسيق لمربع القائمة ، فهو وضع هذا الكود عند تحميل النموذج الذي يحتوي على هذا المربع (وهنا اسم حقل مربع القائمة هو List0_RTL ) :

    'ListBox RTL
    Call RTL_Set(Me, List0_RTL)

وتنسيق الشجرة ، فهو وضع هذا الكود عند تحميل النموذج الذي يحتوي على الشجرة (وهنا اسم الشجرة هو TreeView1) :

    'TreeView RTL
    Call RTL_SetTree(Me, TreeView1)

وللأمانة العلمية ، فاني استخدم قاعدة البيانات التي وضعها الاخ محمد في الرابط: http://www.officena.net/ib/index.php?showtopic=60781

 

 

جعفر

تعديل 1: 18-11-2021 ، جعل البرنامج يعمل على النواتين 32بت و 64 بت

 

 

54.RTL_TreeView_ListBox_32bits_n_64bits.accdb.zip

[رمهان]

هدية رائعة من استاذ واخ رائع !!

 

واكرر اعجابي باتجاه التري فيو من اليمين لليسار ( عربي ) 

 

[ابو جودي]

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

[ابو الآء]

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

وربنالا يحرمن من علمكم الكبير

[jjafferr]

وحيا الله الشباب 

 

أخوي رمهان 

وأخوي محمد 

وأخوي أبوآلآء  

 

وشكرا على لطيف كلماتكم 

 

 

جعفر

[أبو عبدالله الحلوانى]

جزاك الله خيرا أستاذنا جعفر

ما أروع هداياك لا حرمنا الله منك

زادك الله من فضله وكرمه

[محمد سلامة]

الله الله الله عليك استاذنا جعفر

بارك الله فيك

[osama.okn]

جزاكم الله خيرا 

[علي المصري]

شكرا جزيلا

جزاكم الله خيرا

[أبورحيل]

السلام و عليكم هل ممكن تلوين أعلى مربع القائمة (العنوان) ؟

[jjafferr]

وعليكم السلام 

 

الجواب لا ، ولكن:

موقع Lebans.com وهو من افضل مواقع الاكسس القديمة ، وفيها الدُر النفيس 

الرابط هذا فيه غايتك:

http://www.lebans.com/listboxenhanced.htm

 

واما اذا في شدّة وما يهمك تشتري ، فاليك هذا الرابط:

http://www.dbi-tech.com/ComponentPage_ctList.aspx

 

جعفر

 

[أبورحيل]

شكرا على التواصل و بارك االله فيك أخي جعفر

[at_aziz]

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

جزاك الله خير وبارك فيك اخي جعفر 

اشكرك على هذا المجهود المبارك والمفيد

اخي عندي سؤوال

كيف افتح نموذج عن طريق الشجره 

كماهو موضح بالصروه المرفقه

ارجو الافادة 

وفقك الله ورعاك

 

[ندي احمد كمال]

بارك الله فيك

وسلمت يمينك فكرة رائعه جدا

[jjafferr]

منذ ساعه, at_aziz said:

كيف افتح نموذج عن طريق الشجره

حياك الله أخوي 

 

في الرابط التالي ، انا حاولت اوضح كل ما اعرف عن الشجرة ، وان شاء الله توصل للذي تريد:

 

واذا محتاج مساعدة زيادة ، رجاء فتح موضوع جديد 

 

 

جعفر

[at_aziz]

جزاك الله خير اخي جعفر 

الحقيقه ماعرفت كيف اطبق الكود بيحيث لما انقر الى العنصر يفتح نموذج 

حقيقه ماعرفت

اذا فيه مجال  تعمل لنا الكود على المثال السابق 

جزاك الله خير

واذا مافيه مجال نفتح موضمع جديد\

وفقك الله ورعاك اخي

[jjafferr]

7 دقائق مضت, at_aziz said:

جزاك الله خير اخي جعفر 

الحقيقه ماعرفت كيف اطبق الكود بيحيث لما انقر الى العنصر يفتح نموذج 

حقيقه ماعرفت

اذا فيه مجال  تعمل لنا الكود على المثال السابق 

جزاك الله خير

واذا مافيه مجال نفتح موضمع جديد\

وفقك الله ورعاك اخي

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

 

جعفر