smarttimerinterval شخابيط ابو جودى : فكرة ثورية لحل مشكلة الأكسس الأزلية مع حدث التيمر

[ابو جودي]

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

بادئ ذي بدء
هذا الموضوع يعد مهما وحيويا لمصممي ومطوري النظم أكثر من المستخدم العادي

جاءت فكرة هذا الموضوع بناء على موضوع سابق كان بعنوان:
مطلوب إظهار الساعة تعمل داخل النموذج (الساعة والدقائق والثواني) من غير استخدام عداد (تايمر) النموذج

في 28‏/6‏/2025 at 23:39, ابوخليل said:

المطلوب كما في العنوان

ومن أهم ما ورد فيه هذا الاقتباس:

في 29‏/6‏/2025 at 21:09, jjafferr said:

ما انا فما احب استعمال Timer في نماذجي ، لأنها تؤذيني لما اشتغل في الكود !!

واعتقدت ان كود ابو جودي سيحل المشكلة ، ولكن للأسف ، حصلت على نفس المشكلة في الكود !!

في الموضوع السابق كانت الفكرة تمثل حلا تقليديا لأنها اعتمدت على Timer آخر للمراقبة وهذا لم يكن مناسبا لأنه يظل يعمل أثناء تعديل الأكواد داخل محرر VBA

لكن بفضل الله سبحانه وتعالى توصلت إلى حل مختلف تماما يعتمد على:

• TimerInterval الخاص بالنموذج نفسه
• مراقبة ظهور واختفاء محرر VBA
• استخدام Hook عند تغيير النافذة النشطة بدلا من الاعتماد على Timer إضافي

فكرة العمل باختصار

• عند فتح النموذج يبدأ TimerInterval
• إذا تم فتح محرر VBA يتم إيقاف التايمر فورا
• عند إغلاق المحرر والعودة إلى نماذج قاعدة البيانات المفتوحة يتم تشغيل التايمر من جديد تلقائيا وفورا
• لا حاجة لتمرير اسم النموذج الرئيسي أو اسم عنصر الـ Subform يدويا لأن الكود يكتشف ذلك تلقائيا
• المطلوب فقط هو تمرير اسم عنصر التحكم الذي سيتم عرض الوقت فيه أيا كان نوعه: Label أو TextBox

مميزات الحل

• يعمل مع النموذج الرئيسي أو المستقل
• يعمل مع النموذج الفرعي
• يعمل مع أكثر من نموذج في نفس الوقت
• يدعم عنصر العرض سواء كان Label أو TextBox
• لا يعتمد على Timer إضافي للمراقبة

الوحدة النمطية العامة باسم : basSmartClock

Option Compare Database
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetWinEventHook Lib "user32" ( _
        ByVal eventMin As Long, _
        ByVal eventMax As Long, _
        ByVal hmodWinEventProc As LongPtr, _
        ByVal pfnWinEventProc As LongPtr, _
        ByVal idProcess As Long, _
        ByVal idThread As Long, _
        ByVal dwFlags As Long) As LongPtr

    Private Declare PtrSafe Function UnhookWinEvent Lib "user32" ( _
        ByVal hWinEventHook As LongPtr) As Long

    Private Declare PtrSafe Function GetAncestor Lib "user32" ( _
        ByVal hwnd As LongPtr, _
        ByVal gaFlags As Long) As LongPtr
#Else
    Private Declare Function SetWinEventHook Lib "user32" ( _
        ByVal eventMin As Long, _
        ByVal eventMax As Long, _
        ByVal hmodWinEventProc As Long, _
        ByVal pfnWinEventProc As Long, _
        ByVal idProcess As Long, _
        ByVal idThread As Long, _
        ByVal dwFlags As Long) As Long

    Private Declare Function UnhookWinEvent Lib "user32" ( _
        ByVal hWinEventHook As Long) As Long

    Private Declare Function GetAncestor Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal gaFlags As Long) As Long
#End If

Private Const CLOCK_INTERVAL_MS         As Long = 1000
Private Const EVENT_SYSTEM_FOREGROUND   As Long = &H3
Private Const WINEVENT_OUTOFCONTEXT     As Long = &H0
Private Const GA_ROOT                   As Long = 2

Private gHook                           As LongPtr
Private gAccessHwnd                     As LongPtr
Private gClocks                         As Object

Private Sub EnsureClockStore()
    If gClocks Is Nothing Then
        Set gClocks = CreateObject("Scripting.Dictionary")
    End If
End Sub

Private Function MakeClockKey(frm As Access.Form) As String
    On Error GoTo EH

    Dim p As Access.Form
    Dim ctlName As String

    Set p = frm.Parent
    ctlName = GetSubformControlName(p, frm)

    If Len(ctlName) > 0 Then
        MakeClockKey = p.Name & "|" & ctlName & "|" & frm.Name
        Exit Function
    End If

EH:
    MakeClockKey = frm.Name
End Function

Private Function CreateClockState(frm As Access.Form, ByVal ClockControlName As String) As Object
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")

    Dim isSub As Boolean
    Dim parentName As String
    Dim subCtlName As String

    On Error Resume Next
    parentName = frm.Parent.Name
    subCtlName = GetSubformControlName(frm.Parent, frm)
    isSub = (Len(subCtlName) > 0)
    On Error GoTo 0

    d.Add "Key", MakeClockKey(frm)
    d.Add "HostFormName", frm.Name
    d.Add "ParentFormName", parentName
    d.Add "SubformControlName", subCtlName
    d.Add "IsSubform", isSub
    d.Add "ClockControlName", ClockControlName
    d.Add "WasStoppedByVBE", False

    Set CreateClockState = d
End Function

Public Sub StartSmartClock(frm As Access.Form, ByVal ClockControlName As String)
    On Error GoTo EH

    EnsureClockStore

    Dim key As String
    Dim state As Object

    key = MakeClockKey(frm)

    If gClocks.Exists(key) Then
        gClocks.Remove key
    End If

    Set state = CreateClockState(frm, ClockControlName)
    gClocks.Add key, state

    frm.TimerInterval = CLOCK_INTERVAL_MS

    If gAccessHwnd = 0 Then
        gAccessHwnd = Application.hWndAccessApp
    End If

    If gHook = 0 Then
        gHook = SetWinEventHook( _
                    EVENT_SYSTEM_FOREGROUND, _
                    EVENT_SYSTEM_FOREGROUND, _
                    0, _
                    AddressOf ForegroundChangedProc, _
                    0, _
                    0, _
                    WINEVENT_OUTOFCONTEXT)
    End If

    Exit Sub
EH:
End Sub

Public Sub StopSmartClock(frm As Access.Form)
    On Error Resume Next

    EnsureClockStore

    Dim key As String
    key = MakeClockKey(frm)

    frm.TimerInterval = 0

    If gClocks.Exists(key) Then
        gClocks.Remove key
    End If

    If gClocks.Count = 0 Then
        If gHook <> 0 Then
            UnhookWinEvent gHook
            gHook = 0
        End If
        Set gClocks = Nothing
    End If
End Sub

Public Sub SmartClockTimer(frm As Access.Form)
    On Error Resume Next

    EnsureClockStore

    Dim key As String
    Dim state As Object

    key = MakeClockKey(frm)
    If Not gClocks.Exists(key) Then Exit Sub

    Set state = gClocks(key)

    If Application.VBE.MainWindow.Visible Then
        state("WasStoppedByVBE") = True
        frm.TimerInterval = 0
        Exit Sub
    End If

    SetClockDisplay frm, state("ClockControlName"), Format$(Now(), "dd/mm/yyyy, hh:nn:ss AM/PM")
End Sub

Private Sub SetClockDisplay(frm As Access.Form, ByVal ClockControlName As String, ByVal ClockText As String)
    On Error Resume Next

    Dim ctl As Access.Control
    Set ctl = frm.Controls(ClockControlName)
    If ctl Is Nothing Then Exit Sub

    Select Case ctl.ControlType
        Case acTextBox
            ctl.Value = ClockText

        Case acLabel
            ctl.Caption = ClockText
    End Select
End Sub

Private Function GetSubformControlName(parentFrm As Access.Form, childFrm As Access.Form) As String
    On Error Resume Next

    Dim ctl As Access.Control

    For Each ctl In parentFrm.Controls
        If ctl.ControlType = acSubform Then
            If ctl.Form Is childFrm Then
                GetSubformControlName = ctl.Name
                Exit Function
            End If
        End If
    Next ctl
End Function

Private Function GetStateTargetForm(state As Object, ByRef frm As Access.Form) As Boolean
    On Error GoTo EH

    If state("IsSubform") Then
        If (SysCmd(acSysCmdGetObjectState, acForm, state("ParentFormName")) And acObjStateOpen) = 0 Then Exit Function
        Set frm = Forms(state("ParentFormName")).Controls(state("SubformControlName")).Form
    Else
        If (SysCmd(acSysCmdGetObjectState, acForm, state("HostFormName")) And acObjStateOpen) = 0 Then Exit Function
        Set frm = Forms(state("HostFormName"))
    End If

    GetStateTargetForm = Not (frm Is Nothing)
    Exit Function
EH:
    Set frm = Nothing
End Function

#If VBA7 Then
Public Sub ForegroundChangedProc( _
    ByVal hWinEventHook As LongPtr, _
    ByVal eventId As Long, _
    ByVal hwnd As LongPtr, _
    ByVal idObject As Long, _
    ByVal idChild As Long, _
    ByVal dwEventThread As Long, _
    ByVal dwmsEventTime As Long)
#Else
Public Sub ForegroundChangedProc( _
    ByVal hWinEventHook As Long, _
    ByVal eventId As Long, _
    ByVal hwnd As Long, _
    ByVal idObject As Long, _
    ByVal idChild As Long, _
    ByVal dwEventThread As Long, _
    ByVal dwmsEventTime As Long)
#End If

    On Error Resume Next

    If gClocks Is Nothing Then Exit Sub
    If gClocks.Count = 0 Then Exit Sub

    If GetAncestor(hwnd, GA_ROOT) <> gAccessHwnd Then Exit Sub

    Dim k As Variant
    Dim state As Object
    Dim frm As Access.Form

    For Each k In gClocks.Keys
        Set state = gClocks(k)

        If state("WasStoppedByVBE") Then
            If GetStateTargetForm(state, frm) Then
                frm.TimerInterval = CLOCK_INTERVAL_MS
                SetClockDisplay frm, state("ClockControlName"), Format$(Now(), "dd/mm/yyyy, hh:nn:ss AM/PM")
                state("WasStoppedByVBE") = False
            End If
        End If
    Next k
End Sub

مثال الاستدعاء إذا كان العرض داخل Label

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
    StartSmartClock Me, "lblClock"
End Sub

Private Sub Form_Timer()
    SmartClockTimer Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    StopSmartClock Me
End Sub

مثال الاستدعاء إذا كان العرض داخل TextBox

 

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
    StartSmartClock Me, "txtDClock"
End Sub

Private Sub Form_Timer()
    SmartClockTimer Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    StopSmartClock Me
End Sub

كما تلاحظون كود الاستدعاء هو نفسه لأي نموذج سواء كان:

• رئيسيا
• فرعيا
• منفردا
• أو أكثر من نموذج معا
• إذا كان عرض الوقت داخل النموذج يعتمد على عنصر من النوع:  Label
• إذا كان عرض الوقت داخل النموذج يعتمد على عنصر من النوع: TextBox

كل المطلوب فقط هو تمرير اسم عنصر التحكم المستخدم في عرض الوقت ايا كان نوعه ( Label/TextBox ) :

 StartSmartClock Me, "اسم_عنصر_التحكم"

وفى النهاية أسأل الله أن ينفع به

إذا كان لدى أحد الأساتذة العظماء أو الإخوة الكرام أي ملاحظة على الكود أكون شاكرا جدا.

مع خالص التحية
 

 

 

SmartClock.accdb

[ابو جودي]

تطبيق عملى للفكرة والاكواد على المثال القدبم والمستخدم سابقا فى الموضوع :
مطلوب اظهار الساعة تعمل داخل النموذج (الساعة والدقائق والثواني ) من غير استخدام عداد (تايمر) النموذج
 

في 28‏/6‏/2025 at 23:39, ابوخليل said:

المطلوب كما في العنوان

 

ClockEngine.zip

[منتصر الانسي]

11 دقائق مضت, ابو جودي said:

تطبيق عملى للفكرة والاكواد على المثال القدبم والمستخدم سابقا فى الموضوع 

 كنت على وشك أن أطلب منك تطبيق الحل على مثال لساعة حائطية وجاء الرد قبل أن أطلب 

رائع 👏👏👏

[ابو جودي]

4 دقائق مضت, منتصر الانسي said:

كنت على وشك أن أطلب منك تطبيق الحل على مثال لساعة حائطية وجاء الرد قبل أن أطلب 

رائع 👏👏👏

وانا قلت اسبق حضرتك بوضع المثال 

المثال و المرفق والافكار وصاحبهم ملك يمينك استاذ @منتصر الانسي  تدلل

 

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