[samee119485r]

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


انا لقيت هذا الكود وانا بصفح مواضيع المنتتدى

وحاولت اني اشغله بس معرفتش ولو امكن

وضع هاذا الكود في مشروع

وجزاكم الله خيرا



' في قسم التصريحات العام

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

[elhon.tec]

تايمر سريع دقه عالية

[samee119485r]

السلام عليكم


اخي انا عارف انه تايمر سريع ودقه عاليه

ولاكن مش عارف اركب الكود على البرنامج

بدي مثال على مشروع لكي توضح الصوره

وشكرا على ردك