给你一个实例: FrmMain.frm ----------------------------- VERSION 5.00 Begin VB.Form frmMain BorderStyle = 1 'Fixed Single Caption = "Form1" ClientHeight = 1230 ClientLeft = 45 ClientTop = 330 ClientWidth = 1230 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 1230 ScaleWidth = 1230 StartUpPosition = 2 'CenterScreen Begin VB.CommandButton cmdUnDock Caption = "UnDock" Height = 255 Left = 0 TabIndex = 4 Top = 960 Width = 1215 End Begin VB.CommandButton cmdDockRight Caption = "Dock Right" Height = 255 Left = 0 TabIndex = 3 Top = 720 Width = 1215 End Begin VB.CommandButton cmdDockLeft Caption = "Dock Left" Height = 255 Left = 0 TabIndex = 2 Top = 480 Width = 1215 End Begin VB.CommandButton cmdDockBottom Caption = "Dock Bottom" Height = 255 Left = 0 TabIndex = 1 Top = 240 Width = 1215 End Begin VB.CommandButton cmdDockTop Caption = "Dock Top" Height = 255 Left = 0 TabIndex = 0 Top = 0 Width = 1215 End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim lHeight As Long 'Initial form height Dim lWidth As Long 'Initial form width Dim AppBar As APPBARDATA 'Represents your docked formPrivate Sub cmdDockBottom_Click() UnDock AppBar 'Undock if it was before ResetSize Dock dsBottom, Me, AppBar End SubPrivate Sub cmdDockLeft_Click() UnDock AppBar 'Undock if it was before ResetSize Dock dsLeft, Me, AppBar End SubPrivate Sub cmdDockRight_Click() UnDock AppBar 'Undock if it was before ResetSize Dock dsRight, Me, AppBar End SubPrivate Sub cmdDockTop_Click() UnDock AppBar 'Undock if it was before ResetSize Dock dsTop, Me, AppBar End SubPrivate Sub cmdUnDock_Click() UnDock AppBar 'Undock if it was before ResetSize End SubPrivate Sub Form_Load() lHeight = Me.Height lWidth = Me.Width End SubPublic 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 SubPrivate Sub Form_Unload(Cancel As Integer) UnDock AppBar End Sub
Docking.bas ---------------------------------------- Attribute VB_Name = "Docking" 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 LongPublic 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 = &H40Public Const SPI_GETWORKAREA = 48Type RECT Left As Long Top As Long Right As Long Bottom As Long End TypeType APPBARDATA cbSize As Long hwnd As Long uCallbackMessage As Long uEdge As Long rc As RECT lParam As Long End TypePublic Enum DockSide dsTop = 1 dsBottom = 3 dsLeft = 0 dsRight = 2 End EnumPublic 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 FunctionPublic 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 SubPublic 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 FunctionPublic Sub GetWorkArea(ByRef WndRgn As RECT) ' Returns the area of the screen not reserved Call SystemParametersInfo(SPI_GETWORKAREA, 0, WndRgn, 0) End Sub
但肯定和OICQ是不一样的,当OICQ显示时,它仅仅是在最上层,但却遮盖了其他应用程序。而我不想遮住其他任何东西,如果我的程序运行在屏幕的正上方,那么其他程序,包括桌面可用的空间就只有屏幕下方到任务栏的所有空间。
我想说的已经很清楚了。请大家不吝指教,不胜感激。
FrmMain.frm
-----------------------------
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 1230
ClientLeft = 45
ClientTop = 330
ClientWidth = 1230
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1230
ScaleWidth = 1230
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton cmdUnDock
Caption = "UnDock"
Height = 255
Left = 0
TabIndex = 4
Top = 960
Width = 1215
End
Begin VB.CommandButton cmdDockRight
Caption = "Dock Right"
Height = 255
Left = 0
TabIndex = 3
Top = 720
Width = 1215
End
Begin VB.CommandButton cmdDockLeft
Caption = "Dock Left"
Height = 255
Left = 0
TabIndex = 2
Top = 480
Width = 1215
End
Begin VB.CommandButton cmdDockBottom
Caption = "Dock Bottom"
Height = 255
Left = 0
TabIndex = 1
Top = 240
Width = 1215
End
Begin VB.CommandButton cmdDockTop
Caption = "Dock Top"
Height = 255
Left = 0
TabIndex = 0
Top = 0
Width = 1215
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim lHeight As Long 'Initial form height
Dim lWidth As Long 'Initial form width
Dim AppBar As APPBARDATA 'Represents your docked formPrivate Sub cmdDockBottom_Click()
UnDock AppBar 'Undock if it was before
ResetSize
Dock dsBottom, Me, AppBar
End SubPrivate Sub cmdDockLeft_Click()
UnDock AppBar 'Undock if it was before
ResetSize
Dock dsLeft, Me, AppBar
End SubPrivate Sub cmdDockRight_Click()
UnDock AppBar 'Undock if it was before
ResetSize
Dock dsRight, Me, AppBar
End SubPrivate Sub cmdDockTop_Click()
UnDock AppBar 'Undock if it was before
ResetSize
Dock dsTop, Me, AppBar
End SubPrivate Sub cmdUnDock_Click()
UnDock AppBar 'Undock if it was before
ResetSize
End SubPrivate Sub Form_Load()
lHeight = Me.Height
lWidth = Me.Width
End SubPublic 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 SubPrivate Sub Form_Unload(Cancel As Integer)
UnDock AppBar
End Sub
----------------------------------------
Attribute VB_Name = "Docking"
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 LongPublic 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 = &H40Public Const SPI_GETWORKAREA = 48Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypeType APPBARDATA
cbSize As Long
hwnd As Long
uCallbackMessage As Long
uEdge As Long
rc As RECT
lParam As Long
End TypePublic Enum DockSide
dsTop = 1
dsBottom = 3
dsLeft = 0
dsRight = 2
End EnumPublic 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 FunctionPublic 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 SubPublic 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 FunctionPublic Sub GetWorkArea(ByRef WndRgn As RECT)
' Returns the area of the screen not reserved
Call SystemParametersInfo(SPI_GETWORKAREA, 0, WndRgn, 0)
End Sub