سلام
دستور ایجاد وقفه به مدت چند ثانیه چی هستش؟
منظورم تایمر کنترل نیست!!
من می خوام توی یه زیر برنامه بین یک دستور تا دستور دیگه 3 ثانیه وقفه ایجاد بشه؟
آیا میشه؟
Printable View
سلام
دستور ایجاد وقفه به مدت چند ثانیه چی هستش؟
منظورم تایمر کنترل نیست!!
من می خوام توی یه زیر برنامه بین یک دستور تا دستور دیگه 3 ثانیه وقفه ایجاد بشه؟
آیا میشه؟
یه چیزی مثل delay توی زبانهای ساختیافته میخواین دیگه؟ با یه سرچ توی msdn پیدا میشه
آره یه چیزی مثل Delay
شما نمی دونید؟
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sleep (3000)
ببخش عزیز این کدی که دادید پیغام خطل می ده
فکر کنم یه فایل ماژول می خواد
این فایل ماژول رو ندارید؟؟؟؟؟
فک نمی کنم چیز دیگه ای بخواد.
مثالهایی از KPD-Team ، تو سایت فک کنم از این مثالها باشه sleep رو جستجو کن.
Sleep'This project needs a button
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Me.Caption = "Your system will sleep 5 sec."
'Sleep for 5000 milliseconds
Sleep 5000
Me.Caption = ""
End Sub
Private Sub Form_Load()
Me.Caption = ""
Command1.Caption = "Sleep ..."
End Sub
SleepExPrivate Declare Function SleepEx Lib "kernel32" (ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Sleep 2 seconds
SleepEx 2000, False
End Sub
WaitForSingleObject'This program needs a common dialog box, named CDBox
' (To add the Common Dialog Box to your tools menu, go to Project->Components (or press CTRL-T)
' and select Microsoft Common Dialog control)
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Function SuperShell(ByVal App As String, ByVal WorkDir As String, dwMilliseconds As Long, ByVal start_size As enSW, ByVal Priority_Class As enPriority_Class) As Boolean
Dim pclass As Long
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
'Not used, but needed
Dim sec1 As SECURITY_ATTRIBUTES
Dim sec2 As SECURITY_ATTRIBUTES
'Set the structure size
sec1.nLength = Len(sec1)
sec2.nLength = Len(sec2)
sinfo.cb = Len(sinfo)
'Set the flags
sinfo.dwFlags = STARTF_USESHOWWINDOW
'Set the window's startup position
sinfo.wShowWindow = start_size
'Set the priority class
pclass = Priority_Class
'Start the program
If CreateProcess(vbNullString, App, sec1, sec2, False, pclass, _
0&, WorkDir, sinfo, pinfo) Then
'Wait
WaitForSingleObject pinfo.hProcess, dwMilliseconds
SuperShell = True
Else
SuperShell = False
End If
End Function
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Set the dialog's title
CDBox.DialogTitle = "Choose an EXEC-File ..."
'Error when canceled
CDBox.CancelError = True
'Set the dialog's filter
CDBox.Filter = "EXEC-Files (*.exe)|*.exe|All files (*.*)|*.*"
'Show the 'Open File'-dialog
CDBox.ShowOpen
'Execute the program
SuperShell CDBox.filename, Left$(CDBox.filename, Len(CDBox.filename) - Len(CDBox.FileTitle)), 0, SW_NORMAL, HIGH_PRIORITY_CLASS
End
End Sub
باید این کد رو داخل یه ماژول بزاریم تا دستور
sleep 3000
جواب بده
Option Explicit
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const WAIT_ABANDONED& = &H80&
Private Const WAIT_ABANDONED_0& = &H80&
Private Const WAIT_FAILED& = -1&
Private Const WAIT_IO_COMPLETION& = &HC0&
Private Const WAIT_OBJECT_0& = 0
Private Const WAIT_OBJECT_1& = 1
Private Const WAIT_TIMEOUT& = &H102&
Private Const INFINITE = &HFFFF
Private Const ERROR_ALREADY_EXISTS = 183&
Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE _
Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE _
Or QS_KEY)
Private Const QS_ALLEVENTS& = (QS_INPUT _
Or QS_POSTMESSAGE _
Or QS_TIMER _
Or QS_PAINT _
Or QS_HOTKEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE _
Or QS_PAINT _
Or QS_TIMER _
Or QS_POSTMESSAGE _
Or QS_MOUSEBUTTON _
Or QS_MOUSEMOVE _
Or QS_HOTKEY _
Or QS_KEY)
Private Declare Function CreateWaitableTimer Lib "kernel32" _
Alias "CreateWaitableTimerA" ( _
ByVal lpSemaphoreAttributes As Long, _
ByVal bManualReset As Long, _
ByVal lpName As String) As Long
Private Declare Function OpenWaitableTimer Lib "kernel32" _
Alias "OpenWaitableTimerA" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" ( _
ByVal hTimer As Long, _
lpDueTime As FILETIME, _
ByVal lPeriod As Long, _
ByVal pfnCompletionRoutine As Long, _
ByVal lpArgToCompletionRoutine As Long, _
ByVal fResume As Long) As Long
Private Declare Function CancelWaitableTimer Lib "kernel32" ( _
ByVal hTimer As Long)
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" ( _
ByVal nCount As Long, _
pHandles As Long, _
ByVal fWaitAll As Long, _
ByVal dwMilliseconds As Long, _
ByVal dwWakeMask As Long) As Long
Public Sub Wait(lNumberOfSeconds As Long)
Dim ft As FILETIME
Dim lBusy As Long
Dim lRet As Long
Dim dblDelay As Double
Dim dblDelayLow As Double
Dim dblUnits As Double
Dim hTimer As Long
hTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer")
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
' If the timer already exists, it does not hurt to open it
' as long as the person who is trying to open it has the
' proper access rights.
Else
ft.dwLowDateTime = -1
ft.dwHighDateTime = -1
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
End If
' Convert the Units to nanoseconds.
dblUnits = CDbl(&H10000) * CDbl(&H10000)
dblDelay = CDbl(lNumberOfSeconds) * 1000 * 10000
' By setting the high/low time to a negative number, it tells
' the Wait (in SetWaitableTimer) to use an offset time as
' opposed to a hardcoded time. If it were positive, it would
' try to convert the value to GMT.
ft.dwHighDateTime = -CLng(dblDelay / dblUnits) - 1
dblDelayLow = -dblUnits * (dblDelay / dblUnits - _
Fix(dblDelay / dblUnits))
If dblDelayLow < CDbl(&H80000000) Then
' &H80000000 is MAX_LONG, so you are just making sure
' that you don't overflow when you try to stick it into
' the FILETIME structure.
dblDelayLow = dblUnits + dblDelayLow
End If
ft.dwLowDateTime = CLng(dblDelayLow)
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, False)
Do
' QS_ALLINPUT means that MsgWaitForMultipleObjects will
' return every time the thread in which it is running gets
' a message. If you wanted to handle messages in here you could,
' but by calling Doevents you are letting DefWindowProc
' do its normal windows message handling---Like DDE, etc.
lBusy = MsgWaitForMultipleObjects(1, hTimer, False, _
INFINITE, QS_ALLINPUT&)
DoEvents
Loop Until lBusy = WAIT_OBJECT_0
' Close the handles when you are done with them.
CloseHandle hTimer
End Sub
سلام
کدی که adaman دادند خیلی خوب هم کار میکنه .
کاش پیغام خطا رو مینوشتی .
من فکر میکنم شما تابع
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
رو در قسمت Form_load نوشتی این تابع بعداز دستور Option Explicit نوشته میشه من امتحان کردم خیلی خوب کار میکنه
نقل قول:
نوشته شده توسط mehdi_RM
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sleep (3000)
این کد خیلی کوتاه و خوبه و درست جواب میده
اگر تابع رو تو ماژول معرفی میکنی واژه Public رو به جای Private قرار بده اما اگر زیر Option Explicit تو فرم مینویسی باید همون Private باشه بعد هر جا که خواستی برنامه مکث کنه مینویسی Sleep(3000)
سلام
دستور sleep مشکلی که داره اینه که اگر در طول مدت زمانی که دستور در حال کار هست ابجکتی را کلیک کنیم یا فرم را درگ کنیم یا ... برنامه مختل میشه و بعضا کراش میکنه
خواستم بدونم دستوره دیگری نیست که مشابه باشه ولی چنین مشکلی را پیش نیاره:متفکر:
سلام.
این کارا نیاز نیست دوستان.
تابع Sleep باعث میشه برنامه چند ثانیه متوقف بشه (هنگ کنه)
بهترین راه برای اینکار استفاده از کده زیره (هم خیلی کوتاه هم خیلی کارآمد) :
Start = Timer
Do While Timer < Start + 3
DoEvents
Loop
موفق و پیروز باشید.
سلامنقل قول:
نوشته شده توسط mehdi_RM
بیا داداش حالشو ببر:لبخندساده:
دستور اسلیپ بعضی جاها اذیت میکنه
ولی با این روش برنامه کاملا متوقف میشه و تازه هنگ هم نمیکنه وهر زمان خواستی دوباره اجرا میشه
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub Pause(HowLong As Long)
Dim u%, tick As Long
tick = GetTickCount()
Do
u% = DoEvents
Loop Until tick + HowLong < GetTickCount
End Sub
Private Sub Command1_Click()
Print "Pause"
Pause 4000 '1 sanyeh
Print "Play"
End Sub
دوستان در کدهایی که برای pause کردن بدون گیر کردن برنامه دادید یک مشکل هست،اگر چندین بار بر روی دکمه ای بهش 5 ثانیه دستور توقف داده شده کلیک کنیم بعد از 5 ثانیه از آخرین کلیک همه کلیک ها رو محاسبه میکنه!
میشه کاری کرد که یکبار کلیک شده بود و در صورتی که وقت وقفه تموم نشده اگر کاربر کلیک کرد اتفاقی نیفته؟!
سلام
بله ميشه، اين يك نمونه
Private Sub Delay(s As Single)
Static Run As Byte
If Run Then Exit Sub
Run = 1
Dim Start!
Start = Timer
Do While Timer < Start + s
DoEvents
Loop
Run = 0
MsgBox "Complete"
End Sub
Private Sub Command1_Click()
Delay 0.5
End Sub
سلام
برای وقفه میتونید از 2تا حلقه for خالی استفاده کنید بعد ادامه برنامه تون رو بعد حلقه بنویسید
************************
دستورات مورد نظر
.
.
.
for i=1 to 100 step 1
nexti
for j=1 to 500 step 1
nextj
دستورات مورد نظر
.
.
.
***********************
بین دستورات مورد نظر که از for استفاده کردم وقفه ای ایجاد میکنه بعد میره تو دستورات مورد نظر بعدیتون.برای میزان وقفه هم میتونید مقدار اعداد رو تغییر بدهید
من از این روش استفاده میکنم
سلام
اما ايراد اين روش اينه كه برنامتون در هنگام ايجاد تاخير قفل مي‌كنه و حتي شايد ماوس رو هم نتونيد حركت بديد
ضمنا ميزان تاخير با توجه به سرعت سيستم هاي مختلف و تعداد برنامه هاي در حال اجرا متغيره و نميشه مقدار دقيقي رو مشخص كرد
بله از این نظر باهاتون موافقم. این روش در حد 2 یا 3 ثانیه بد نیست . اما جالبه تو محیط کنسول C این روش بدون مشکل اجرا میشه اما همینطور که شما فرمودید تو وی بی با مشکلاتی رو برو میشه اگه ثانیه افزایش پیدا کنه
سلام
تو محيط كنسول سي بخاطر سرعت اجراي بسيار بالاي برنامه هاي سي چيزي متوجه نميشيد وگرنه اگر اونهم تكرارش خيلي خيلي زياد باشه همين مشكل رو داره
این تابع مشکل دارهنقل قول:
نوشته شده توسط vbhamed
متغیر «timer» از کجا پیداش شده؟؟ مقدارش چیه؟؟
سلامنقل قول:
نوشته شده توسط Hossis
اولا به تاریخ تاپیک هم توجه کنید !
ثانیا Timer متغیر نیست بلکه یکی از توابع VB هستش که در هر لحظه زمان گذشته از نیمه شب یعنی ساعت 00:00 رو به ثانیه با چند رقم اعشار میده
بهتر بود حداقل اول تست میکردین کد رو