导航

« photoshop 快速蒙版When Pets Age: The Best Way to Care for Older Pets  »

2009-9-13 9:57:31

vb6.0 实用小闹钟 附代码

虚位以待 Vb6.0

用VB6.0写的简单实用的小闹钟,可以指定时间也可以选择倒计时模式,设定时间后即刻生效;倒计时模式设置后点开始.闹钟的声音(beep)默认开启.

 下载:小闹钟.rar   程序大小:9K

 

（.NET本版：Clock.rar  2012-1-31）

clock

 

最新改动：2009-09-14 增加到时关机功能

更新：以下是vb6.0小闹钟的全部代码

折叠ASP/Visual Basic Code复制内容到剪贴板
  1. '================================================================   
  2. 'By kfCalf www.spersky.com;勾月http://download.csdn.net/user/gouyue   
  3. '================================================================   
  4.   
  5. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _   
  6.           ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long  
  7.        Const HWND_TOPMOST = -1 '最前   
  8.        Const HWND_NOTOPMOST = -2   
  9.           
  10.         Const LWA_ALPHA = &H2&   
  11.  Const LWA_COLORKEY = &H1&   
  12.  Const GWL_EXSTYLE = (-20)   
  13.  Const WS_EX_LAYERED = &H80000   
  14.  Const WS_EX_TRANSPARENT = &H20&   
  15.  'icon   
  16.  Const MAX_TOOLTIP As Integer = 64   
  17.  Const NIF_ICON = &H2                          '删除图标   
  18.  Const NIF_MESSAGE = &H1   
  19.  Const NIF_TIP = &H4   
  20.  Const NIM_ADD = &H0                          '添加图标到任务栏提示区   
  21.  Const NIM_DELETE = &H2   
  22.  Const WM_MOUSEMOVE = &H200   
  23.  Const WM_LBUTTONDOWN = &H201   
  24.  Const WM_LBUTTONUP = &H202   
  25.  Const WM_LBUTTONDBLCLK = &H203   
  26.  Const WM_RBUTTONDOWN = &H204   
  27.  Const WM_RBUTTONUP = &H205   
  28.  Const WM_RBUTTONDBLCLK = &H206   
  29.  Const SW_RESTORE = 9   
  30.  Const SW_HIDE = 0   
  31.  Private Type NOTIFYICONDATA   
  32.     cbSize           As Long  
  33.     hwnd             As Long  
  34.     uID              As Long  
  35.     uFlags           As Long  
  36.     uCallbackMessage As Long  
  37.     hIcon            As Long  
  38.     szTip            As String * MAX_TOOLTIP   
  39. End Type   
  40. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _   
  41.     ByVal nCmdShow As Long) As Long  
  42. Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _   
  43.     (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long  
  44. Private nfIconData As NOTIFYICONDATA 'icon   
  45.   
  46. 'flash   
  47. Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long  
  48. 'sound   
  49.   
  50. Dim a, b, c As String  
  51. Dim ok, Dok As Boolean '时间到   
  52. Dim MyTime, systime   
  53. Dim info As String  
  54. Dim Shour, Smin, Ssec, PosiH   
  55. Dim Dh, Dm, Ds '倒计时参数声明   
  56. Dim Time As Date '倒计时   
  57.   
  58.   
  59. Private Sub cmdDreset_Click()   
  60.     Dh = 0   
  61.     Dm = 0   
  62.     Ds = 0   
  63.     Time = 0   
  64.     txtDh.Text = " "  
  65.     txtDm.Text = " "  
  66.     txtDs.Text = " "  
  67.     txtDh.SetFocus '获得焦点   
  68.     Dok = False  
  69. cmdDstart.Enabled = True  
  70. Shell "shutdown -a" '取消关机   
  71. End Sub  
  72.   
  73. Private Sub cmdDstart_Click()   
  74.     TimCount.Enabled = True  
  75.     If Not Lblcount.Caption = "00:00:00" Then  
  76.         Dok = True  
  77.     End If  
  78.     cmdDstart.Enabled = False  
  79. End Sub  
  80.   
  81. Private Sub Command1_Click()   
  82. Call Shell_NotifyIcon(NIM_DELETE, nfIconData)   
  83. End  
  84. End Sub  
  85.   
  86. Private Sub Command2_Click()   
  87. systime = Format(Now, "hh:mm:ss")   
  88.   
  89. PosiH = InStr(1, systime, ":")   
  90. Shour = Mid(systime, 1, PosiH - 1)   
  91. Text1.Text = Shour   
  92.   
  93. Smin = Mid(systime, 4, 2)   
  94. Text2.Text = Smin   
  95. Text3.Text = "00"  
  96. ok = False  
  97. Shell "shutdown -a" '取消关机   
  98. End Sub  
  99.   
  100.   
  101. Private Sub Form_Load()   
  102. SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, _   
  103.               Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _   
  104.          Me.Height \ Screen.TwipsPerPixelY, 0   
  105.             
  106.          nfIconData.hwnd = Me.hwnd   
  107.   nfIconData.uID = Me.Icon   
  108.   nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP   
  109.   nfIconData.uCallbackMessage = WM_MOUSEMOVE   
  110.   nfIconData.hIcon = Me.Icon.Handle   
  111.   nfIconData.szTip = "小闹钟" & vbNullChar   
  112.   nfIconData.cbSize = Len(nfIconData)   
  113.   Call Shell_NotifyIcon(NIM_ADD, nfIconData)   
  114. ok = False  
  115. Dok = False  
  116.   
  117. Timer2.Interval = 1000   
  118.   
  119. systime = Format(Now, "hh:mm:ss")   
  120.   
  121. PosiH = InStr(1, systime, ":")   
  122. Shour = Mid(systime, 1, PosiH - 1)   
  123. Text1.Text = Shour   
  124.   
  125. Smin = Mid(systime, 4, 2)   
  126. Text2.Text = Smin   
  127.   
  128.     Dh = 0 '倒计时部分   
  129.     Dm = 0   
  130.     Ds = 0   
  131.     Time = 0   
  132.   
  133. End Sub  
  134.   
  135. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)   
  136. Dim d As Single  
  137.   d = X / Screen.TwipsPerPixelX   
  138.   
  139.    If d = WM_LBUTTONUP Then  
  140.      If Me.WindowState = vbNormal Then  
  141.         Me.WindowState = vbMinimized   
  142.         Me.Visible = False  
  143.         Else  
  144.         Me.WindowState = vbNormal   
  145.         Me.Visible = True  
  146.      End If  
  147.    End If  
  148.            
  149.         
  150. End Sub  
  151.   
  152. Private Sub Form_Resize()   
  153.      If Me.WindowState = vbNormal Then  
  154.        
  155.         Me.Visible = True  
  156.         Else  
  157.          
  158.         Me.Visible = False  
  159.      End If  
  160. End Sub  
  161.   
  162. Private Sub Form_Unload(Cancel As Integer)   
  163. Call Shell_NotifyIcon(NIM_DELETE, nfIconData)   
  164. End  
  165. End Sub  
  166.   
  167. Private Sub Label8_Click()   
  168. Shell "explorer http://www.spersky.com/post/vb6Miniclock.html", 1   
  169. End Sub  
  170.   
  171.   
  172. Private Sub Text1_Click()   
  173. Text1.SelStart = 0   
  174. Text1.SelLength = Len(Text1.Text)   
  175. End Sub  
  176.   
  177.   
  178. Private Sub Text2_Click()   
  179. Text2.SelStart = 0   
  180. Text2.SelLength = Len(Text2.Text)   
  181. End Sub  
  182.   
  183.   
  184. Private Sub Text3_Click()   
  185. Text3.SelStart = 0   
  186. Text3.SelLength = Len(Text3.Text)   
  187. End Sub  
  188.   
  189. Private Sub TimCount_Timer()   
  190.     'Count down loop   
  191.     TimCount.Enabled = False  
  192.     If (VBA.Format(Time, "hh") & ":" & VBA.Format(Time, "nn") & ":" & VBA.Format(Time, "ss")) <> "00:00:00" Then 'Counter to continue loop until 0   
  193.         Time = DateAdd("s", -1, Time)   
  194.         'Lblcount.Visible = False   
  195.         Lblcount.Caption = VBA.Format(Time, "hh") & ":" & VBA.Format(Time, "nn") & ":" & VBA.Format(Time, "ss")   
  196.         'Lblcount.Visible = True   
  197.         TimCount.Enabled = True  
  198.     Else  
  199.         'Turn off timer, set off alarm, and enable reset.   
  200.         TimCount.Enabled = False  
  201.         Beep   
  202.     End If  
  203. End Sub  
  204.   
  205. Private Sub Timer1_Timer()   
  206. a = Text1.Text   
  207. b = Text2.Text   
  208. c = Text3.Text   
  209. MyTime = a & ":" & b & ":" & c   
  210. systime = Format(Now, "hh:mm:ss")   
  211. 'MsgBox systime   
  212. If MyTime = systime Then  
  213. ok = True  
  214. End If  
  215.   
  216. End Sub  
  217.   
  218. Private Sub Timer2_Timer()   
  219. Me.Caption = "小闹钟   " & systime   
  220.   
  221. End Sub  
  222.   
  223. Private Sub Timer3_Timer()   
  224. info = Text4.Text   
  225. If ok = True Or (Dok = True And Lblcount.Caption = "00:00:00") Then  
  226. Call FlashWindow(Me.hwnd, True)   
  227. Me.Caption = "小闹钟1.0   " & info   
  228. Me.WindowState = vbNormal   
  229. Me.Visible = True  
  230.     If chkSound.Value = 1 Then  
  231.          Beep   
  232.     End If  
  233.     If chkShut.Value = 1 Then  
  234.         Shell "shutdown -s -t 10" '执行这代码后，10秒内关机   
  235.     End If  
  236. End If  
  237.   
  238.   
  239. End Sub  
  240.   
  241.   
  242. Private Sub TxtToLbl()   
  243.     Dh = Val(txtDh.Text)   
  244.     Dm = Val(txtDm.Text)   
  245.     Ds = Val(txtDs.Text)   
  246.     Time = TimeSerial(Dh, Dm, Ds)   
  247.     Lblcount.Caption = VBA.Format(Time, "hh") & ":" & VBA.Format(Time, "nn") & ":" & VBA.Format(Time, "ss")   
  248. End Sub  
  249.   
  250. Private Sub txtDh_Change()   
  251. TxtToLbl   
  252. End Sub  
  253.   
  254. Private Sub txtDm_Change()   
  255. TxtToLbl   
  256. End Sub  
  257.   
  258. Private Sub txtDs_Change()   
  259. TxtToLbl   
  260. End Sub  
  261.   
  262.   
  263.   

 

  • 顶一下
发布:Calf | 分类:编程学习 | 评论:4 | 引用:0 | 浏览:
虚位以待




原创文章如转载，请注明：转载自落日故乡

本文链接地址：http://www.spersky.com/post/vb6Miniclock.html
  • quote 2楼  xhunter
  • head
    非常好用的小工具，特别适合玩定时的小游戏！感谢作者。
  • 2011/10/26 14:57:37 回复该留言

发表评论:

◎欢迎参与讨论，请在这里发表您的看法、交流您的观点。

内容搜索


虚位以待

常用链接

最新评论及回复

Powered By Z-Blog

Copyright spersky All Rights Reserved.Theme Moonlight,Calf modified.n 浙ICP备16017820号-1