كود جاهز - نسخة قابلة للطباعة

كود جاهز - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم أسئلة واستفسارات الأعضاء - المنتدى القديم (http://vb4arb.com/vb/forumdisplay.php?fid=94)
+--- قسم : قسم Visual Basic 6 وما قبله (http://vb4arb.com/vb/forumdisplay.php?fid=167)
+--- الموضوع : كود جاهز (/showthread.php?tid=8886)

كود جاهز - samee119485r - 14-05-13

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

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

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

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

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

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

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 - 15-05-13

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

كود جاهز - samee119485r - 15-05-13

السلام عليكم

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

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

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

وشكرا على ردك