clockmain.frm

一个好的VB时钟程度代码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "钟"
   ClientHeight    =   3795
   ClientLeft      =   9120
   ClientTop       =   1245
   ClientWidth     =   2010
   Icon            =   "Clockmain.frx":0000
   LinkTopic       =   "Form1"
   Picture         =   "Clockmain.frx":0442
   ScaleHeight     =   3795
   ScaleWidth      =   2010
   Begin VB.Timer Timer1 
      Interval        =   200
      Left            =   720
      Top             =   2040
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "21"
      ForeColor       =   &H00000000&
      Height          =   195
      Left            =   1290
      TabIndex        =   0
      Top             =   1800
      Width           =   195
   End
   Begin VB.Line Line3 
      BorderColor     =   &H000000FF&
      X1              =   920
      X2              =   920
      Y1              =   1340
      Y2              =   1880
   End
   Begin VB.Line Line2 
      BorderColor     =   &H000000FF&
      BorderWidth     =   2
      X1              =   920
      X2              =   920
      Y1              =   1580
      Y2              =   1880
   End
   Begin VB.Line Line1 
      BorderColor     =   &H000080FF&
      BorderWidth     =   2
      X1              =   920
      X2              =   920
      Y1              =   1480
      Y2              =   1880
   End
   Begin VB.Menu MFile 
      Caption         =   "文件"
      Visible         =   0   'False
      Begin VB.Menu Changetime 
         Caption         =   "更改时间"
      End
      Begin VB.Menu small 
         Caption         =   "最小化"
      End
      Begin VB.Menu Showfrm 
         Caption         =   "隐藏界面"
      End
      Begin VB.Menu proB1 
         Caption         =   "-"
      End
      Begin VB.Menu Openwave 
         Caption         =   "开启声音"
      End
      Begin VB.Menu Mclwav 
         Caption         =   "关闭声音"
      End
      Begin VB.Menu Alerttime 
         Caption         =   "定时提醒/闹铃"
      End
      Begin VB.Menu Prob2 
         Caption         =   "-"
      End
      Begin VB.Menu Closeme 
         Caption         =   "关闭程序"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public htoday As Boolean, alc As Integer
Dim ts As Integer, closewave As Boolean
Public Sub controlpanels(filename As String)
   Dim rtn As Double
   On Error Resume Next
   rtn = Shell(filename, 5)
End Sub
Private Sub Alerttime_Click()
    Form3.Show
End Sub
Private Sub Changetime_Click()
    Call controlpanels("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl")
End Sub
Private Sub Closeme_Click()
    End
End Sub
Private Sub Form_Load()
    Call PutWindowOnTop(Form1)
    Call drewfrm(Me.hWnd, App.Path + "\clockh.pfm")
    closewave = False
    Label1.Caption = Right(Format(Now, "yy-mm-dd"), 2)
    htoday = False
    Dim a As Integer, b As Integer, c As Integer
    Dim inputdata As String
    Open App.Path + "\forever.dat" For Input As 1
    On Error Resume Next
    Do While Not EOF(1)
      Line Input #1, inputdata
      Select Case typetime(inputdata)
          Case 1
             Clockf(a) = Mid$(inputdata, 5)
             a = a + 1
          Case 3
             Alertft(b) = Mid$(inputdata, 5, 5)
             alertfms(b) = Mid$(inputdata, 10)
             b = b + 1
          Case 4
             If Mid$(inputdata, 11, 8) = Format(Now, "yy-mm-dd") Then
              htoday = True
              Alertot(c) = Mid$(inputdata, 5, 5)
              alertoda(c) = Mid$(inputdata, 11, 8)
              alertoms(c) = Mid$(inputdata, 19)
              c = c + 1
             End If
      End Select
    Loop
    alc = c - 1
    Close #1
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then
       PopupMenu MFile
    ElseIf Button = 1 Then
       Dim ret As Long
       ReleaseCapture
       ret& = SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0)
    End If
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Label1.ToolTipText = Format(Now, "yyyy年mm月dd日hh:mm")
End Sub

Private Sub Mclwav_Click()
    closewave = True
End Sub

Private Sub Openwave_Click()
    closewave = False
End Sub
Private Sub Showfrm_Click()
    Form2.Show
    Me.Hide
End Sub
Private Sub small_Click()
    Me.WindowState = 1
End Sub
Private Sub Timer1_Timer()
  Call timemove(Format(Time$, "hh:mm:ss"))
  ts = ts + 1
  If ts = 5 Then
   If closewave = False Then
    k = App.Path + "\clock.wav"
    l = &H1 Or &H2
    i = sndPlaySound(k, l)
   End If
    ts = 0
  End If
  For i = 0 To 50
    If Alertft(i) = Format(Time$, "hh:mm") Then
       MsgBox alertfms(i), vbOKOnly + vbInformation + vbApplicationModal, "每日定时提醒"
       Alertft(i) = "hh:mm"
    End If
    If Clockf(i) = Format(Time$, "hh:mm") Then
       Clockf(i) = "hh:mm"
       ts = -10
       k = App.Path + "\Cuckoo.wav"
       l = &H1 Or &H2
       i = sndPlaySound(k, l)
    ElseIf clockn(i) = Format(Time$, "hh:mm") Then
       clockn(i) = "hh:mm"
       ts = -10
       k = App.Path + "\Cuckoo.wav"
       l = &H1 Or &H2
       i = sndPlaySound(k, l)
    End If
  Next i
  If htoday = True Then
     For i = 0 To alc
        If Alertot(i) = Format(Time$, "hh:mm") Then
           MsgBox alertoms(i), vbOKOnly + vbInformation + vbApplicationModal, "提醒你"
           Alertot(i) = "hh:mm"
        End If
     Next i
  End If
End Sub