المؤقت ذو الدقة العالية - High Resolution Timer

السلام عليكم...

أداة الـ Timer تعتمد على تردد دقات ساعة النظام (TickCount) بوحدة الملي ثانية (milliseconds) و بالتالي فأقل قيمة لها هي 1 (أي 1 ملي ثانية) بالإضافة إلى أنها تصبح غير دقيقة عند استعمال قيم صغيرة.

البديل هو استعمال ما يسمى بـ "المؤقت ذي الدقة العالية" (High Resolution Timer) و ذلك باستخدام دوال API كالتالي:

1. ضع التصريحات و الإجراء التالي في بداية كود الـ Class:

    Private Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef lpPerformanceCount As Long) As Integer
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef lpFrequency As Long) As Integer

    Private ContinueTimer As Boolean = False    ' لتشغيل أو إيقاف المؤقت

    Private Sub TimerProcedure()
        Dim Frequency As Long
        Dim StartCount As Long
        Dim EndCount As Long

        ' QueryPerformanceFrequency gives the frequency as Counts per Second:
        If QueryPerformanceFrequency(Frequency) = 0 Then
            MsgBox("النظام لا يدعم المؤقتات ذات الدقة العالية")
            Exit Sub
        End If

        Do While ContinueTimer
            ' QueryPerformanceCounter gives the current Counter value:
            QueryPerformanceCounter(StartCount)
            Do
                QueryPerformanceCounter(EndCount)
            Loop While ((EndCount - StartCount) / Frequency) < 0.0001    ' القيمة بالثواني و يمكن أن تكون كسرية - أي أجزاء من الثانية

            ' ======== أدناه ضع الكود الذي تريد تنفيذه كلما انقضت المدة المحددة DoEvents بين هذا السطر و جملة =========
            '....
            '....
            '....
            ' ======================================================================

            Application.DoEvents()      ' مهمة جداً جداً
        Loop
    End Sub

2. في إجراء الحدث FormClosing اكتب السطر التالي (مهم):

ContinueTimer = False

3. عندما تريد تشغيل المؤقت استعمل السطرين التاليين:

ContinueTimer = TrueTimerProcedure()

4. عندما تريد إيقاف المؤقت استعمل السطر التالي:

ContinueTimer = False

نرجو الاستفادة و السلام.