原贴地址: http://bbs.bc-cn.net/bbs/dispbbs.asp?boardID=6&ID=18083&page=1 '///////////////////////////////// Const PI = 3.1415926 Private Sub Form_Load() Private Sub Init() BaseX = Me.ScaleWidth / 2 For i = 0 To 360 Step 6 '绘制指针 Second = DatePart("s", Time) Me.DrawWidth = 1 DrawLine BaseX - r1 * Sin(Second * PI / 30), BaseY + r1 * Cos(Second * PI / 30), BaseX + (R - 10) * Sin(Second * PI / 30), BaseY - (R - 10) * Cos(Second * PI / 30), 0 '画线函数 Private Sub Form_Resize() Private Sub Timer1_Timer()
'小闹钟示例
'Written By griefforyou
'在窗体中添加一个Timer控件,将Interval设为1000以下。
'////////////////////////////////
Option Explicit
Dim BaseX As Integer, BaseY As Integer, R As Integer
Dim r1 As Integer, r2 As Integer, r3 As Integer
Me.ScaleMode = 3
Me.AutoRedraw = True
If Me.Width < 3000 Then Me.Width = 3000
If Me.Height < 3000 Then Me.Height = 3000
End Sub
Dim i As Integer
BaseY = Me.ScaleHeight / 2
R = IIf(BaseX > BaseY, BaseY * 0.8, BaseY * 0.8)
r1 = R * 0.2
r2 = R * 0.1
r3 = R * 0.05
If i Mod 30 = 0 Then '时
Me.DrawWidth = 2
DrawLine BaseX + (R - 3) * Sin(i * PI / 180), BaseY - (R - 3) * Cos(i * PI / 180), BaseX + (R - 8) * Sin(i * PI / 180), BaseY - (R - 8) * Cos(i * PI / 180), 3
Else '分
Me.DrawWidth = 2
Me.PSet (BaseX + (R - 3) * Sin(i * PI / 180), BaseY - (R - 3) * Cos(i * PI / 180))
End If
Next
Me.DrawWidth = 1
Me.Circle (BaseX, BaseY), R
End Sub
Private Sub DrawClock()
Dim Second As Integer
Dim Minute As Integer
Dim Hours As Integer
Minute = DatePart("n", Time)
Hours = DatePart("h", Time)
If Hours > 12 Then
Hours = Hours - 12
End If
Me.Circle (BaseX, BaseY), 4
DrawLine BaseX - r2 * Sin(Minute * PI / 30), BaseY + r2 * Cos(Minute * PI / 30), BaseX + R * 0.8 * Sin(Minute * PI / 30), BaseY - R * 0.8 * Cos(Minute * PI / 30), 1
DrawLine BaseX - r3 * Sin((Hours + Minute / 60) * PI / 6), BaseY + r3 * Cos((Hours + Minute / 60) * PI / 6), BaseX + R * 0.6 * Sin((Hours + Minute / 60) * PI / 6), BaseY - R * 0.6 * Cos((Hours + Minute / 60) * PI / 6), 2
End Sub
Private Sub DrawLine(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, Flag As Integer)
Static OldSX1 As Integer, OldSX2 As Integer, OldSY1 As Integer, OldSY2 As Integer
Static OldMX1 As Integer, OldMX2 As Integer, OldMY1 As Integer, OldMY2 As Integer
Static OldHX1 As Integer, OldHX2 As Integer, OldHY1 As Integer, OldHY2 As Integer
Select Case Flag
Case 0
Me.DrawWidth = 1
Me.Line (OldSX1, OldSY1)-(OldSX2, OldSY2), Me.BackColor
Me.Line (x1, y1)-(x2, y2)
OldSX1 = x1
OldSX2 = x2
OldSY1 = y1
OldSY2 = y2
Case 1
Me.DrawWidth = 2
Me.Line (OldMX1, OldMY1)-(OldMX2, OldMY2), Me.BackColor
Me.Line (x1, y1)-(x2, y2)
OldMX1 = x1
OldMX2 = x2
OldMY1 = y1
OldMY2 = y2
Case 2
Me.DrawWidth = 3
Me.Line (OldHX1, OldHY1)-(OldHX2, OldHY2), Me.BackColor
Me.Line (x1, y1)-(x2, y2)
OldHX1 = x1
OldHX2 = x2
OldHY1 = y1
OldHY2 = y2
Case Else
Me.Line (x1, y1)-(x2, y2)
End Select
End Sub
Me.Cls
Call Init
End Sub
Call DrawClock
End Sub
文章来源于领测软件测试网 https://www.ltesting.net/
版权所有(C) 2003-2010 TestAge(领测软件测试网)|领测国际科技(北京)有限公司|软件测试工程师培训网 All Rights Reserved
北京市海淀区中关村南大街9号北京理工科技大厦1402室 京ICP备2023014753号-2
技术支持和业务联系:info@testage.com.cn 电话:010-51297073