المشاركات : 57
المواضيع 11
الإنتساب : Oct 2013
السمعة :
1
الشكر: 2
تم شكره 34 مرات في 12 مشاركات
بسم الله الرحمن الرحيم
اخواني
ارجوكم اريد طريقة لجعل timer سريع جدا لأن قيمة interval =1 تعتبر بطيئة بالنسبة للمطلوب
شكرا لكم
المشاركات : 372
المواضيع 15
الإنتساب : Sep 2013
السمعة :
28
الشكر: 487
تم شكره 1677 مرات في 187 مشاركات
السلام عليكم...
يمكنك استعمال المؤقت ذي التباين العالي أو الدقة العالية (High Resolution Timer) إذا كان كان الجهاز يدعم ذلك (أعتقد كل الأجهزة الآن تدعم ذلك).
كود :
' في قسم التصريحات العام
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)
' الرقم 0.0001 الموجود في نهاية الحلقة التالية يعني جزء من عشرة آلاف من الثانية. أي أن القيمة بالثواني
Do
QueryPerformanceCounter LIValue
EndCount = LargeIntToDbl(LIValue.lowpart, LIValue.highpart)
Loop While ((EndCount - StartCount) / Frequency) < 0.0001
' بعد هذا السطر ضع الكود الذي تريد تنفيذه بعد المدة المحددة
' ... هنا
' ... هنا
' ... إلخ
DoEvents ' مهمة جداً جداً
Loop
End Sub
' زر تشغيل المؤقت
Private Sub cmdRunTimer_Click()
ContinueTimer = True
TimerProcedure
End Sub
' زر إيقاف المؤقت
Private Sub cmdStopTimer_Click()
ContinueTimer = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
ContinueTimer = False ' مهمة جداً جداً
End Sub
نرجو الاستفادة و السلام.
بِسْمِ اللهِ الرَّحْمَنِ الرَّحِيمِ ( وَ مَا تُقَدِّمُوا لِأَنفُسِكُم مِّنْ خَيْرٍ تَجِدُوهُ عِندَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً ) صَدَقَ اللهُ الْعَظِيمُ
المشاركات : 372
المواضيع 15
الإنتساب : Sep 2013
السمعة :
28
الشكر: 487
تم شكره 1677 مرات في 187 مشاركات
السلام عليكم...
ما يأمر عليك ظالم... شكراً...
"وَ مَا تُقَدِّمُوا لأَنْفُسِكُم مِنْ خَيْرٍ تَجِدُوهُ عِنْدَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً" - صدق الله العظيم.
سلام.
بِسْمِ اللهِ الرَّحْمَنِ الرَّحِيمِ ( وَ مَا تُقَدِّمُوا لِأَنفُسِكُم مِّنْ خَيْرٍ تَجِدُوهُ عِندَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً ) صَدَقَ اللهُ الْعَظِيمُ
المشاركات : 490
المواضيع 54
الإنتساب : Sep 2013
السمعة :
63
الشكر: 1726
تم شكره 1192 مرات في 348 مشاركات
[COLOR="#0000FF"]وعليكم السلام ورحمة الله وبركاته
الأستاذ ناجي كل يوم يذهلنا بإبداعاته
ما شاء الله تبارك الله
ربنا يفتح عليك أكثر وأكثر[/COLOR]
فاعلم أنه لا إله إلا الله
المشاركات : 157
المواضيع 17
الإنتساب : Oct 2013
السمعة :
1
الشكر: 5
تم شكره 64 مرات في 12 مشاركات
السلام عليكم ورحمة الله وبركاته
جزاكم الله خيرا و نفع بكم بهذا المنتدى للرقي بأمة محمد صلى الله عليه وسلم ولنشر العلم وثقافة طلب العلم في مختلف المعارف ليستفيد منها القاصي والداني بإذن الله تعالى ولكي تعود أمتنا أمة العلم والمعرفة أمة الرقي ومكارم الأخلاق .
و أدعو الله أن يعجل بالفرج على إخواننا في سوريا، و السلام