اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

السلام عليكم

 

1.

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

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

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

 

 

2.

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

 

 

النتيجة:

RTL.Clipboard01.jpg.231f83a922d4488009b85c909e655e13.jpg

 

 

و

 

RTL.Clipboard02.jpg.bebb0992224598674894f9f77a443f0b.jpg

 

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

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

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

  • Like 8
  • Thanks 1
قام بنشر

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

 

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

 

  • Like 1
قام بنشر

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

  • Like 1
قام بنشر

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

 

أخوي رمهان  :smile:

وأخوي محمد  :smile:

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

 

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

 

 

جعفر

  • 9 months later...
قام بنشر

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

 

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

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

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

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

 

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

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

 

جعفر

 

  • Like 1
  • 1 month later...
قام بنشر

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

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

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

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

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

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

ارجو الافادة 

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

 

2016-03-30_19-34-11.png

قام بنشر
منذ ساعه, at_aziz said:

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

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

 

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

 

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

 

 

جعفر

قام بنشر

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

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

حقيقه ماعرفت

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

جزاك الله خير

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

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

قام بنشر
7 دقائق مضت, at_aziz said:

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

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

حقيقه ماعرفت

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

جزاك الله خير

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

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

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

 

جعفر

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information