欢迎转载,但请保留以下信息:
作者:Lost_Painting
首发地址:http://blog.csdn.net/Lost_Painting/archive/2009/11/28/4894097.aspx
前段时间使用WIN7,其右下角的显示桌面功能让本人这种懒人觉得十分方便,不用去按WIN + D,或者辛苦的去点击快速开始上的"显示桌面图标"(不小心点歪了,还会启动其他进程=_=!!).只要把鼠标甩到右下角单击一下,就显示桌面了.
后来因为WIN7 X64兼容性问题,使我不得不回到WINXP时代,WINXP没有了右下角的显示桌面,很不习惯了,此时就想着自己写一个右下角显示桌面的功能.
一开始,思路是:
写一个FORM设定其位置刚好掩盖在任务栏的右下角的一个区域,高度与任务栏一样,长度自定义,然后设置为透明(透明度自定),窗口置顶HWND_TOPMOST.然后响应Form的Click事件时,调用显示桌面功能
折腾了1个小时,代码都写得差不多了,结果调试的时候发觉不对,因为任务栏也是HWND_TOPMOST,本人写的显示桌面程式首次运行时是在其上面的,但是一旦任务栏获取了焦点,显示桌面程式就会被任务栏掩盖了,再也点不到了. =_=!!
再次转变思路:
考虑调用API来修改任务栏的宽度(用FindWindow抓出任务栏的窗口句柄),预留自定义的宽度给显示桌面程式,使任务栏获取了焦点,显示桌面程式不会被任务栏掩盖.尝试了API :SetWindowPos,MoveWindow皆不行.尝试几次後,觉得是否是只修改任务栏窗口是不行的,还需要修其子窗口的宽度,逐一尝试,依然失败.(等待高手/大牛的代码实现修改任务栏宽度),所以,目前该思路对本人而言暂时进行不下去了.
然后再次转变思路:(呵呵,要曲线救国了)
不再尝试写FORM放置到任务栏上,而使用判断任务栏是否获取了焦点,在其获取焦点时,判断鼠标的坐标是否落在设定好的范围,如果是,激活显示桌面功能.这样就初步实现了,把鼠标一甩到任务栏右下角单机即可显示桌面.因为没有FORM的遮盖,所以没法用颜色或其他方式标记这个范围了,这个比较不方便. (^_^)
其中加入了写入注册表,自启动的功能,觉得不需要或者有担忧的,可以将该段代码屏蔽
(部分杀毒软件会监控注册表敏感区域的写入,可能会报警)
实现代码如下:
[code=VB]
VERSION 5.00
Begin VB.Form frmShow
BorderStyle = 0 '没有框线
Caption = "Show"
ClientHeight = 90
ClientLeft = 0
ClientTop = 0
ClientWidth = 90
Icon = "frmShow.frx":0000
LinkTopic = "frmShow"
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 90
ScaleWidth = 90
ShowInTaskbar = 0 'False
StartUpPosition = 3 '系统默认值
Visible = 0 'False
WindowState = 1 '最小化
Begin VB.Timer Timer1
Left = 0
Top = 0
End
End
Attribute VB_Name = "frmShow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================================
'创建信息:Lost_Painting
'创建时间:2009/11/28
'=====================================================
Option Explicit
'声明API
'查找窗口窗口句柄
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String _
,ByVal lpWindowName As String _
) As Long
'查找获取焦点的窗口句柄
Private Declare Function GetForegroundWindow Lib "user32" () As Long
'获取当前鼠标信息
Private Declare Function GetCursorPos Lib "user32" ( _
lpPoint As POINTAPI _
'查找窗口位置信息
Private Declare Function GetWindowRect Lib "user32" ( _
ByVal hwnd As Long _
) As Long
'鼠标X,Y坐标
Private Type POINTAPI
x As Long
y As Long
End Type
'窗口位置信息,以左上角为原点(MinX,MinY),右下为终点(MaxX,MaxY)
Private Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
'查询
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
ByVal HKey As Long,_
ByVal lpValueName As String,sans-serif;"> ByVal lpReserved As Long,sans-serif;"> ByRef lpType As Long,sans-serif;"> ByVal lpData As String,sans-serif;"> ByRef lpcbData As Long _
'创建或改变一个键值
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
( _
ByVal Reserved As Long,sans-serif;"> ByVal dwType As Long,sans-serif;"> lpData As Any,sans-serif;"> ByVal cbData As Long _
) As Long
'创建或改变一个键值.
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( _
ByVal HKey As Long _
'关闭键值
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
Private Const HKEY_LOCAL_MACHINE = &H80000002 'HKEY_LOCAL_MACHINE
Private Const REG_SZ = 1
'取得系统目录
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" ( _
ByVal lpBuffer As String _
Private hwndTaskBar As Long '任务栏句柄
Private rectTaskBar As RECT '任务字段置信息
Private rectShowDesktop As RECT '显示桌面响应范围
Private Pos As POINTAPI '鼠标位置
Private oShell As Object '脚本对象
Const SHOW_DESKTOP_WIDTH As Long = 15 '显示桌面响应范围-宽 15个 PPI
Const RESPONSE_TIME As Integer = 500 'Timer间隔
Const FILEPATH_MAX_LEN As Long = 255 '文件目录最大长度
Private Sub Form_Load()
On Error GoTo ExitPoint
'只运行一个实例
If App.PrevInstance = True Then
Unload Me
Exit Sub
End If
'设定响应时间
Timer1.Interval = RESPONSE_TIME
Timer1.Enabled = True
'取得任务栏的窗口句柄
hwndTaskBar = FindWindow("Shell_TrayWnd",vbNullString)
'取得任务栏的窗口位置信息
GetWindowRect hwndTaskBar,rectTaskBar
'根据任务栏窗口位置信息初始化显示桌面响应范围
rectShowDesktop.x1 = rectTaskBar.x2 - SHOW_DESKTOP_WIDTH
rectShowDesktop.y1 = rectTaskBar.y1
rectShowDesktop.x2 = rectTaskBar.x2
rectShowDesktop.y2 = rectTaskBar.y2
'创建Shell.Application对象,调用其显示桌面功能
Set oShell = CreateObject("Shell.Application")
'复制档,写入注册表
SetAutoRun
'隐藏自身
Me.Hide
Exit Sub
ExitPoint:
MsgBox "Loading Failed,Error:" & Err.Description
End Sub
Private Sub Timer1_Timer()
On Error GoTo ExitPoint
Dim hwndForeground As Long
'取得当前获取焦点的窗口句柄
hwndForeground = GetForegroundWindow()
'判断是否是任务栏窗口获取焦点,如果是进入
If hwndForeground = hwndTaskBar Then
'获取当前鼠标位置
GetCursorPos Pos
'判断落点范围是否在显示桌面响应范围
If (Pos.x >= rectShowDesktop.x1 And Pos.x <= rectShowDesktop.x2) _
And (Pos.y >= rectShowDesktop.y1 And Pos.y <= rectShowDesktop.y2) Then
'显示桌面
oShell.ToggleDesktop
End If
Set oShell = Nothing
'开机运行
Private Sub SetAutoRun()
Dim HKey As Long
Dim SourFilePath As String
Dim hValue As String
SourFilePath = """" & App.Path & "/" & App.EXEName & ".exe" & """"
hValue = String(Len(SourFilePath) + 1,Chr(0))
'打开/创建键
RegCreateKey HKEY_LOCAL_MACHINE,"Software/Microsoft/Windows/CurrentVersion/Run",HKey
'判断键值是否与待写入的一致
RegQueryValueEx HKey,"ShowDesktop",REG_SZ,hValue,Len(SourFilePath) + 1
If Replace(hValue,Chr(0),vbNullString) <> (SourFilePath) Then
'写入运行的程序路径
RegSetValueEx HKey,ByVal SourFilePath,Len(SourFilePath)
'关闭
RegCloseKey HKey
End Sub
[/code]
源代码下载地址:
http://www.rayfile.com/zh-cn/files/2bb766d9-dbd4-11de-a9d8-0014221b798a/
原文链接:/vb/262459.html