回 帖 发 新 帖 刷新版面

主题:特大时钟的代码

特大时钟的代码

本时钟的钟面直径就是你的电脑屏幕的高度,很大,很震撼。
新建一个工程,在窗体上添加1个计时器,其Interval=1000,窗体的StartUpPosition=2,窗体的字大小为初号,粗体。
代码如下:

Option Explicit
'圆形窗体
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'透明窗体
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Const PI = 3.141592653 '圆周率

Private Sub Form_Load()
Me.Height = Screen.Height
Me.Width = Me.Height
'SetWindowRgn hWnd, CreateEllipticRgn(0, 0, Me.Width / 15, Me.Width / 15), True '圆形窗体
Me.Scale (0, 0)-(10000, 10000)
SetWindowLong hWnd, -20, &H80000 '透明窗体
SetLayeredWindowAttributes hWnd, BackColor, 0, 1 '透明窗体
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 27 Then Unload Me
End Sub

Private Sub Timer1_Timer()
Dim a As Single '通过半径和角度计算指针各点坐标
Dim XX As Single, YY As Single
Dim i As Single, j As Integer
Cls
ForeColor = 255
CurrentX = 4200: CurrentY = 120: Print 12
CurrentX = 9030: CurrentY = 4620: Print 3
CurrentX = 4440: CurrentY = 9120: Print 6
CurrentX = -15: CurrentY = 4650: Print 9
    
ForeColor = 0
CurrentX = 6710: CurrentY = 750: Print 1
CurrentX = 8340: CurrentY = 2400: Print 2
CurrentX = 8340: CurrentY = 6900: Print 4
CurrentX = 6710: CurrentY = 8550: Print 5
CurrentX = 2240: CurrentY = 8550: Print 7
CurrentX = 600: CurrentY = 6900: Print 8
CurrentX = 420: CurrentY = 2460: Print 10
CurrentX = 2010: CurrentY = 780: Print 11

DrawWidth = 22: i = Hour(Time) + Minute(Time) / 60: a = PI * i / 6: ForeColor = &H800000
For j = 0 To 3200 Step 10 '画时针,通过循环打点画出从粗到细指针效果
  GoSub 100
  If j Mod 350 = 0 And DrawWidth > 1 Then DrawWidth = DrawWidth - 1 '调节指针粗细分布
  PSet (XX, YY)
Next

DrawWidth = 22: i = Minute(Time) + Second(Time) / 60: a = PI * i / 30
For j = 0 To 4100 Step 10  '画分针
  GoSub 100
  If j Mod 350 = 0 And DrawWidth > 1 Then DrawWidth = DrawWidth - 1
  PSet (XX, YY)
Next

DrawWidth = 15: i = Second(Time): a = PI * i / 30: ForeColor = &HFF
For j = 600 To 0 Step -10       '画秒针,从尾半截到圆心
  XX = j * Sin(a + PI) + 5000: YY = 5000 - j * Cos(a + PI)
  If j Mod 200 = 0 And DrawWidth > 5 Then DrawWidth = DrawWidth - 1
  PSet (XX, YY)
Next
For j = 0 To 4700 Step 10  '画秒针从圆心到针尖
  GoSub 100
  If j Mod 750 = 0 And DrawWidth > 1 Then DrawWidth = DrawWidth - 1
  PSet (XX, YY)
Next

'处理圆心效果
DrawWidth = 25
PSet (5000, 5000)
ForeColor = &H404040
DrawWidth = 15
PSet (5000, 5000)
ForeColor = &HE0E0E0
DrawWidth = 5
PSet (5000, 5000)
Exit Sub

100 '计算指针各点坐标
XX = j * Sin(a) + 5000: YY = 5000 - j * Cos(a)
Return
End Sub


说明:
1.本程序运行后窗体是透明的,按【Esc】键退出程序。
2.如果不想让窗体透明,可以删除Form_Load过程中最下面的2个语句,同时去掉SetWindowRgn前面的注释符,运行后就是圆形窗体了。不过由于Cls清屏的缘故,圆形窗体有跳动,不爽,所以建议使用透明窗体为好。
本代码在win7旗舰版通过,未在其它版本测试。

回复列表 (共1个回复)

沙发

修改如下,效果更好


Private Sub Form_Load()
Me.Height = Screen.Height
Me.Width = Me.Height
Me.Scale (-5000, 5000)-(5000, -5000)
SetWindowLong hWnd, -20, &H80000
SetLayeredWindowAttributes hWnd, BackColor, 0, 1 '窗体透明
End Sub

Private Sub Timer1_Timer()

Dim s As Single '半径和角度计算
Dim X As Single, Y As Single, j As Integer
Cls

ForeColor = 255
CurrentX = -770: CurrentY = 4890: Print 12
CurrentX = 4000: CurrentY = 350: Print 3
CurrentX = -570: CurrentY = -4100: Print 6
CurrentX = -5100: CurrentY = 350: Print 9
    
ForeColor = &HC000&
CurrentX = 1650: CurrentY = 4200: Print 1
CurrentX = 3300: CurrentY = 2600: Print 2
CurrentX = 3300: CurrentY = -1900: Print 4
CurrentX = 1650: CurrentY = -3500: Print 5
CurrentX = -2750: CurrentY = -3550: Print 7
CurrentX = -4400: CurrentY = -1900: Print 8
CurrentX = -4600: CurrentY = 2600: Print 10
CurrentX = -2950: CurrentY = 4200: Print 11

DrawWidth = 28: s = PI * (Hour(Time) + Minute(Time) / 60) / 6: ForeColor = &H800000
X = 3200 * Sin(s): Y = 3200 * Cos(s)
Line (0, 0)-(X, Y), &H800000 '画时针
DrawWidth = 8
X = 1900 * Sin(s): Y = 1900 * Cos(s)
Line (0, 0)-(X, Y), &HFFFF00

DrawWidth = 22: s = PI * (Minute(Time) + Second(Time) / 60) / 30
X = 4000 * Sin(s): Y = 4000 * Cos(s)
Line (0, 0)-(X, Y), &H800000 '画分针
DrawWidth = 6
X = 2800 * Sin(s): Y = 2800 * Cos(s)
Line (0, 0)-(X, Y), &HFFFF00

DrawWidth = 15: s = PI * Second(Time) / 30: ForeColor = &HFF
For j = -500 To 4600 Step 10 '画秒针
  If j < 0 Then
    X = -j * Sin(s + PI): Y = -j * Cos(s + PI) '计算下面打点语句的各点坐标
  Else
    X = j * Sin(s): Y = j * Cos(s)
  End If
  If j Mod 450 = 0 Then DrawWidth = DrawWidth - 1
  PSet (X, Y)
Next

'处理圆心效果
DrawWidth = 30: PSet (0, 0)
ForeColor = &H800000: DrawWidth = 20: PSet (0, 0)
ForeColor = &HFFFFFF: DrawWidth = 10: PSet (0, 0)
End Sub

我来回复

您尚未登录,请登录后再回复。点此登录或注册