用VB设计一个动画时钟程序（要求具有真实钟表界面，并有闹钟功能）。
Option Explicit
DefDbl A-Z
Private SubForm_Load()
Timer1.Interval = 100
Width = 4000
Height = 4000
Left = Screen.Width \ 2 - 2000
Top = (Screen.Height - Height) \ 2
EndSub
Private SubForm_Resize()
Dimi , Angle
StaticflagAsBoolean
Ifflag = FalseThen
Flag = True
For i = 0 To 14
'画出表盘12个点和时、分、秒共15个LINE
If i > 0 Then LoadLine1 (i)
Line1(i).Visible = True
Line1(i).BorderWidth = 5
Line1(i).BorderColor = RGB(0, 128, 0) '设置LINE的粗细和颜色
Nexti
End If
For i = 0 To 14
Scale (-1, 1)-(1, -1)
Angle = i * 2 * Atn(1) / 3
Line1(i).x1 = 0.9 * Cos(Angle)
Line1(i).y1 = 0.9 * Sin(Angle)
Line1(i).x2 = Cos(Angle)
Line1(i).y2 = Sin(Angle)
Nexti
EndSub
Private Subtimer1_Timer()
ConstHH = 0
ConstMH = 13
ConstSH = 14
DimAngle
StaticLS
IfSecond(Now) = LSThenExitSub
LS = Second(Now)
Angle = 0.5236 * (15 - (Hour(Now)(Minute(Now) / 60))) '设置时针
Line1(HH).x1 = 0
Line1(HH).y1 = 0
Line1(HH).x2 = 0.3 * Cos(Angle)
Line1(HH).y2 = 0.3 * 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))
'设置秒针
Line1(SH).x1 = 0
Line1(SH).y1 = 0
Line1(SH).x2 = 0.8 * Cos(Angle)
Line1(SH).y2 = 0.8 * Sin(Angle)
Form1.Caption = Str(Now())
'窗口显示精确的日期和数字化的时间
EndSub 展开
你这个表针想要更逼真就比较难办了： 所有修改过的代码如下
'首先在窗体上先画一个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
非常感谢！！！那个，你能再帮我加个闹钟功能不
当然可以啦，每天只闹一次吗？还是每天要闹多少次哦。
红蓝视觉
2024-12-12 广告
不行啊，运行的时候老是显示无效的外部过程
这个我就不知道了，不好意思啊
