Startseite / Tipps / VB 5/6-Tipp 0319: Eigenen ApplicationBar erstellen

VB 5/6-Tipp 0319: Eigenen ApplicationBar erstellen

 von ActiveVB

'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-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

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.