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

原创 2004年07月05日 22:34:00

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

vb:将窗体嵌入桌面的一段代码

Option Explicit  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpCl...
  • km_afei
  • km_afei
  • 2016年12月02日 12:32
  • 338

VB编写的桌面便签

  • 2014年02月10日 21:50
  • 67KB
  • 下载

vb资源下载 长期有效

东西太多了 自己懒得改文件列表 大家看着下吧 呵呵只整理到了一半 地址www.84ren.com驱动器 F 中的卷是 ZCM_BACK卷的序列号是 08BC-0AE4F:/VBCN/编程模块及工具20...
  • zcm123
  • zcm123
  • 2006年03月24日 16:40
  • 9051

[王垠系列]怎样写一个解释器

怎样写一个解释器 这是一篇解释器的入门教程。虽然我试图从最基本的原理讲起,尽量让这篇文章不依赖于其它知识,但是这篇教程并不是针对编程的入门知识,所以我假设你已经学会了最基本的 Scheme 和函...
  • unsv29
  • unsv29
  • 2016年01月07日 09:08
  • 519

自己动手用C扩展PHP(三)

原文地址:http://www.cnblogs.com/moodlxs/archive/2011/09/21/2345382.html 在上两章里讲述了扩展模块的基本用法,相信读者已...
  • lltaoyy
  • lltaoyy
  • 2017年05月02日 21:27
  • 148

活动桌面处理和一个例子

赵湘宁   下载本文例子代码 ...
  • dlyhlq
  • dlyhlq
  • 2008年03月25日 21:25
  • 734

VB图标分类大全

  • 2013年09月15日 17:03
  • 720KB
  • 下载

自己动手用python写豆瓣FM

以前装过几次ubuntu,但总是因为缺少一些软件工具而最终不得不回到windows下。最近又迷上了ubuntu,逐渐从windows系统转战ubuntu。这次,openfetion、wineqq、ch...
  • shawpan
  • shawpan
  • 2013年07月19日 21:49
  • 1082

使用LFS打造自己的Linux日常桌面操作系统心得体会

都签到签到十级了,是时候发个帖子了.编译了lfs也有几十回了,也是时候写个帖子记录下了 这些内容可能对新手不太友好,该喷就喷吧 第一 为什么要自己编译系统 14年之后,以linux为...
  • qq_36476111
  • qq_36476111
  • 2016年11月11日 22:33
  • 590

Spy++原理初探(VB篇)

Spy++原理初探 南京 阿珊境界 下载源代码  用API函数,就会提到句柄,像SendMessage, GetWindowText等,最常用到的参数就是句柄。啥是句柄呢?就是窗口的锅把儿,...
  • asanscape
  • asanscape
  • 2008年03月02日 22:40
  • 6964
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:自己动手用VB打造桌面小钟
举报原因:
原因补充:

(最多只允许输入30个字)