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

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

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/

VB6初步實現在WINXP下類似WIN7顯示桌面的功能

相關文章