level 5
Public Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)想做个后台喊话的程序,望高手给源代码或给设计思路。用Sleep这个Api好像很卡,有没有其他好点的办法?还有有没有想后台发送按键enter的命令?
2008年02月23日 23点02分
1
level 5
这东西用按键精灵很容易做出来,VB的我找了两天资料了还没有琢磨出来,望高手指点迷津
2008年02月23日 23点02分
2
level 1
'自定义一个过程,delay 1000 表示延迟1000毫秒,经测试比timer更精确,而且不会象sleep函数那样使整个进程挂起。至今为止还没找到比它更好的延迟方法Private Declare Function timeGetTime Lib "winmm.dll" () As LongPrivate Sub Delay(ByVal n As Single) Dim tm1 As Long, tm2 As Long tm1 = timeGetTime Do tm2 = timeGetTime If (tm2 - tm1) > n Then Exit Do DoEvents LoopEnd Sub
2008年02月24日 00点02分
3
level 13
'有许多的机会在在编程时都需要用到计时器, 我们要有一个观念, 那就是我们并不是在从事科研工作也不是宇航员, 有必要去躜那几毫毫秒的空间吗?Dim Delaytm&Delaytm = TimerDo: DoEvents: Loop Until Timer > Delaytm + 3 '延时3秒
2008年02月24日 02点02分
5
level 1
这是一个老外写的类模块,算是经典的了Option ExplicitPrivate Type FILETIME dwLowDateTime As Long dwHighDateTime As LongEnd TypePrivate 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& = 0Private Const WAIT_OBJECT_1& = 1Private Const WAIT_TIMEOUT& = &H102&Private Const INFINITE = &HFFFFPrivate Const ERROR_ALREADY_EXISTS = 183&Private Const QS_HOTKEY& = &H80Private Const QS_KEY& = &H1Private Const QS_MOUSEBUTTON& = &H4Private Const QS_MOUSEMOVE& = &H2Private Const QS_PAINT& = &H20Private Const QS_POSTMESSAGE& = &H8Private Const QS_SENDMESSAGE& = &H40Private Const QS_TIMER& = &H10Private 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 Const UNITS = 4294967296#Private Const MAX_LONG = -2147483648#Private Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, ByVal bManualReset As Long, ByVal lpName As String) As LongPrivate Declare Function OpenWaitableTimer Lib "kernel32" Alias "OpenWaitableTimerA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As LongPrivate 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 LongPrivate Declare Function CancelWaitableTimer Lib "kernel32" (ByVal hTimer As Long)Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate 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 LongPrivate mlTimer As LongPrivate Sub Class_Terminate() On Error Resume Next If mlTimer <> 0 Then CloseHandle mlTimerEnd SubPublic Sub Dely(MilliSeconds As Long) On Error GoTo ErrHandler Dim ft As FILETIME Dim lBusy As Long Dim lRet As Long Dim dblDelay As Double Dim dblDelayLow As Double mlTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer" & Format$(Now(), "NNSS")) If Err.LastDllError <> ERROR_ALREADY_EXISTS Then ft.dwLowDateTime = -1 ft.dwHighDateTime = -1 lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, 0) End If ' Convert the Units to nanoseconds. dblDelay = CDbl(MilliSeconds) * 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 / UNITS) - 1 dblDelayLow = -UNITS * (dblDelay / UNITS - Fix(CStr(dblDelay / UNITS))) If dblDelayLow < MAX_LONG Then dblDelayLow = UNITS + dblDelayLow ft.dwLowDateTime = CLng(dblDelayLow) lRet = SetWaitableTimer(mlTimer, 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, mlTimer, False, INFINITE, QS_ALLINPUT&) DoEvents Loop Until lBusy = WAIT_OBJECT_0 ' Close the handles when you are done with them. CloseHandle mlTimer mlTimer = 0 Exit Sub ErrHandler: '// errorEnd Sub
2008年02月24日 03点02分
7