Dim day, year, month, ddate, ttime As String
Dim alf(0 To 11)
Dim rr
Dim nhourlen, nminlen, nseclen As Integer
Const pi = 3.14159265358979
Private Sub Form_Load()
Timer1.Interval = 1000
End Sub
Private Sub Timer1_Timer()
rr = pictime.Height / 2
ddate = Format(Now, "mm:dd:yy")
ttime = Format(Now, "hh:mm:ss")
month = Left(ddate, 2)
day = Mid(ddate, 4, 2)
year = Right(ddate, 2)
hh = Left(ttime, 2)
mm = Mid(ttime, 4, 2)
ss = Right(ttime, 2)
txtyear.Text = "20" & year
txtmth.Text = month
txtday.Text = day
lbltime.Caption = Time
nwidth = pictime.Width - 40
nhourlen = nwidth * 4 / 18
nminlen = nwidth * 6 / 18
nseclen = nwidth * 8 / 18
alfsec = ((ss - 15) / 30) * pi
alfmin = ((mm + ss / 60 - 15) / 30) * pi
alfhour = ((hh + mm / 60 + ss / 3600 - 15) / 6) * pi
pictime.Refresh
For i = 0 To 11
alf(i) = i * 30 * pi / 180
pictime.DrawWidth = 1
If i = 0 Or i = 3 Or i = 6 Or i = 9 Then
pictime.DrawWidth = 3
End If
pictime.Line (rr + (rr - 100) * Cos(alf(i)), rr + (rr - 100) * Sin(alf(i)))-(rr + (rr - 300) * Cos(alf(i)), rr + (rr - 300) * Sin(alf(i))), RGB(255, 0, 255)
Next i
pictime.DrawWidth = 3
pictime.Line (rr, rr)-(rr + nhourlen * Cos(alfhour), rr + nhourlen * Sin(alfhour))
pictime.DrawWidth = 2
pictime.Line (rr, rr)-(rr + nminlen * Cos(alfmin), rr + nminlen * Sin(alfmin))
pictime.DrawWidth = 1
pictime.Line (rr, rr)-(rr + nseclen * Cos(alfsec), rr + nseclen * Sin(alfsec))
pictime.DrawWidth = 5
pictime.PSet (rr, rr), RGB(255, 0, 255)
End Sub
注 你的PICTURE1是PICTURE BOX 并改名為PICTIME
同時添加1個時間控件TIMER1 3個TEXT BOX 并分別命名為txtyear, txtmth ,txtday
1個LABEL 命名為LBLTIME就可以了