منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

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


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

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

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

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



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

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

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

السلام عليكم


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

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

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

وشكرا على ردك