[سؤال] تسريع أداة التايمر

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

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

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

1. ضع التصريحات و الدوال التالية في القسم العام للكود:

Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

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

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

' دالة للحصول على عدد صحيح كبير - أكبر من الطويل
Private Function LargeIntToDbl(LoPart As Long, HiPart As Long) As Double
    'This function converts the LARGE_INTEGER data type to a double
    Dim dblLo As Double, dblHi As Double
    
    If LoPart < 0 Then
        dblLo = 2 ^ 32 + LoPart
    Else
        dblLo = LoPart
    End If
    
    If HiPart < 0 Then
        dblHi = 2 ^ 32 + HiPart
    Else
        dblHi = HiPart
    End If
    
    LargeIntToDbl = dblLo + dblHi * 2 ^ 32
End Function

' إجراء التوقيت
Private Sub TimerProcedure()
    Dim LIValue As LARGE_INTEGER
    
    Dim Frequency As Double
    Dim StartCount As Double
    Dim EndCount As Double
    
    ' QueryPerformanceFrequency gives the frequency as Counts per Second:
    If QueryPerformanceFrequency(LIValue) = 0 Then
        MsgBox "النظام لا يدعم المؤقتات ذات الدقة العالية"
        Exit Sub
    Else
        Frequency = LargeIntToDbl(LIValue.lowpart, LIValue.highpart)
    End If
    
    Do While ContinueTimer
        ' QueryPerformanceCounter gives the current Counter value:
        QueryPerformanceCounter LIValue
        StartCount = LargeIntToDbl(LIValue.lowpart, LIValue.highpart)
        Do
            QueryPerformanceCounter LIValue
            EndCount = LargeIntToDbl(LIValue.lowpart, LIValue.highpart)
        Loop While ((EndCount - StartCount) / Frequency) < 0.001    ' القيمة بالثواني و يمكن أن تكون كسرية - أي أجزاء من الثانية
        
        ' ======== أدناه ضع الكود الذي تريد تنفيذه كلما انقضت المدة المحددة DoEvents بين هذا السطر و جملة =========
        '....
        '....
        '....
        ' ======================================================================
        
        DoEvents    ' مهمة جداً جداً
    Loop
End Sub

2. في الإجراء Form_Load اكتب السطر التالي:

ContinueTimer = False

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

ContinueTimer = False

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

    ContinueTimer = True    TimerProcedure

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

ContinueTimer = False

6. خوفاً من انقطاع محتمل للكهرباء (!!!) أرسلت المشاركة دون المزيد من التوضيحات (سأحاول ذلك فيما بعد).

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

أخي ناجي

أشكرك جزيل الشكر

شرحك واضح جداً وهذا ماكنت أريده.

أكرر شكري

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

ارجومنك توضيح هذا الكود اكثر علي فيجوال 2008 حيث ان لدي نفس المشكله السابقة وحاولت تنفيذ الكود علي فيجوال 2008 ولكنه لم يعمل 

ارجو افادتي هذا الخصوص للاهمية ولو بالامكان مع مثال اكون شاكر اكثر

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

تم تعديل الكود و وضعه في هذا الموضوع في قسم VB.NET.

سلام.