透明桌面时间助手

1、透明桌面时间助手（附源代码）编程：简凌看了腾讯的时间助手，这个透明的界面很好看了，刚好在学编程，最近下了一个VB6.0的精简版，于是就用些零碎的业余时间做一个小简设计时间助手。也有n年没有写过代码了，以往岁月中那些浅尝辄止的零散基础也没帮上什么，于是“万事问百度”再加上那股“初生牛犊不怕虎”的劲儿，哎，终于捣弄出来了一个“小简设计时间助手V1”一、时间代码我首先找到时间，日期 函数和星期函数，分别改成ChinaTime () Jdata() 和Jweek()Sub Chinatime()tmp = Format(Now, "hh:mm:ss")h = Left(tmp, 2

2、): s = Right(tmp, 2): m = Mid(tmp, 4, 2)Label1.Caption = h + ":" + mEnd SubSub Jdate()JDtmp = Format(Now, "mm/dd/yy")yue = Left(JDtmp, 2)day = Mid(JDtmp, 4, 2)Label2.Caption = yue + "月" + day + "日"End SubSub Jweek()wk = Weekday(Date, vbMonday)Jwk = Left(wk, 1)

3、End Sub百度里有很多答案，我通常会选择最简单的代码。可是里这个星期1的“数字”有点不好呢，星期日都变成“星期7”了。对了，加个EndIf就可以了吧Sub Jweek()wk = Weekday(Date, vbMonday)Jwk = Left(wk, 1)If Jwk = 1 ThenLabel3.Caption = "星期一"ElseIf Jwk = 2 ThenLabel3.Caption = "星期二"ElseIf Jwk = 3 ThenLabel3.Caption = "星期三"ElseIf Jwk = 4 Then

4、Label3.Caption = "星期四"ElseIf Jwk = 5 ThenLabel3.Caption = "星期五"ElseIf Jwk = 6 ThenLabel3.Caption = "星期六"ElseIf Jwk = 7 ThenLabel3.Caption = "星期日"End IfEnd Sub二、透明窗体和可拖放这都是百度上的代码了，但我会比较哪一个代码更简单，更好用，更有实效。但我去掉了窗的缩小放大和关闭按钮，因为放在桌面我的考虑不用关闭。拖动这个透明窗体我放在显示时间的控件上了。Optio

5、n ExplicitPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal d

6、wNewLong As Long) As LongPrivate 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 WS_EX_LAYERED = &H80000Const GWL_EXSTYLE = (-20)Private Const LWA_ALPHA = &H2Privat

7、e Const LWA_COLORKEY = &H1'变量声明'MoveScreen，布尔型变量，标示窗体是否处于被移动状态Dim MoveScreen As Boolean '鼠标位置Dim MousX As IntegerDim MousY As Integer'窗体位置Dim CurrX As IntegerDim CurrY As Integer '“退出”按钮'当鼠标在窗体上按下时Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Sing

8、le, Y As Single)'-'参数说明：'-'button 返回一个整数，用来标识按下或释放的是哪一'个按钮。button 参数的值为相应于左按钮（1）右按钮'（2），以及中间按钮（4）。'-'shift 返回一个整数，在鼠标按钮被按下或者被释放'的同时，SHIFT,CTRL,和 ALT 键的状态，返回的shift'参数值分别为1，2，和 4。指示这些键的状态。'-'x, y 返回一个指定鼠标指针当前位置的数。'- '如果是鼠标左键按下If Button = 1 Then &

9、#39;标示为移动状态MoveScreen = True '得到鼠标在窗体上的位（相对与窗体内部坐标）MousX = XMousY = YEnd IfEnd Sub '当鼠标在窗体上移过时Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) '如果处于鼠标左键按下的状态，即MoveScreen = True时If MoveScreen Then '计算新的窗体坐标值 '仔细想一下，看看是不是这样CurrX = Form1.Le

10、ft - MousX + XCurrY = Form1.Top - MousY + Y '移动窗体到新的位置Form1.Move CurrX, CurrYEnd IfEnd Sub'把新的窗体坐标显示出来，是相对于屏幕的坐标Label3.Caption = CurrX Label4.Caption = CurrY '把鼠标点击的位置显示出来，是相对与窗体的坐标 Label7.Caption = MousX Label8.Caption = MousYEnd Sub'如果鼠标松开，则停止拖动Private Sub Label1_MouseUp(Button As

11、Integer, Shift As Integer, X As Single, Y As Single)MoveScreen = FalseEnd Sub呵呵。窗体终于透明了，注意要把控件的背景色设置为黑色，字体的颜色设置为白色。或者相反，关键的是在窗体加载时把控件背景色变成要透明的颜色：在代码里是&H0 或者别的颜色值。 Sub Form_Load() Dim rtn As Long rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rt

12、n SetLayeredWindowAttributes hwnd, &H0, 0, LWA_COLORKEY End Sub三、天气预报哎呀，我在百度上找到很多，但感觉都太复杂了。我在成都，只需要知道的成都的天气和温度就可以了。但百度的上代码都太复杂了。WebBrowser控件我加窗体里，一加载运行，哦好大的窗体和信息，都跑到窗体外面去了。于是我不得不对天气预报中国网进行探究，有收费代码，有免费代码。我就做个小程序，当然找免费的了。可是如下可都是网页代码。直接放VB里不行。我决定从简而行。我只用了一行代码，其中就是一行网址：Me.WebBrowser1.Navigate "

13、可加载起，有边框，有背景色，不在中间。怎么办？这个网页已经最简单了，只有一排文字。经过一番思考，我查看了网页的源代码。找到关键字：innerText我把WebBrowser控件放在了窗体之外（不是删除）Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)WebBrowser1.Document.body.Scroll = "no"CDwt =WebBrowser1.Document.body.innerTextLabel5.Caption = CDwt End Sub可

14、是，运行后，成都和后面的天气连接到了一起。不得不再次用到最基础的的取值函数left() Right()Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)WebBrowser1.Document.body.Scroll = "no"CDwt = Left(WebBrowser1.Document.body.innerText, 2)CDft = Right(WebBrowser1.Document.body.innerText, 12)Label5.Caption =

15、CDwt + " " + CDft小简透明标志这是我桌面的右上角，标志被做成了一幅桌面壁纸。当初步做好这个助手后，我想把标志也直接做在程序里，这样也可以换不同壁纸但标志和时间都在壁纸上面不也挺好的。我找到我标志的源文件cdr格式的导了一个png格式的图片，png格式本身就是透明的。我想这样不是更好么？可是picture控件和Image控件都不支持png。哦，我又换成的jpg格式欧麦嘎：那些小黑点是什么呢？我导入PS里不断的选取填充结果，失败了。不，只是成功地证明了此路不通。我找到这两个控件的介绍：picture控件可显示的图片文件有位图、图标、图元文件、增强型图元文件、JP

16、EG文件或GIF文件。依据多年的图片的转换的不同经验，我立马想到了wmf格式：我从cdr里导出一个wmf格式的图片。再来一个欧麦嘎当然最后我在最后一面加了一个我QQ空间的超链接Private Sub Label6_Click()Shell "explorer.exe 1End Sub哦，至此，时间助手程序第一个版本就此结束。运行成功。总结的确，这对编程高手来说也许十分容易。对我这种初学程序的人来说却是打翻了五味瓶什么滋味都有。但我却在这里学习了许多：一、网上的很多源码，我会去比较，我会灵活的运用到自己的程序用，我会选择代码相对少，简单的。我觉得比较和判别是一件不容易的事儿。如何找到哪

17、种“一针见血”的最具核心实质的代码才最重要。这跟我一直的习惯思维有关联。二、改弦易辙：我相信条条道路通中国。同样一种问题总有很多的解题方法。只有一种的是很少的。三、多读多看多研究。别人的程序不是直接的抄来，最重要的是明白别人为什么要这么写这一段代码？。多问为什么是对的，但我会努力思考，思考也不一定要有答案。但经过思考以后，它就会在的脑海里留一下点，终有一天，我脑海的十万个为什么会把这此点连结起来。附小简设计时间助手VI源代码：Dim tmp, h, m, s, JDtmp, yue, day, wk, Jwk, CDwt, CDftDim xa As Single, ya As SingleO

18、ption ExplicitPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByV

19、al dwNewLong As Long) As LongPrivate 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 WS_EX_LAYERED = &H80000Const GWL_EXSTYLE = (-20)Private Const LWA_ALPHA = &H2Pr

20、ivate Const LWA_COLORKEY = &H1'变量声明'MoveScreen，布尔型变量，标示窗体是否处于被移动状态Dim MoveScreen As Boolean '鼠标位置Dim MousX As IntegerDim MousY As Integer'窗体位置Dim CurrX As IntegerDim CurrY As Integer '“退出”按钮'当鼠标在窗体上按下时Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As

21、Single, Y As Single)'-'参数说明：'-'button 返回一个整数，用来标识按下或释放的是哪一'个按钮。button 参数的值为相应于左按钮（1）右按钮'（2），以及中间按钮（4）。'-'shift 返回一个整数，在鼠标按钮被按下或者被释放'的同时，SHIFT,CTRL,和 ALT 键的状态，返回的shift'参数值分别为1，2，和 4。指示这些键的状态。'-'x, y 返回一个指定鼠标指针当前位置的数。'- '如果是鼠标左键按下If Button = 1 Th

22、en '标示为移动状态MoveScreen = True '得到鼠标在窗体上的位（相对与窗体内部坐标）MousX = XMousY = YEnd IfEnd Sub '当鼠标在窗体上移过时Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) '如果处于鼠标左键按下的状态，即MoveScreen = True时If MoveScreen Then '计算新的窗体坐标值 '仔细想一下，看看是不是这样CurrX = Form

23、1.Left - MousX + XCurrY = Form1.Top - MousY + Y '移动窗体到新的位置Form1.Move CurrX, CurrYEnd IfEnd Sub'把新的窗体坐标显示出来，是相对于屏幕的坐标Label3.Caption = CurrX Label4.Caption = CurrY '把鼠标点击的位置显示出来，是相对与窗体的坐标 Label7.Caption = MousX Label8.Caption = MousYEnd Sub'如果鼠标松开，则停止拖动Private Sub Label1_MouseUp(Button

24、 As Integer, Shift As Integer, X As Single, Y As Single)MoveScreen = FalseEnd Sub Sub Form_Load() Dim rtn As Long rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, &H0, 0, LWA_COLORKEY Me.WebBrowser1.Navigate &

25、quot; End SubSub Chinatime()tmp = Format(Now, "hh:mm:ss")h = Left(tmp, 2): s = Right(tmp, 2): m = Mid(tmp, 4, 2)Label1.Caption = h + ":" + mEnd SubSub Jdate()JDtmp = Format(Now, "mm/dd/yy")yue = Left(JDtmp, 2)day = Mid(JDtmp, 4, 2)Label2.Caption = yue + "月" + day + &q