自己动手用VB打造桌面小钟

想自己写一个可爱的桌面小钟？永远在最上面，半透明，还可以随意拖动，其实非常简单，用Visual Basic 6只需十分钟，就可以写出下面这样可爱的小钟：

OK，如果你有一点VB的基本知识，按照下面的步骤一步一步地写：

1.首先，找一个漂亮的钟面，你可以直接用上面的图片，或者自己画一个也行。

2.用图片作Form的背景，调整一下大小，设置BorderStyle=0(None)，AutoRedraw=True，ScaleMode=3(Pixel)。

3.放几个Line当表针，调整大小，颜色，用一个Timer让它们动起来，Intervel=100就足够了：

Private Const PI As Single = 3.1415926
Private Const ClockX = 41
Private Const ClockY = 48
Private Const SecLength = 25
Private Const MinLength = 17
Private Const HourLength = 11

Private Sub tmrGetTime_Timer()
Dim nSec As Long, nMin As Long, nHour As Long

nSec = Second(Now)
nMin = Minute(Now)
nHour = Hour(Now)
If nHour >= 12 Then nHour = nHour - 12

'Draw second pointer ***************************************
lineSec.X2 = ClockX + SecLength * Cos(PI / 2 - PI * nSec / 30)
lineSec.Y2 = ClockY - SecLength * Sin(PI / 2 - PI * nSec / 30)

'Draw minute pointer ***************************************
lineMin.X2 = ClockX + MinLength * Cos(PI / 2 - PI * nMin / 30)
lineMin.Y2 = ClockY - MinLength * Sin(PI / 2 - PI * nMin / 30)

'Draw hour pointer *****************************************
lineHour.X2 = ClockX + HourLength * Cos(PI / 2 - PI * nHour / 6 - PI * nMin / 360)
lineHour.Y2 = ClockY - HourLength * Sin(PI / 2 - PI * nHour / 6 - PI * nMin / 360)
End Sub

4.实现不规则窗体，用几个API函数，把透明色剔出掉，在Form_Load()中调用：

Private Sub SetRgn()
Dim nRgn As Long, nTRgn As Long
Dim i As Long, j As Long

nRgn = CreateRectRgn(20, 20, 21, 21)

For i = 0 To Me.ScaleWidth - 1
For j = 0 To Me.ScaleHeight - 1
If Me.Point(i, j) <> &HFF Then' 注意了：我的透明色是红色，你要改成实际颜色！
nTRgn = CreateRectRgn(i + 1, j + 1, i + 2, j + 2)
Call CombineRgn(nRgn, nRgn, nTRgn, RGN_OR)
DeleteObject nTRgn
End If
Next j
Next i
SetWindowRgn Me.hwnd, nRgn, True
DeleteObject nRgn
End Sub

5.实现鼠标拖动：

Dim pt As POINTAPI
Dim formX As Single, formY As Single

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
'save the position of cursor and form:
GetCursorPos pt
formX = Me.Left
formY = Me.Top
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim newpt As POINTAPI
Dim nLeft As Long, nTop As Long

If Button = vbLeftButton Then
GetCursorPos newpt
nLeft = formX + (newpt.X - pt.X) * Screen.TwipsPerPixelX
nTop = formY + (newpt.Y - pt.Y) * Screen.TwipsPerPixelY
If nLeft < 200 Then nLeft = 0
If nTop < 200 Then nTop = 0
If nLeft > Screen.Width - Me.Width - 200 Then nLeft = Screen.Width - Me.Width
If nTop > Screen.Height - Me.Height - 200 Then nTop = Screen.Height - Me.Height
Me.Move nLeft, nTop
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
Me.PopupMenu mnuPop, vbPopupMenuLeftButton Or vbPopupMenuRightButton
End If
End Sub

6.像Winamp一样贴着边：上面已经实现啦！仔细看红色部分。

7.实现半透明其实最简单了，在2000/XP下只要写几行代码：

Private Sub SetTransparent(Optional ByVal b As Boolean = True)
Dim rtn As Long
rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong Me.hwnd, GWL_EXSTYLE, rtn
' 透明度可调：0-255，255就完全不透明：
SetLayeredWindowAttributes Me.hwnd, 0, IIf(b, 127, 255), LWA_ALPHA
End Sub

98/NT系统就不行了，为了确保能正常调用这个API，先检查一下Windows版本：

Dim osinfo As OSVERSIONINFO
osinfo.dwOSVersionInfoSize = Len(osinfo)
GetVersionEx osinfo
If osinfo.dwMajorVersion >= 5 Then
SetTransparent
End If

8.最后一步，让小钟总在最前：

SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE

编译，大功告成！剩下的功能比如报时什么的自己添加。如果你想直接下载：

EXE文件：http://javap2p.nease.net/soft/dclock.exe.zip

VB源代码：http://javap2p.nease.net/soft/dclock.zip