Option Explicit
 
' API Deklarationen
Private Declare Function SHAppBarMessage Lib "Shell32.dll" (ByVal _
        dwMessage As Long, pData As APPBARDATA) As Long
 
Private 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
 
' Types für die API
Private Type RECT
  Left      As Long
  Top       As Long
  Right     As Long
  Bottom    As Long
End Type
 
Private Type APPBARDATA
  cbSize            As Long
  hwnd              As Long
  uCallbackMessage  As Long
  uEdge             As Long
  rc                As RECT
  lParam            As Long
End Type
' Konstanten für die API
Private Const HWND_TOPMOST = -1
 
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_SHOWWINDOW = &H40
 
Private Const ABM_NEW = &H0
Private Const ABM_REMOVE = &H1
Private Const ABM_SETPOS = &H3
Private Const ABM_GETTASKBARPOS = &H5
 
Public Const ABE_LEFT = &H0
Public Const ABE_TOP = &H1
Public Const ABE_RIGHT = &H2
Public Const ABE_BOTTOM = &H3
 
' Enum der Docking Positionen
Public Enum AppBarPos
  BarLeft = 0
  BarTop = 1
  BarRight = 2
  BarBottom = 3
End Enum
 
' Anwendungsvariablen
Public frmAppForm           As Form
Public bDocked              As Boolean
Private lBorder             As Long
' AppBar Informationen
Private APD                 As APPBARDATA
 
Private lDockMode           As Long
Private lXTwips             As Long
Private lYTwips             As Long
 
Sub Main()
  lXTwips = Screen.TwipsPerPixelX
  lYTwips = Screen.TwipsPerPixelY
  lBorder = 0
  LoadAppBar frmAppBar, BarRight
End Sub
 
Public Sub LoadAppBar(AppForm As Form, Position As AppBarPos)
  Dim lTop, lBottom     As Long
  Dim lLeft, lRight     As Long
  Dim lWidth, lHeight   As Long
  Dim lMinSize          As Long ' minimale Höhe oder Breite der Bar in Pixel
  Dim WTBPos            As APPBARDATA
 
  lDockMode = Position
  Set frmAppForm = AppForm
  bDocked = True
 
  ' Neue AppBar anlegen
  Call SHAppBarMessage(ABM_NEW, APD)
  ' Je nach Position die Variablen füllen
  Select Case lDockMode
    Case ABE_LEFT
      lMinSize = frmAppForm.fraBack.Width / lYTwips
      lLeft = 0
      lTop = 0
      lRight = lMinSize + lBorder
      lBottom = Screen.Height
      lWidth = lMinSize * lXTwips
      lHeight = Screen.Height
 
    Case ABE_TOP
      lMinSize = frmAppForm.fraBack.Height / lXTwips
      lLeft = 0
      lTop = 0
      lRight = Screen.Width / lXTwips
      lBottom = lMinSize + lBorder
      lWidth = Screen.Width
      lHeight = lMinSize * lYTwips
 
    Case ABE_RIGHT
      lMinSize = frmAppForm.fraBack.Width / lYTwips
      lLeft = Screen.Width / lXTwips - lMinSize - lBorder
      lTop = 0
      lRight = Screen.Width / lXTwips
      lBottom = lMinSize + lBorder
      lWidth = lMinSize * lXTwips
      lHeight = Screen.Height
 
    Case ABE_BOTTOM
      lMinSize = frmAppForm.fraBack.Height / lXTwips
      lLeft = 0
      lTop = Screen.Height / lXTwips - lMinSize - lBorder
      lRight = Screen.Width / lXTwips
      lBottom = Screen.Height / lXTwips
      lWidth = Screen.Width
      lHeight = (lBottom - lTop) * lYTwips
    End Select
    '--------------------------------------------------
    'Nun noch die Windows Taskbar berücksichtigen
    Call SHAppBarMessage(ABM_GETTASKBARPOS, WTBPos)
    '--------------------------------------------------
    ' Taskbar unten
    If WTBPos.uEdge = ABE_BOTTOM And lDockMode = ABE_BOTTOM Then
      lTop = WTBPos.rc.Top - lMinSize - lBorder
      lBottom = WTBPos.rc.Bottom
    ElseIf WTBPos.uEdge = ABE_BOTTOM And _
           (lDockMode = ABE_LEFT Or lDockMode = ABE_RIGHT) Then
      lHeight = WTBPos.rc.Top * lYTwips
    '--------------------------------------------------
    ' Taskbar oben
    ElseIf WTBPos.uEdge = ABE_TOP And lDockMode = ABE_TOP Then
      lTop = WTBPos.rc.Bottom
      lBottom = lTop + lMinSize
    ElseIf WTBPos.uEdge = ABE_TOP And _
           (lDockMode = ABE_LEFT Or lDockMode = ABE_RIGHT) Then
      lTop = WTBPos.rc.Bottom
      lHeight = Screen.Height - WTBPos.rc.Bottom * lYTwips
    '--------------------------------------------------
    ' Taskbar links
    ElseIf WTBPos.uEdge = ABE_LEFT And lDockMode = ABE_LEFT Then
      lLeft = WTBPos.rc.Right
    ElseIf WTBPos.uEdge = ABE_LEFT And _
           (lDockMode = ABE_TOP Or lDockMode = ABE_BOTTOM) Then
      lLeft = WTBPos.rc.Right
      lWidth = Screen.Width - WTBPos.rc.Right * lYTwips
    '--------------------------------------------------
    ' Taskbar rechts
    ElseIf WTBPos.uEdge = ABE_RIGHT And lDockMode = ABE_RIGHT Then
      lLeft = WTBPos.rc.Left - lMinSize
    ElseIf WTBPos.uEdge = ABE_RIGHT And _
           (lDockMode = ABE_TOP Or lDockMode = ABE_BOTTOM) Then
      lWidth = WTBPos.rc.Left * lYTwips
    End If
 
    ' AppData Objekt für die ApplicationBar füllen
    With APD
      .uEdge = lDockMode
      .rc.Top = lTop
      .rc.Left = lLeft
      .rc.Right = lRight
      .rc.Bottom = lBottom
    End With
 
    ' AppBar mit den neuen Werten füllen
    Call SHAppBarMessage(ABM_SETPOS, APD)
 
    ' Nun das Form an die Position der AppBar bringen
    DoEvents
    With frmAppForm
      .Show
      Call SetWindowPos(.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW)
      .Top = lTop * lXTwips
      .Left = lLeft * lYTwips
      .Width = lWidth
      .Height = lHeight
    End With
End Sub
 
Public Sub UnloadAppBar()
  If bDocked Then Call SHAppBarMessage(ABM_REMOVE, APD)
  bDocked = False
End Sub