标题:求助 各路高人 班长 能不能修改一下循环计时代码
只看楼主
fengjianxina
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2011-10-22
结帖率:100%
 问题点数:0 回复次数:1 
求助 各路高人 班长 能不能修改一下循环计时代码
下面代码不能显示秒数的变化(就像电脑屏幕右下角分 秒都是变化的)   只有到时间点儿了才有音乐提示   那位高人修理一下   不要那个时间间隔框也行 换成时间即时变化框 只要有秒数变化的动态显示就行    音乐提示可别去掉哦
另存.hta或html格式  双击就运行
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>闹钟</title>
<script language="vbscript">
<!-- Insert code, subroutines, and functions here -->
Option Explicit
Const CONFIG_FILE = "timer.cfg"
Dim g_sInitDir, g_nID, g_oPlayer
resizeTo 350, 180
moveTo (screen.width - 350) / 2, (screen.height - 180) / 2



Sub window_onLoad()
 Dim oWSH, oFSO, oFile, a
 Set oWSH = CreateObject("WScript.Shell")
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 If oFSO.FileExists(CONFIG_FILE) Then
  Set oFile = oFSO.OpenTextFile(CONFIG_FILE)
  a = Split(oFile.ReadAll(), "|")
  document.all("interval").value = a(0)
  document.all("music").value = a(1)
  g_sInitDir = a(1) & "\.."
 Else
  Set oFile = oFSO.CreateTextFile(CONFIG_FILE)
  g_sInitDir = oWSH.ExpandEnvironmentStrings("%windir%") & "\media"
  oFile.Write "60|" & g_sInitDir & "\notify.wav"
  document.all("interval").value = "60"
  document.all("music").value = g_sInitDir & "\notify.wav"
 End If
 oFile.Close
 Set oFile = Nothing
 Set oWSH = Nothing
 Set oFSO = Nothing
End Sub

Sub scan_onClick()
 Dim oWSH, oDialog, sCurrentDir
 Set oWSH = CreateObject("WScript.Shell")
 Set oDialog = CreateObject(")
 oDialog.Filter = "所有文件(*.*)|*.*"
 oDialog.InitialDir = g_sInitDir
 sCurrentDir = oWSH.CurrentDirectory
 If oDialog.ShowOpen() then
  document.all("music").value = oDialog.FileName
  oWSH.CurrentDirectory = sCurrentDir
 End If
 Set oDialog = Nothing
 Set oWSH = Nothing
End Sub

Sub start_onClick()
 Dim oFSO, oFile, lInterval, sMusic
 
 If Not IsNumeric(document.all("interval").value) Then
  ShowMsg "时间间隔必须是数字!"
  Exit Sub
 End If
 sMusic = document.all("music").value
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 lInterval = CLng(document.all("interval").value)
 If Not oFSO.FileExists(sMusic) Then
  ShowMsg "找不到音乐文件!"
  Exit Sub
 End If
 document.all("interval").disabled = True
 document.all("music").disabled = True
 document.all("scan").disabled = True
 document.all("start").disabled = True
 document.all("stop").disabled = False
  Set oFile = oFSO.CreateTextFile(CONFIG_FILE, True)
  oFile.Write CStr(lInterval) & "|" & sMusic
  oFile.Close
  Set oFile = Nothing
 Set oFSO = Nothing
 
 lInterval = lInterval * 1000
 g_nID = setInterval("PlayMusic", lInterval)
End Sub

Sub stop_onClick()
 clearInterval g_nID
 If IsObject(g_oPlayer) Then
  If g_oPlayer.controls.isavailable("stop") Then g_oPlayer.controls.stop
  Set g_oPlayer = Nothing
 End If
 document.all("interval").disabled = False
 document.all("music").disabled = False
 document.all("scan").disabled = False
 document.all("start").disabled = False
 document.all("stop").disabled = True
End Sub

Sub PlayMusic()
 Set g_oPlayer = CreateObject("WMPlayer.OCX")
 g_oPlayer.URL = document.all("music").value
 g_oPlayer.controls.play
End Sub

Sub ShowMsg(s)
 document.all("msg").innerHTML = "<font color=""red"" size=""2px"">" & s & "</font>"
 setTimeout "document.all(""msg"").innerHTML = """"", 3000
End Sub
</script>
<hta:application
 applicationname="Timer"
 border="dialog"
 borderstyle="normal"
 
 contextmenu="no"
 icon="myicon.ico"
 maximizebutton="no"
 minimizebutton="yes"
 navigable="no"
 scroll="no"
 selection="no"
 showintaskbar="yes"
 singleinstance="yes"
 sysmenu="yes"
 version="1.0"
 windowstate="normal"
>
</head>
<body>
<!-- HTML goes here -->
<p align="center">
时间间隔:<input type="text" id="interval" style="width: 65%" />(秒)
<br />
音乐路径:<input type="text" id="music" style="width: 65%" /><input type="button" id="scan" value="..." />
<br />

</p>
<p align="center">
<input type="button" id="start" value=" 开始 " />   <input type="button" id="stop" value=" 结束 " disabled=true/>
</p>
<div id="msg"></div>
</body>
</html>
搜索更多相关主题的帖子: 音乐 content title 动态 
2011-11-09 19:32
fengjianxina
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2011-10-22
得分:0 
晕   不信没人会
2011-11-17 08:14



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-354758-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.650224 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved