Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0319: Eigenen ApplicationBar erstellen

 von 

Beschreibung 

Die SHAppBarMessage bietet eine halbwegs komfortable Möglichkeit ähnlich der Standard-Taskbar eine eigene ApplicationBar im System anzumelden und zu verwenden. In diesem Beispiel wird gezeigt, wie ein Formular durch Bewegen an die Desktopgrenzen zu einem systemweiten dockenden Fenster werden kann. Umgekehrt läßt sich dieses natürlich auch wieder lösen.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

DrawFrameControl, GetCursorPos, GetSystemMetrics, GetWindowPlacement, SHAppBarMessage, SetRect, SetWindowPos

Download:

Download des Beispielprojektes [5,1 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Sub Command1_Click()
  Call Form_Unload(0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call ExitAppBar
  Unload Form2
  Unload Form1
End Sub

Private Sub Timer1_Timer()
  If Docked Then Exit Sub
  Timer1.Enabled = False
  WPL.Length = Len(WPL)
  Call GetWindowPlacement(Form1.hWnd, WPL)
  
  If WPL.rcNormalPosition.Left < Xmin Then
    DockMode = ABE_LEFT
  ElseIf WPL.rcNormalPosition.Top < Ymin Then
    DockMode = ABE_TOP
  ElseIf WPL.rcNormalPosition.Right > Xmax Then
    DockMode = ABE_RIGHT
  ElseIf WPL.rcNormalPosition.Bottom > Ymax Then
    DockMode = ABE_BOTTOM
  End If
  
  If DockMode <> -1 Then
    Call InitAppBar
  End If
  Timer1.Enabled = True
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Public Declare Function GetWindowPlacement Lib "User32" (ByVal _
        hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long

Public Declare Function DrawFrameControl Lib "User32" _
       (ByVal hdc As Long, lpRect As RECT, ByVal un1 _
       As Long, ByVal un2 As Long) 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 GetCursorPos Lib "User32" (lpPoint As _
       POINTAPI) As Long
       
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

Private Declare Function GetSystemMetrics Lib "User32" (ByVal _
        nIndex As Long) As Long
              
Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Type POINTAPI
  X As Long
  Y As Long
End Type

Type WINDOWPLACEMENT
  Length As Long
  flags As Long
  ShowCmd As Long
  ptMinPosition As POINTAPI
  ptMaxPosition As POINTAPI
  rcNormalPosition As RECT
End Type

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

Const HWND_TOPMOST = -1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2

Const SM_CXFRAME = 32
Const SM_CYFRAME = 33

Const ABM_NEW = &H0
Const ABM_REMOVE = &H1
Const ABM_SETPOS = &H3
Const ABM_GETTASKBARPOS = &H5

Public Const DFC_BUTTON = 4
Public Const DFCS_BUTTON3STATE = &H10

Public Const ABE_LEFT = &H0
Public Const ABE_TOP = &H1
Public Const ABE_RIGHT = &H2
Public Const ABE_BOTTOM = &H3

Public Xmin&, Xmax&, Ymin&, Ymax&, Docked As Boolean
Public WPL As WINDOWPLACEMENT
Public PxSense&
Public DockMode&
Public TPX&
Public TPY&

Dim APD As APPBARDATA
Dim FrameX&, FrameY&

Sub Main()
  TPX = Screen.TwipsPerPixelX
  TPY = Screen.TwipsPerPixelY
  
  Form1.Left = (Screen.Width - Form1.Width) / 2
  Form1.Top = (Screen.Height - Form1.Height) / 2
  Form1.Timer1.Interval = 50
  Form1.Timer1.Enabled = True
  Form1.Show
  
  PxSense = 20
  Xmin = PxSense
  Ymin = PxSense
  Xmax = Screen.Width / TPX - PxSense
  Ymax = Screen.Height / TPY - PxSense
  
  FrameX = GetSystemMetrics(SM_CXFRAME)
  FrameY = GetSystemMetrics(SM_CYFRAME)

  DockMode = -1
End Sub

Public Sub InitAppBar()
  Dim X&, Y&
  Dim Fx&, Fy&, Fw&, Fh&
  Dim TPos As APPBARDATA
    
    Docked = True
    
    'Höhe der Taskbar ermitteln, das Beispiel geht der Einfachheit
    'halber immer von einer Taskbar im unteren Bereich aus
    'Dies kann natürlich beliebig geändert werden
    Call SHAppBarMessage(ABM_GETTASKBARPOS, TPos)
    
    Y = Form2.Command1.Height / TPX
    X = Form2.Command1.Width / TPY
  
    Form1.Hide
    Call SHAppBarMessage(ABM_NEW, APD)
    
    Select Case DockMode
      Case ABE_LEFT:   With APD
                        .uEdge = ABE_LEFT
                        .rc.Top = 0
                        .rc.Left = 0
                        .rc.Right = X + FrameX
                        .rc.Bottom = TPos.rc.Top
                       End With
                       Fx = 0
                       Fy = 0
                       Fw = X * TPX
                       Fh = TPos.rc.Top * TPY
                    
      Case ABE_TOP:    With APD
                         .uEdge = ABE_TOP
                         .rc.Top = 0
                         .rc.Left = 0
                         .rc.Right = Screen.Width / TPX
                         .rc.Bottom = Y + FrameY
                       End With
                       Fx = 0
                       Fy = 0
                       Fw = Screen.Width
                       Fh = Y * TPY
                    
      Case ABE_RIGHT:  With APD
                         .uEdge = ABE_RIGHT
                         .rc.Top = 0
                         .rc.Left = Screen.Width / TPX - X - FrameX
                         .rc.Right = Screen.Width / TPX
                         .rc.Bottom = Y + FrameY
                       End With
                       Fx = Screen.Width - X * TPX
                       Fy = 0
                       Fw = X * TPX
                       Fh = TPos.rc.Top * TPY
                      
      Case ABE_BOTTOM: With APD
                         .uEdge = ABE_BOTTOM
                         .rc.Top = TPos.rc.Top - Y - FrameY
                         .rc.Left = 0
                         .rc.Right = Screen.Width / TPX
                         .rc.Bottom = TPos.rc.Top
                       End With
                       Fx = 0
                       Fy = (TPos.rc.Top - Y) * TPY
                       Fw = Screen.Width
                       Fh = Y * TPY
    End Select
    
    Call SHAppBarMessage(ABM_SETPOS, APD)
    DoEvents
    
    With Form2
      .Show
      Call SetWindowPos(.hWnd, HWND_TOPMOST, 0, 0, 0, 0, _
                        SWP_NOSIZE Or SWP_NOMOVE)
      .Top = Fy
      .Left = Fx
      .Width = Fw
      .Height = Fh
    End With
End Sub

Public Sub ExitAppBar()
  If Docked Then Call SHAppBarMessage(ABM_REMOVE, APD)
  Docked = False
  DockMode = -1
End Sub

Public Sub ExitAppBarComplete()
  Call ExitAppBar
  Unload Form1
  Unload Form2
End Sub
'---------- Ende Modul "Module1" alias Module1.bas ----------
'--------- Anfang Formular "Form2" alias Form2.frm  ---------
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Dim DragFlag As Boolean

Private Sub Command1_Click()
  Call ExitAppBarComplete
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
                           X As Single, Y As Single)
  DragFlag = True
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
                           X As Single, Y As Single)
  Dim p As POINTAPI
  Dim Fx&, Fy&
  
    If DragFlag Then
      Call GetCursorPos(p)
      Select Case DockMode
        Case ABE_TOP:    Fx = (p.X - 10) * TPX
                         Fy = PxSense * TPY
                      
        Case ABE_LEFT:   Fx = PxSense * TPY
                         Fy = (p.Y - 10) * TPY
                       
        Case ABE_RIGHT:  Fx = Xmax * TPX - Form1.Width
                         Fy = (p.Y - 10) * TPY
                         
        Case ABE_BOTTOM: Fx = (p.X - 10) * TPX
                         Fy = Ymax * TPY - Form1.Height
      End Select
      
      Form1.Left = Fx
      Form1.Top = Fy
      Form2.Hide
      Form1.Show
  
      Call ExitAppBar
      DragFlag = False
      Docked = False
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
                         X As Single, Y As Single)
  DragFlag = False
End Sub

Private Sub Form_Paint()
  Dim R As RECT
    Call SetRect(R, 0, 0, Form2.Width / TPX, Form2.Height / TPY)
    DrawFrameControl Form2.hdc, R, DFC_BUTTON, DFCS_BUTTON3STATE
End Sub
'---------- Ende Formular "Form2" alias Form2.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 8 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von FrankAdelik am 18.08.2009 um 13:00

Bei Windows Vista und VB6 ist ein Fehler beim Andocken an der linken Seite des Bildschirmrandes. Kann aber auch sein, das es daran liegt das ich meine Taskleiste an der rechten Seite des Bildschirms habe. Hab mir den Code nicht so genau angeguckt, ist mir nur aufgefallen.

Kommentar von heini am 02.09.2008 um 16:11

gibt es dieses Beispiel auch irgendwo für .NET (VS2008)??

Kommentar von Alex Hahn am 11.09.2006 um 19:23

Hi!

Das Programm funktioniert hervorragend! Aber, wenn ich den Bildschirm sperre, und danach wieder entsperre, bleibt am Rand, wo vorher der AppBar gelegen ist, die Fläche des AppBars frei, und der AppBar liegt um dessen Breite versetzt im inneren des Bildschirms!

Habt ihr eine Idee, wie man das beheben kann.

Betriebssystem: Windows XP SP2, VB6 SP6

Bitte um Hilfe und Danke im Voraus
lg Alex

Kommentar von Heiko von Schalscha am 10.05.2005 um 14:49

Hi.

Bei mir funktioniert der Code, allerdings hätte ich gerne zwei Appbars in meiner Anwendung (eine rechts und eine unten, und nur der Rest des Desktop soll anderen Anwendungen zur Verfügung stehen.)
Kann man das auch bewerkstelligen?

Vielen Dank ...

Kommentar von Markus am 19.10.2004 um 22:34

Hat sich erledigt!

Es fehlt die Zuweisung der hwnd des Application-Fensters!!!

Kommentar von Markus am 14.10.2004 um 16:38

Mein Problem ist folgendes:
Am Anfang funktioniert alles gut,
aber nach einer gewissen Zeit wird der Bereich hinter der
Applicationbar einfach wieder freigegeben, und die maximierten Fenster verschwinden teilweise hinter die Applicationbar!
Wie kann man das verhindern?

Kommentar von moloch am 17.06.2004 um 09:32

wo wird die breite der bar bestimmt?? mfg michael

Kommentar von Mario Hompesch am 19.09.2001 um 15:10

Ich habe folgendes Problem: andere Fenster werden (zum Teil) hinter der ApplicationBar versteckt, sodass mann diese nicht ueber die "normalen" Buttons minimieren, bzw. maximieren oder schliessen kann.
Wie kann ich es veranlassen das dieser Bereich fuer andere Fenster "gesperrt" ist, damit dieses Problem nicht mehr auftritt?
Gruss
Mario