CSDN博客

img asklxf

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

发表于2004/7/5 22:34:00  4959人阅读

想自己写一个可爱的桌面小钟?永远在最上面,半透明,还可以随意拖动,其实非常简单,用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

0 0

相关博文

我的热门文章

img
取 消
img