www.pudn.com > 精巧的小闹钟.rar > Frmclock.frm
VERSION 5.00
Begin VB.Form Frmclock
BorderStyle = 3 'Fixed Dialog
Caption = "闹钟"
ClientHeight = 1170
ClientLeft = 45
ClientTop = 435
ClientWidth = 2295
Icon = "Frmclock.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1170
ScaleWidth = 2295
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Tmrset
Enabled = 0 'False
Interval = 10
Left = 1920
Top = 0
End
Begin VB.Timer Tmrclk
Interval = 800
Left = 0
Top = 0
End
Begin VB.CommandButton Cmdstop
Caption = "停止"
BeginProperty Font
Name = "华文行楷"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1320
TabIndex = 2
Top = 720
Width = 855
End
Begin VB.CommandButton Cmdset
Caption = "设置"
BeginProperty Font
Name = "华文行楷"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 1
Top = 720
Width = 855
End
Begin VB.Label lblClk
Alignment = 2 'Center
BackColor = &H00404040&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "隶书"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF00&
Height = 495
Left = 120
TabIndex = 0
Top = 120
Width = 2055
End
Begin VB.Menu mnuhelp
Caption = "ys"
Visible = 0 'False
Begin VB.Menu mnuHelpAbout
Caption = "关于"
End
Begin VB.Menu mnuHelpSep1
Caption = "-"
End
Begin VB.Menu mnuHelpExit
Caption = "退出"
End
End
End
Attribute VB_Name = "Frmclock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strTime As String
'这些是可以让窗口永远在所有窗口最上边的函数
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOCOPYBITS = &H80
Private Const SWP_NOOWNERZORDER = &H200
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Private Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Private Const HWND_TOP = 0
Private Const HWND_BOTTOM = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private mbOnTop As Boolean
Private Property Let OnTop(Setting As Boolean)
If Setting Then
SetWindowPos hwnd, -1, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Else
SetWindowPos hwnd, -2, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End If
mbOnTop = Setting
End Property
Private Property Get OnTop() As Boolean
OnTop = mbOnTop
End Property
'调用 OnTop=True 即可让窗口 Always OnTop。
Public Sub cmdSet_Click()
Load Frmset
Frmset.Show vbModal
End Sub
Public Sub cmdStop_Click()
lblClk.Caption = Time
Tmrclk.Enabled = True
Tmrset.Enabled = False
Cmdset.Enabled = True
strTime = ""
PlaySound ""
End Sub
'避免延迟
Public Sub Form_Load()
lblClk.Caption = Time
OnTop = True
End Sub
Public Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
lblClk.Caption = Time
Tmrclk.Enabled = True
If Button = vbRightButton Then
PopupMenu mnuhelp
End If
Tmrset.Enabled = False
Cmdset.Enabled = True
strTime = ""
PlaySound ""
End Sub
Public Sub PlaySound(filename)
Dim cmd As String
Dim sd As String
Call mciSendString("close MyWav", 0, 0, 0) ' MyWav 这个名称可依需要来修改
cmd = "open " & filename & " type WAVEAudio alias MyWav"
Call mciSendString(cmd, 0, 0, 0)
Call mciSendString("play MyWav", 0, 0, 0)
End Sub
Public Sub Form_Resize()
If Tmrset.Enabled Then Exit Sub
If Me.WindowState = vbMinimized Then
Me.Caption = "闹钟 - " & Time
Else
Me.Caption = "闹钟"
End If
End Sub
Private Sub lblClk_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
lblClk.Caption = Time
Tmrclk.Enabled = True
If Button = vbRightButton Then
PopupMenu mnuhelp
End If
Tmrset.Enabled = False
Cmdset.Enabled = True
strTime = ""
PlaySound ""
End Sub
Public Sub mnuHelpAbout_Click()
MsgBox "Author:张宇翔" & vbCrLf & "QQ:203057" & vbCrLf & "Email:203057@qq.com", _
vbInformation, "关于闹钟"
End Sub
Public Sub mnuHelpExit_Click()
Unload Frmset
Unload Me
End
End Sub
'显示时间
Public Sub tmrClk_Timer()
lblClk.Caption = Time
If Me.WindowState = vbMinimized Then
Me.Caption = "闹钟 - " & Time
End If
If Time = strTime Then
Frmset.Hide
Me.WindowState = vbNormal
Me.Show
Cmdset.Enabled = False
Tmrset.Enabled = True
PlaySound (sd)
End If
End Sub
'提醒
Public Sub tmrSet_Timer()
Randomize
Tmrclk.Enabled = False
lblClk.Caption = "时间到了"
Me.Top = Me.Top + Int(121 * Rnd - 60)
Me.Left = Me.Left + Int(121 * Rnd - 60)
Dim retStr As String * 80
Call mciSendString("status MyWav mode", retStr, 80, 0)
If Left(retStr, 7) = "stopped" Then ' 如果停止了
PlaySound (sd) ' 重复播放
End If
End Sub