读书人

怎么用VB做Windows任务栏或API、消息

发布时间: 2012-07-30 16:19:05 作者: rapoo

如何用VB做Windows任务栏,或API、消息改变桌面矩形区域大小?
如下图所示,在XP中,将一个文件夹拖拽到桌面窗口边缘放开,就会出现工具栏,右键工具栏选择“前端显示”
效果:工具栏区域占用了屏幕一部分区域,而且始终置顶,但不影响其他窗口的使用 就像Windows的任务栏一样

在实际应用中,我希望自己的程序像那个工具栏一样来显示列表信息,然后桌面的其他区域为其他程序能工作的区域

最终要达到的效果就是:当最大化其他窗口时,我的程序窗口置前且不遮挡最大化窗口的任何部分!



提供几个与窗口操作相关的API
sendmessage
posmessage
getwindowlong
setwindowlong


[解决办法]
模块

Public Declare Function SHAppBarMessage Lib "Shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long
Public Declare Function SetRect Lib "User32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function SystemParametersInfo Lib "User32" Alias "SystemParametersInfoA" (ByVal uiAction As Long, ByVal uiParam As Long, ByRef pvParam As Any, ByVal fWinIni As Long) As Long

Public Const ABM_NEW = &H0
Public Const ABM_REMOVE = &H1
Public Const ABM_SETPOS = &H3
Public Const ABE_BOTTOM = 3
Public Const ABE_TOP = 1
Public Const ABE_LEFT = 0
Public Const ABE_RIGHT = 2
Public Const WM_MOUSEMOVE = &H200
Public Const HWND_TOPMOST = -1
Public Const SWP_SHOWWINDOW = &H40

Public Const SPI_GETWORKAREA = 48

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Type APPBARDATA
cbSize As Long
hwnd As Long
uCallbackMessage As Long
uEdge As Long
rc As RECT
lParam As Long
End Type

Public Enum DockSide
dsTop = 1
dsBottom = 3
dsLeft = 0
dsRight = 2
End Enum

Public Function Dock(ByVal ScreenSide As DockSide, ByRef xForm As Form, ByRef AppBar As APPBARDATA) As Boolean
Dim lScreenWidth As Long ' Holds the width of the screen in pixles
Dim lScreenHeight As Long ' Holds the height of the screen in pixles
Dim lxHeight As Long ' Holds the height of the form in pixles
Dim lxWidth As Long ' Holds the width of the form in pixles
Dim lTaskBarHeight As Long ' Holds the height of the taskbar
Dim bResult As Boolean ' Holds the API calls results

Dim WorkArea As RECT ' These hold the area of the screen
Dim xWorkArea As RECT ' not currently reserved for a docked
Dim yWorkArea As RECT ' program.

AppBar.hwnd = xForm.hwnd ' Handle to the form to be docked
AppBar.cbSize = Len(AppBar) ' Size of the AppBar Variable
AppBar.uCallbackMessage = WM_MOUSEMOVE ' Call back function for any system messages

GetWorkArea WorkArea ' Get the current area of the screen not reserved

lScreenWidth = Screen.Width / Screen.TwipsPerPixelX ' Get the screen
lScreenHeight = Screen.Height / Screen.TwipsPerPixelY ' dimensions.

lxHeight = xForm.Height / Screen.TwipsPerPixelY ' Get the form
lxWidth = xForm.Width / Screen.TwipsPerPixelX ' dimensions

bResult = SHAppBarMessage(ABM_REMOVE, AppBar) ' Undock the form if it is docked
DoEvents ' Let the system catch up
bResult = SHAppBarMessage(ABM_NEW, AppBar) ' Register the program with windows for docking

Select Case ScreenSide ' Find where you want to dock it and set the placement dimensions
Case ABE_TOP ' Top of screen
AppBar.uEdge = ABE_TOP
AppBar.rc.Top = WorkArea.Top
AppBar.rc.Left = 0
AppBar.rc.Right = lScreenWidth
AppBar.rc.Bottom = lxHeight


Case ABE_BOTTOM ' Bottom of screen
AppBar.uEdge = ABE_BOTTOM
AppBar.rc.Top = WorkArea.Bottom - lxHeight
AppBar.rc.Left = 0
AppBar.rc.Right = lScreenWidth
AppBar.rc.Bottom = WorkArea.Bottom
Case ABE_LEFT ' Left side of screen
AppBar.uEdge = ABE_LEFT
AppBar.rc.Top = 0
AppBar.rc.Left = WorkArea.Left
AppBar.rc.Right = WorkArea.Left + lxWidth
AppBar.rc.Bottom = lScreenHeight
Case ABE_RIGHT ' Right side of screen
AppBar.uEdge = ABE_RIGHT
AppBar.rc.Top = 0
AppBar.rc.Left = WorkArea.Right - lxWidth
AppBar.rc.Right = WorkArea.Right
AppBar.rc.Bottom = lScreenHeight
End Select

GetWorkArea xWorkArea ' Find the area of the screen not reserved

bResult = SHAppBarMessage(ABM_SETPOS, AppBar) ' Reserve screen space for the form
DoEvents ' This can take a second so give the
DoEvents ' system time to register the space

With AppBar.rc
' This If...Then chunk keeps checking until the unreserved
' screen area before we reserved space is different then
' the unreserved area after we reserved space depending on
' where we have it docked. Just waiting for the system to
' catch up basicly.
If ScreenSide = dsTop Then
GetWorkArea yWorkArea
Do Until yWorkArea.Top > xWorkArea.Top
GetWorkArea yWorkArea
DoEvents
Loop
ElseIf ScreenSide = dsBottom Then
GetWorkArea yWorkArea
Do Until xWorkArea.Bottom > yWorkArea.Bottom
GetWorkArea yWorkArea
DoEvents
Loop
ElseIf ScreenSide = dsLeft Then
GetWorkArea yWorkArea
Do Until yWorkArea.Left > xWorkArea.Left
GetWorkArea yWorkArea
DoEvents
Loop
ElseIf ScreenSide = dsRight Then
GetWorkArea yWorkArea
Do Until xWorkArea.Right > yWorkArea.Right
GetWorkArea yWorkArea
DoEvents
Loop
End If

' This next line will put the form on top of all
' other windows
bResult = SetWindowPos(xForm.hwnd, HWND_TOPMOST, .Top, .Left, .Right, .Bottom, SWP_SHOWWINDOW)

' This last chunk is just to resize the form
' to fit the space we reserved for it.
xForm.Top = .Top * Screen.TwipsPerPixelY
xForm.Left = .Left * Screen.TwipsPerPixelX
xForm.Height = (.Bottom - .Top) * Screen.TwipsPerPixelY
xForm.Width = (.Right - .Left) * Screen.TwipsPerPixelX
End With
End Function

Public Sub UnDock(ByRef AppBar As APPBARDATA)
Call SHAppBarMessage(ABM_REMOVE, AppBar) ' unreserve the space we reserved and unregister the form
DoEvents ' Wait for the system to catch up
End Sub

Public Function TaskBarHeight()
' Returns the height of the task bar
Dim lHeight1 As Long
Dim lHeight2 As Long
Dim bResult As Boolean
Dim rcArea As RECT
Dim luiParam As Long
Dim lScreenHeight As Long

' Find the area of the screen not reserved
bResult = SystemParametersInfo(SPI_GETWORKAREA, 0, rcArea, 0)

' Find the total height of the screen
lScreenHeight = Screen.Height / Screen.TwipsPerPixelY

TaskBarHeight = lScreenHeight - rcArea.Bottom
End Function

Public Sub GetWorkArea(ByRef WndRgn As RECT)
' Returns the area of the screen not reserved
Call SystemParametersInfo(SPI_GETWORKAREA, 0, WndRgn, 0)
End Sub


窗口

Dim lHeight As Long 'Initial form height


Dim lWidth As Long 'Initial form width
Dim AppBar As APPBARDATA 'Represents your docked form

Private Sub cmdDockBottom_Click()
UnDock AppBar 'Undock if it was before
ResetSize
Dock dsBottom, Me, AppBar
End Sub

Private Sub cmdDockLeft_Click()
UnDock AppBar 'Undock if it was before
ResetSize
Dock dsLeft, Me, AppBar
End Sub

Private Sub cmdDockRight_Click()
UnDock AppBar 'Undock if it was before
ResetSize
Dock dsRight, Me, AppBar
End Sub

Private Sub cmdDockTop_Click()
UnDock AppBar 'Undock if it was before
ResetSize
Dock dsTop, Me, AppBar
End Sub

Private Sub cmdUnDock_Click()
UnDock AppBar 'Undock if it was before
ResetSize
End Sub

Private Sub Form_Load()
lHeight = Me.Height
lWidth = Me.Width
End Sub

Public Sub ResetSize()
''''''''''''''''''''''''''''''''''
' This is just to bring the form '
' back to the size it was before '
' and center it on the screen. '
''''''''''''''''''''''''''''''''''

Me.Height = lHeight
Me.Width = lWidth
Me.Left = (Screen.Width - lWidth) / 2
Me.Top = (Screen.Height - lHeight) / 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnDock AppBar
End Sub

读书人网 >VB

热点推荐