用VB设计一个动画时钟程序(要求具有真实钟表界面,并有闹钟功能)。

2025-04-25 23:36:53
推荐回答(1个)
回答1:

你这个表针想要更逼真就比较难办了: 所有修改过的代码如下

'首先在窗体上先画一个Line控件、并设置其index属性为0

Option Explicit

DefDbl A-Z

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Const HTCAPTION = 2

Const WM_NCLBUTTONDOWN = &HA1

Private Sub Form_DblClick()

  End

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

  Dim r As Long

  Dim i

  If Button = 1 Then

     i = ReleaseCapture()

     r = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)

  End If

End Sub

Private Sub Form_Load()

  Timer1.Interval = 1000

  Width = 3330  '4000

  Height = 3615 '4000

  Left = Screen.Width \ 2 - 2000

  Top = (Screen.Height - Height) \ 2

  Me.Caption = "电子时钟"

  Me.AutoRedraw = True

  'Me.MinButton = False  '这项要手动设置

  'Me.MaxButton = False  '这项要手动设置

  Label1.ForeColor = &HFF&

  Label2.ForeColor = &HFF&

  Label1.Alignment = 2

  Label2.Alignment = 2

  Label1.BackStyle = 0

  Label2.BackStyle = 0

End Sub

Private Sub Form_Resize()

  Dim i, Angle

  Static flag As Boolean

  If flag = False Then

    flag = True

    For i = 0 To 14

      '画出表盘12个点和时、分、秒共15个LINE

      If i > 0 Then Load Line1(i)

      Line1(i).Visible = True

      Line1(i).BorderWidth = 2

      Line1(i).BorderColor = RGB(0, 0, 0) '设置LINE的粗细和颜色

    Next i

  End If

  For i = 0 To 14  '绘制12条断线

    Scale (-1, 1)-(1, -1)

    Angle = i * 2 * Atn(1) / 3

    Line1(i).X1 = 0.98 * Cos(Angle)  '断线想长点就改0.98为0.93或更小

    Line1(i).Y1 = 0.98 * Sin(Angle)

    Line1(i).X2 = Cos(Angle)

    Line1(i).Y2 = Sin(Angle)

  Next i

End Sub

Private Sub timer1_Timer()

  Const HH = 0

  Const MH = 13

  Const SH = 14

  Dim Angle

  Static LS

  If Second(Now) = LS Then Exit Sub

  LS = Second(Now)

  

  '设置时针

  Angle = 0.5236 * (15 - (Hour(Now) + (Minute(Now) / 60)))

  Line1(HH).X1 = 0

  Line1(HH).Y1 = 0

  Line1(HH).X2 = 0.5 * Cos(Angle)

  Line1(HH).Y2 = 0.5 * Sin(Angle)

  

  '设置分针

  Angle = 0.1047 * (75 - (Minute(Now) + (Second(Now) / 60)))

  Line1(MH).X1 = 0

  Line1(MH).Y1 = 0

  Line1(MH).X2 = 0.7 * Cos(Angle)

  Line1(MH).Y2 = 0.7 * Sin(Angle)

  

  '设置秒针

  Angle = 0.5236 * (75 - Second(Now) / 5)

  Line1(SH).X1 = 0

  Line1(SH).Y1 = 0

  Line1(SH).X2 = 0.8 * Cos(Angle)

  Line1(SH).Y2 = 0.8 * Sin(Angle)

  

  Label1.ZOrder (1)      '电子显示器至后、否则会覆盖表针(移至表针后面)

  Label2.ZOrder (1)

  

  '窗口显示精确的日期和数字化的时间

  'Form1.Caption = Str(Time())     '显示数字到窗体顶部 =Str(Now())

  Label1.Caption = Str(Time())  '显示数字到表盘中央

  Select Case Weekday(Date, vbMonday)

  Case 1

    Label2.Caption = "星期一"

  Case 2

    Label2.Caption = "星期二"

  Case 3

    Label2.Caption = "星期三"

  Case 4

    Label2.Caption = "星期四"

  Case 5

    Label2.Caption = "星期五"

  Case 6

    Label2.Caption = "星期六"

  Case 7

    Label2.Caption = "星期日"

  End Select

End Sub