VB   发布时间:2022-04-03  发布网站:大佬教程  code.js-code.com
大佬教程收集整理的这篇文章主要介绍了VB6初步实现在WINXP下类似WIN7显示桌面的功能大佬教程大佬觉得挺不错的,现在分享给大家,也给大家做个参考。

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

@H_197_7@作者:Lost_PainTing

@H_197_7@首发地址:http://blog.csdn.net/Lost_Painting/archive/2009/11/28/4894097.aspx

@H_197_7@ 前段时间使用WIN7,其右下角的显示桌面功能让本人这种懒人觉得十分方便,不用去按WIN + D,或者辛苦的去点击快速开始上的"显示桌面图标"(不小心点歪了,还会启动其他进程=_=!!).只要把鼠标甩到右下角单击一下,就显示桌面了.

@H_197_7@ 后来因为WIN7 X64兼容性问题,使我不得不回到WINXP时代,WINXP没有了右下角的显示桌面,很不习惯了,此时就想着自己写一个右下角显示桌面的功能.

@H_197_7@一开始,思路是:

@H_197_7@写一个FORM设定其位置刚好掩盖在任务栏的右下角的一个区域,高度与任务栏一样,长度自定义,然后设置为透明(透明度自定),窗口置顶HWND_TOPMOST.然后响应Form的Click事件时,调用显示桌面功能

@H_197_7@折腾了1个小时,代码都写得差不多了,结果调试的时候发觉不对,因为任务栏也是HWND_TOPMOST,本人写的显示桌面程式首次运行时是在其上面的,但是一旦任务栏获取了焦点,显示桌面程式就会被任务栏掩盖了,再也点不到了. =_=!!

@H_197_7@再次转变思路:

@H_197_7@虑调用API来修改任务栏的宽度(用FindWindow抓出任务栏的窗口句柄),预留自定义的宽度给显示桌面程式,使任务栏获取了焦点,显示桌面程式不会被任务栏掩盖.尝试了API :SetWindowPos,MoveWindow皆不行.尝试几次後,觉得是否是只修改任务栏窗口是不行的,还需要修其子窗口的宽度,逐一尝试,依然失败.(等待高手/大牛的代码实现修改任务栏宽度),所以,目前该思路对本人而言暂时进行不下去了.

@H_197_7@然后再次转变思路:(呵呵,要曲线救国了)

@H_197_7@不再尝试写FORM放置到任务栏上,而使用判断任务栏是否获取了焦点,在其获取焦点时,判断鼠标的坐标是否落在设定好的范围,如果是,激活显示桌面功能.这样就初步实现了,把鼠标一甩到任务栏右下角单机即可显示桌面.因为没有FORM的遮盖,所以没法用颜色或其他方式标记这个范围了,这个比较不方便. (^_^)

@H_197_7@其中加入了写入注册表,自启动的功能,觉得不需要或者有担忧的,可以将该段代码屏蔽

@H_197_7@(部分杀毒软件会监控注册表敏感区域的写入,可能会报警)

@H_197_7@实现代码如下:

@H_197_7@[code=VB]

@H_197_7@VERSION 5.00

@H_197_7@Begin VB.Form frmShow

@H_197_7@ Borderstyle = 0 '没有框线

@H_197_7@ Caption = "Show"

@H_197_7@ ClientHeight = 90

@H_197_7@ ClientLeft = 0

@H_197_7@ ClientTop = 0

@H_197_7@ ClientWidth = 90

@H_197_7@ Icon = "frmShow.frx":0000

@H_197_7@ LinkTopic = "frmShow"

@H_197_7@ @H_545_3@maxButton = 0 'false

@H_197_7@ @H_545_3@minButton = 0 'false

@H_197_7@ @H_545_3@moveable = 0 'false

@H_197_7@ ScaleHeight = 90

@H_197_7@ ScaleWidth = 90

@H_197_7@ ShowInTaskbar = 0 'false

@H_197_7@ StartUpPosition = 3 '系统默认值

@H_197_7@ Visible = 0 'false

@H_197_7@ WindowState = 1 '最小化

@H_197_7@ Begin VB.Timer Timer1

@H_197_7@ Left = 0

@H_197_7@ Top = 0

@H_197_7@ End

@H_197_7@End

@H_197_7@Attribute VB_Name = "frmShow"

@H_197_7@Attribute VB_GlobalNameSpace = false

@H_197_7@Attribute VB_Creatable = false

@H_197_7@Attribute VB_PredeclaredId = True

@H_197_7@Attribute VB_Exposed = false

@H_197_7@'=====================================================

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

@H_197_7@'创建信息:Lost_PainTing

@H_197_7@'创建时间:2009/11/28

@H_197_7@'=====================================================

@H_197_7@

@H_197_7@Option Explicit

@H_197_7@'声明API

@H_197_7@'查找窗口窗口句柄

@H_197_7@Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _

@H_197_7@ ByVal lpClassName As String _

@H_197_7@ ,ByVal lpWindowName As String _

@H_197_7@) As Long

@H_197_7@'查找获取焦点的窗口句柄

@H_197_7@Private Declare Function GetForegroundWindow Lib "user32" () As Long

@H_197_7@'获取当前鼠标信息

@H_197_7@Private Declare Function GetcursorPos Lib "user32" ( _

@H_197_7@lpPoint as POINTAPI _

@H_197_7@'查找窗口位置信息

@H_197_7@Private Declare Function GetWindowRect Lib "user32" ( _

@H_197_7@ ByVal hwnd As Long _

@H_197_7@) As Long

@H_197_7@'鼠标X,Y坐标

@H_197_7@Private Type POINTAPI

@H_197_7@ x As Long

@H_197_7@ y As Long

@H_197_7@End Type

@H_197_7@'窗口位置信息,以左上角为原点(MinX,MinY),右下为终点(MaxX,MaxY)

@H_197_7@Private Type RECT

@H_197_7@ x1 As Long

@H_197_7@ y1 As Long

@H_197_7@ x2 As Long

@H_197_7@ y2 As Long

@H_197_7@'查询

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

@H_197_7@ ByVal HKey As Long,_

@H_197_7@ 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 _

@H_197_7@'创建或改变一个键值

@H_197_7@Private Declare Function RegSETVALueEx Lib "advapi32.dll" Alias "RegSETVALueExA" _

@H_197_7@( _

@H_197_7@ ByVal Reserved As Long,sans-serif;"> ByVal dwType As Long,sans-serif;"> lPDAta As Any,sans-serif;"> ByVal cbData As Long _

@H_197_7@ ) As Long

@H_197_7@'创建或改变一个键值.

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

@H_197_7@ ByVal HKey As Long _

String _

@H_197_7@'关闭键值

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

@H_197_7@Private Const HKEY_LOCAL_MACHINE = &H80000002 'HKEY_LOCAL_MACHINE

@H_197_7@Private Const REG_SZ = 1

@H_197_7@

@H_197_7@'取得系统目录

@H_197_7@Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" ( _

@H_197_7@ ByVal lpBuffer As String _

@H_197_7@Private hwndTaskBar As Long '任务栏句柄

@H_197_7@Private rectTaskBar As RECT '任务字段置信息

@H_197_7@Private rectShowDesktop As RECT '显示桌面响应范围

@H_197_7@Private Pos As POINTAPI '鼠标位置

@H_197_7@Private oSHell As Object '脚本对象

@H_197_7@

@H_197_7@Const SHOW_DESKTOP_WIDTH As Long = 15 '显示桌面响应范围- 15 PPI

@H_197_7@Const RESPONSE_TIME As Integer = 500 'Timer间隔

@H_197_7@Const FILEPATH_MAX_LEN As Long = 255 '文件目录最大长度

@H_197_7@Private Sub Form_Load()

@H_197_7@ On Error GoTo ExitPoint

@H_197_7@ '只运行一个实例

@H_197_7@ If App.prevInstance = True Then

@H_197_7@ Unload Me

@H_197_7@ Exit Sub

@H_197_7@ End If

@H_197_7@ '设定响应时间

@H_197_7@ Timer1.Interval = RESPONSE_TIME

@H_197_7@ Timer1.Enabled = True

@H_197_7@ '取得任务栏的窗口句柄

@H_197_7@ hwndTaskBar = FindWindow("SHell_TrayWnd",vbNullString)

@H_197_7@ '取得任务栏的窗口位置信息

@H_197_7@ GetWindowRect hwndTaskBar,rectTaskBar

@H_197_7@ '根据任务栏窗口位置信息初始化显示桌面响应范围

@H_197_7@ rectShowDesktop.x1 = rectTaskBar.x2 - SHOW_DESKTOP_WIDTH

@H_197_7@ rectShowDesktop.y1 = rectTaskBar.y1

@H_197_7@ rectShowDesktop.x2 = rectTaskBar.x2

@H_197_7@ rectShowDesktop.y2 = rectTaskBar.y2

@H_197_7@ '创建SHell.Application对象,调用其显示桌面功能

@H_197_7@ Set oSHell = CreateObject("SHell.Application")

@H_197_7@ '复制档,写入注册表

@H_197_7@ SetAutoRun

@H_197_7@ '隐藏自身

@H_197_7@ @H_545_3@me.Hide

@H_197_7@ Exit Sub

@H_197_7@ExitPoint:

@H_197_7@ '出错提示并退出

@H_197_7@ @H_545_3@msgBox "Loading failed,Error:" & Err.Description

@H_197_7@End Sub

@H_197_7@Private Sub Timer1_Timer()

@H_197_7@ On Error GoTo ExitPoint

@H_197_7@ Dim hwndForeground As Long

@H_197_7@ '取得当前获取焦点的窗口句柄

@H_197_7@ hwndForeground = GetForegroundWindow()

@H_197_7@ '判断是否是任务栏窗口获取焦点,如果是进入

@H_197_7@ If hwndForeground = hwndTaskBar Then

@H_197_7@ '获取当前鼠标位置

@H_197_7@ GetcursorPos Pos

@H_197_7@ '判断落点范围是否在显示桌面响应范围

@H_197_7@ If (Pos.x >= rectShowDesktop.x1 And Pos.x <= rectShowDesktop.x2) _

@H_197_7@ And (Pos.y >= rectShowDesktop.y1 And Pos.y <= rectShowDesktop.y2) Then

@H_197_7@ '显示桌面

@H_197_7@ oSHell.ToggleDesktop

@H_197_7@ End If

@H_197_7@ Set oSHell = Nothing

@H_197_7@'开机运行

@H_197_7@Private Sub SetAutoRun()

@H_197_7@ Dim HKey As Long

@H_197_7@ Dim SourFilePath As String

@H_197_7@ Dim hValue As String

@H_197_7@ SourFilePath = """" & App.path & "/" & App.EXename & ".exe" & """"

@H_197_7@ hValue = String(Len(SourFilePath) + 1,chr(0))

@H_197_7@ '打开/创建键

@H_197_7@ RegCreateKey HKEY_LOCAL_MACHINE,"Software/Microsoft/Windows/CurrentVersion/Run",HKey

@H_197_7@ '判断键值是否与待写入的一致

@H_197_7@ RegQueryValueEx HKey,"ShowDesktop",REG_SZ,hValue,Len(SourFilePath) + 1

@H_197_7@ If replace(hValue,chr(0),vbNullString) <> (SourFilePath) Then

@H_197_7@ '写入运行的程序路径

@H_197_7@ RegSETVALueEx HKey,ByVal SourFilePath,Len(SourFilePath)

@H_197_7@ '关闭

@H_197_7@ RegCloseKey HKey

@H_197_7@End Sub

@H_197_7@[/code]

@H_197_7@源代码下载地址:

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

大佬总结

以上是大佬教程为你收集整理的VB6初步实现在WINXP下类似WIN7显示桌面的功能全部内容,希望文章能够帮你解决VB6初步实现在WINXP下类似WIN7显示桌面的功能所遇到的程序开发问题。

如果觉得大佬教程网站内容还不错,欢迎将大佬教程推荐给程序员好友。

本图文内容来源于网友网络收集整理提供,作为学习参考使用,版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ:384754419,请注明来意。