一个简单的定时器,朋友们看看有没有更好的方法?交流为主

knikcn 2003-10-16 04:44:38
方法:
使用timer控件作为触发器,每隔(计划时间-现在时间)/2作为触发时间,当小于2秒时,以0.5秒作为触发时间。

控件:button,dtpicker1,timer

代码:
Dim datePlan As Date
Dim dblVar As Double
Private Sub Command1_Click()
'定时开始
datePlan = DTPicker1.Value
Timer1.Interval = 500

End Sub

Private Sub DTPicker1_Change()

datePlan = DTPicker1.Value
End Sub

Private Sub Form_Load()

DTPicker1.Value = Now
End Sub

Private Sub Timer1_Timer()
Dim lngVar As Long
'计算计划时间与现在时刻相差的时间(用秒计算)

dblVar = datePlan - Now
lngVar = CLng(dblVar * 24 * 60 * 60)
If lngVar < 2 Then
If lngVar = 0 Then
Debug.Print "事件开始"
Timer1.Interval = 0
Exit Sub
End If
Timer1.Interval = 500
Exit Sub
End If
Timer1.Interval = lngVar * 500
Debug.Print lngVar
End Sub
...全文
52 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
knikcn 2003-10-19
  • 打赏
  • 举报
回复
关于在60秒内减少响应次数的算法,我想根据情况而定。不过对于系统来说,每秒钟执行一次时间判断,在系统很忙的情况下,比每分钟来说需要的资源更多一些。datePlan是一个外部变量,是外部事件计划响应时间。Date变量在计算过程中,加1天为1,1hour=1/24day,1minute=1/(24*60)day,1second=1/(24*60*60)day,在对于事件要求比较高的情况下,比如在1小时20分50秒15毫秒的时候(这是一种假设,可以讨论),我觉得这种转换还是有必要的,所以在计算中我使用了复点数。
interval是整形变量 2^16,即65355,单位毫秒,换算成秒的话应该是65秒多。
AresChen 2003-10-18
  • 打赏
  • 举报
回复
上面的问题跟这里的讨论无关吧?单开个帖子吧,而且你的问题也说的太~~~,你是什么样的需求?是自己要作个权限管理,还是和AD等相关的需求?详细说一下,也好帮你啊。
danpianji2002 2003-10-17
  • 打赏
  • 举报
回复
很好啊
knikcn 2003-10-17
  • 打赏
  • 举报
回复
对上面仁兄的问题没有看清楚,更改如下

Private Sub Timer1_Timer()
Dim lngVar As Long
Dim dblvar As Double
'计算计划时间与现在时刻相差的时间(用秒计算)

dblvar = dateplan - Now
lngVar = CLng(dblvar * 24 * 60 * 60)
'当设置的时间是过去的时间时退出程序
If lngVar < 0 Then
Timer1.Interval = 0
Exit Sub
End If
If lngVar > 60000 Then
Timer1.Interval = 60000 '当时间大于1分钟时,设置触发时间为1分钟
Else
If lngVar < 2 Then
If lngVar = 0 Then
Debug.Print "事件开始"

Timer1.Interval = 0
Exit Sub
End If
Timer1.Interval = 500
Exit Sub
End If
Timer1.Interval = lngVar * 500
End If
End Sub
ShaB 2003-10-17
  • 打赏
  • 举报
回复
取得用户权限到底是如何做的呢?
有人能解答一下吗?
knikcn 2003-10-17
  • 打赏
  • 举报
回复
关于Areschen说的Timer最长时间是30多秒,这个问题不敢苟同。
在上边的数据测试中,每响应一次我都作了打印输出,时间已经超过了这个极限,所以这个问题上我想可以讨论讨论。
我的算法类似于二分法,每隔二分之一的时间间隔做一次响应,减少Cpu处理,我不知道到这种方法上,是否能够达到优化的目的?大家接着讨论
AresChen 2003-10-17
  • 打赏
  • 举报
回复
明白你的意思了。
首先说一下,我指的30多秒是每次Timer事件的间隔,也可能是60多秒,我只记得interval是integer类型,影响中好像以前有一次将定时器设置到xx,结果产生了溢出的错误。
另外,不赞成你所谓的2分法的方式,我觉得这并没有减少多少cpu,我将knikcn(黑精灵) 的程序copy在下面,逐行分析一下。

Private Sub Timer1_Timer()
Dim lngVar As Long
Dim dblvar As Double
'计算计划时间与现在时刻相差的时间(用秒计算)

dblvar = dateplan - Now
上面这行中,dateplan是什么类型不知,now是date型,dblvar是double型,这种计算转为为机器语言的开销肯定不小;
lngVar = CLng(dblvar * 24 * 60 * 60)
这行,数据转换加双精度浮点运算,而且还有隐性的数据类型转换,开销也不小

'当设置的时间是过去的时间时退出程序
If lngVar < 0 Then
Timer1.Interval = 0
Exit Sub
End If
If lngVar > 60000 Then
Timer1.Interval = 60000 '当时间大于1分钟时,设置触发时间为1分钟
Else
If lngVar < 2 Then
If lngVar = 0 Then
Debug.Print "事件开始"

Timer1.Interval = 0
Exit Sub
End If
Timer1.Interval = 500
Exit Sub
End If
Timer1.Interval = lngVar * 500
End If
前面这些,这么多的条件判断,难道不浪费cpu吗?
End Sub

好了,继续我们的讨论。如果楼主的思路在于节省timer控件的资源浪费,我觉得完全不必去从总共激发了多少次timer来考虑,因为计算机事件的控制本身是硬件中断产生的,所以以2分法的形式来减少cpu消耗,不如去减少每一次timer事件中cpu的消耗。而且,受到timer控件interval数据类型的限制,我们无法绝对的对一个长事件的定时去进行准确的2分。

以上是我的意见,大家继续。
danpianji2002 2003-10-16
  • 打赏
  • 举报
回复
不好意思阿刚才手懒了
把乱七八糟的代码没有编辑就发进来了
完全同意楼上的!!!
支持。
AresChen 2003-10-16
  • 打赏
  • 举报
回复
不会这么复杂吧?
VB标准Timer的最小时间是0.05秒,最长的时间是30秒多(65535/2),既然楼主要求的是0.5秒,触发一个0.1秒间隔的timer不就完了?

以下是一个雏形:
dim lTime as long

private sub btnStart_Click()
lTime=0
tmrTime.interval=100
tmrTime.enabled=true
end sub

private sub tmrTime_Timer(
lTime=lTime+1
if lTime=??? then
tmrTime.enabled=false
msgbox "On Time"
endif
end sub
knikcn 2003-10-16
  • 打赏
  • 举报
回复
你的代码太长了,来点注释!
danpianji2002 2003-10-16
  • 打赏
  • 举报
回复
呵呵可以阿交流一下阿
这是我的一个定时器(定时关机的)见笑了

Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Dim ss, mm, hh, i As Integer
Dim aa, bb, cc As String
Private Sub tt()

If ss < 1 Then
If mm < 1 Then
If hh < 1 Then
Timer1.Interval = 0
If Check1.Value = 1 Then
AdjustToken
ExitWindowsEx EWX_POWEROFF, 0
Timer2.Enabled = False
End If
If Check2.Value = 1 Then
If bb = "" Then
MsgBox "时间到!!", 0
Else: WinExec bb, 3
Unload Me
End If
Timer2.Enabled = False
End If
Exit Sub
Else
hh = hh - 1
mm = 59
ss = 60
End If
Else
mm = mm - 1
ss = 60
End If
Else
ss = ss - 1
End If
Text2.Text = hmstostring(hh, mm, ss)
End Sub
Private Sub pp()
If aa = Text1.Text Then
If Check1.Value = 1 Then
AdjustToken
ExitWindowsEx EWX_POWEROFF, 0
End If
If Check2.Value = 1 Then
If bb = "" Then
MsgBox "时间到!!", 0
Else: WinExec bb, 3
Unload Me
End If
End If
End If
End Sub
Private Function hmstostring(ByVal h As Integer, ByVal m As Integer, ByVal s As Integer) As String
Dim hhs, mms, sss As String
If h < 10 Then
hhs = "0" + Trim(Str(h))
Else
hhs = Trim(Str(h))
End If
If m < 10 Then
mms = "0" + Trim(Str(m))
Else
mms = Trim(Str(m))
End If
If s < 10 Then
sss = "0" + Trim(Str(s))
Else
sss = Trim(Str(s))
End If
hmstostring = hhs + ":" + mms + ":" + sss
End Function

Private Sub Check2_Click()
If Check2.Value = 1 Then
bb = InputBox("请输入要打开程序的路径", " 打开程序")
End If
End Sub


Private Sub Command1_Click()
Label1.Caption = "当前时间:"
i = 0
Timer2.Enabled = True
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
i = 1
Timer2.Enabled = False
Label1.Caption = Time
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Form_Load()
i = 1
End Sub

Private Sub Option1_Click()
Text1.Enabled = True
Text2.Enabled = False
End Sub

Private Sub Option2_Click()
Text1.Enabled = False
Text2.Enabled = True
End Sub

Private Sub Text2_Click()
temp = InputBox("please input a time", "time")
valuetime = Val(temp)
hh = Int(valuetime / 60)
mm = valuetime - hh * 60
ss = 0
Text2.Text = hmstostring(hh, mm, ss)
End Sub

Private Sub Timer1_Timer()
Label1.Caption = Time

i = -i
If i = 1 Then
aa = "点确定计时"
End If
If i = -1 Then
aa = " "
End If
If i = 0 Then
aa = Time
Label1.Caption = "当前时间:"
End If
Label4.Caption = aa
End Sub

Private Sub Timer2_Timer()
If Option2.Value = True Then Call tt
If Option1.Value = True Then Call pp
End Sub
取得权限的模块(别人给的)
Enum HowExitConst
EWX_FORCE = 4 ' 强制关机
EWX_LOGOFF = 0 ' 登出
EWX_REBOOT = 2 ' 重开机
EWX_SHUTDOWN = 1 ' 关机
EWX_POWEROFF = 8
End Enum

Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const ANYSIZE_ARRAY = 1

Private Type LUID
lowpart As Long
highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _
"LookupPrivilegeValueA" (ByVal lpSystemName As String, _
ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" _
(ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" _
(ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long

Public Sub AdjustToken()
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
'Get the LUID for shutdown privilege.
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
tkp.PrivilegeCount = 1 ' One privilege to set
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
'Enable the shutdown privilege in the access token of this process.
AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), _
tkpNewButIgnored, lBufferNeeded
End Sub
yoki 2003-10-16
  • 打赏
  • 举报
回复
可以呀

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧