VB6初步实现在WINXP下类似WIN7显示桌面的功能

欢迎转载,但请保留以下信息:

作者: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

'=====================================================

'说明:模仿WIN7右下角的显示桌面功能

'创建信息: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 _

) As Long

'查找窗口位置信息

Private Declare Function GetWindowRect Lib "user32" ( _

    ByVal hwnd As Long _

    , lpRect As RECT _

) 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

End Type

 

'查询

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _

    ByVal HKey As Long, _

    ByVal lpValueName As String, _

    ByVal lpReserved As Long, _

    ByRef lpType As Long, _

    ByVal lpData As String, _

    ByRef lpcbData As Long _

) As Long

 

'创建或改变一个键值

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _

( _

    ByVal HKey As Long, _

    ByVal lpValueName As String, _

    ByVal Reserved As Long, _

    ByVal dwType As Long, _

    lpData As Any, _

    ByVal cbData As Long _

  ) As Long

 

'创建或改变一个键值.

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( _

    ByVal HKey As Long _

    , ByVal lpSubKey As String _

    , phkResult As Long _

) As Long

 

'关闭键值

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _

    ByVal HKey As Long _

) As Long

 

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 _

    , ByVal nSize As Long _

) As Long

 

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

    Unload Me

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

    End If

    Exit Sub

   

ExitPoint:

    MsgBox "Loading failed,Error:" & Err.Description

    Set oShell = Nothing

End Sub

 

'开机运行

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", 0, REG_SZ, hValue, Len(SourFilePath) + 1

   

    If Replace(hValue, Chr(0), vbNullString) <> (SourFilePath) Then

        '写入运行的程序路径

        RegSetValueEx HKey, "ShowDesktop", 0, REG_SZ, ByVal SourFilePath, Len(SourFilePath)

    End If

   

    '关闭

    RegCloseKey HKey

End Sub

 

 

[/code]

 

源代码下载地址:

http://www.rayfile.com/zh-cn/files/2bb766d9-dbd4-11de-a9d8-0014221b798a/