نمط تفاعلي لقائمة الجانبية لواجهة النافذة (API_WS_EX_COMPOSITED)

[hanan_ms]

نمط تفاعلي للواجهة ويوجد انماط اخرى 😇

 

تعديل على مرفق @Moosak 

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

الدالة والمرفق والشرح بموضوع @Moosak اسفل الفيديو

================================================( بسيط يمكن اضافة قائمة لاختيار انماط الحقول بدل من المسار  

الدالة :

Option Compare Database
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" _
        (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _
        (ByVal hwnd As LongPtr, ByVal nIndex As Long, _
         ByVal dwNewLong As LongPtr) As LongPtr
#Else
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long, _
         ByVal dwNewLong As Long) As Long
#End If

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_COMPOSITED = &H2000000

'==== دالة عامة تحدد النموذج بالاسم وتفعّل/تُلغى الـ DoubleBuffering ====
Public Sub ToggleFormDoubleBuffering(FormName As String, EnableIt As Boolean)
    Dim hWndForm As LongPtr
    
    ' تأكد أن النموذج مفتوح
    If Not CurrentProject.AllForms(FormName).IsLoaded Then
        MsgBox "النموذج " & FormName & " غير مفتوح.", vbExclamation
        Exit Sub
    End If
    
    ' اجلب الـ hWnd
    hWndForm = Forms(FormName).hwnd
    
#If VBA7 Then
    Dim style As LongPtr
    style = GetWindowLongPtr(hWndForm, GWL_EXSTYLE)
    If EnableIt Then
        style = style Or WS_EX_COMPOSITED
    Else
        style = (style And Not WS_EX_COMPOSITED)
    End If
    SetWindowLongPtr hWndForm, GWL_EXSTYLE, style
#Else
    Dim style32 As Long
    style32 = GetWindowLong(hWndForm, GWL_EXSTYLE)
    If EnableIt Then
        style32 = style32 Or WS_EX_COMPOSITED
    Else
        style32 = (style32 And Not WS_EX_COMPOSITED)
    End If
    SetWindowLong hWndForm, GWL_EXSTYLE, style32
#End If
End Sub

'تفعيل DoubleBuffering على نموذج معين
'Call ToggleFormDoubleBuffering("اسم_النموذج", True)

'إلغاء DoubleBuffering على نموذج معين
'Call ToggleFormDoubleBuffering("اسم_النموذج", False)

Public Sub ToggleFormOrSubformDoubleBuffering(FormName As String, Optional SubformControlName As String = "", Optional EnableIt As Boolean = True)
    Dim hWndForm As LongPtr
    
    If Not CurrentProject.AllForms(FormName).IsLoaded Then
        MsgBox "النموذج " & FormName & " غير مفتوح.", vbExclamation
        Exit Sub
    End If
    
    If SubformControlName <> "" Then
        hWndForm = Forms(FormName).Controls(SubformControlName).Form.hwnd
    Else
        hWndForm = Forms(FormName).hwnd
    End If
    
    ' تطبيق النمط
#If VBA7 Then
    Dim style As LongPtr
    style = GetWindowLongPtr(hWndForm, GWL_EXSTYLE)
    If EnableIt Then
        style = style Or WS_EX_COMPOSITED
    Else
        style = (style And Not WS_EX_COMPOSITED)
    End If
    SetWindowLongPtr hWndForm, GWL_EXSTYLE, style
#Else
    Dim style32 As Long
    style32 = GetWindowLong(hWndForm, GWL_EXSTYLE)
    If EnableIt Then
        style32 = style32 Or WS_EX_COMPOSITED
    Else
        style32 = (style32 And Not WS_EX_COMPOSITED)
    End If
    SetWindowLong hWndForm, GWL_EXSTYLE, style32
#End If
End Sub

'على نموذج رئيسى
'Call ToggleFormOrSubformDoubleBuffering("frmMain", , True)

'على نموذج فرعى داخل نموذج رئيسى
'Call ToggleFormOrSubformDoubleBuffering("frmMain", "subMyForm", True)

تحميل المرفق

https://www.mediafire.com/file/1qo54r19srcfear/API_WS_EX_COMPOSITED.rar/file