Option Explicit
Global Const SRCCOPY = &HCC0020    ' API Call for Picture Copy Bild kopieren
Global SourceBitmap As PictureBox  ' Where are all my Bitmaps

Type ToolbarButtonType             ' All my active Bitmaps are here
   Left As Integer
   Top As Integer
   right As Integer
   bottom As Integer
   Nummer As Integer
   pressed As Integer
   enabled As Integer
   visible As Integer
   Yellowhelp As String
   Statushelp As String
End Type

Type POINTAPI  '4 Bytes
   x As Integer
   y As Integer
End Type

Type RECT   '8 Bytes
   Left As Integer
   Top As Integer
   right As Integer
   bottom As Integer
End Type

' Only API Call for Copy then Bitmaps
Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
Declare Sub GetCursorPos Lib "User" (sPoint As POINTAPI)
Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)

Sub ToolbarAddButton (Ctrl As Control, TbBtn As ToolbarButtonType, ByVal XPos As Integer, ByVal Nummer As Integer, SourceBitmap As PictureBox)
   '
   ' Button in Toolbar anfügen und zeichnen
   '
   '  Ctrl = Toolbar
   '  XPos = von Links in Pixel, 4 von oben
   '  Nummer = Nummer des Bitmaps, gemäss Verzeichnis
   '
   On Error Resume Next
   Dim success As Integer
   TbBtn.Top = 2
   TbBtn.Left = XPos
   TbBtn.right = XPos + 24
   TbBtn.bottom = 2 + 22
   TbBtn.Nummer = Nummer
   TbBtn.pressed = False
   TbBtn.visible = True
   TbBtn.enabled = True
   success = BitBlt(Ctrl.hDC, XPos, 2, 24, 22, SourceBitmap.hDC, (Nummer * 24) - 24, 0, SRCCOPY)
   Ctrl.Refresh
End Sub

Function ToolBarGetClicked (Ctrl As Control, TbBtn() As ToolbarButtonType) As Integer
   '
   ' Gibt zurück, welcher Knopf auf der Toolbar gedrückt wurde.
   ' wurde kein Kopf gedrückt, gibt es 0 (False) zurück
   '
   On Error Resume Next
   Dim mpos As POINTAPI      ' mposition
   Dim TbPos As RECT
   Dim i As Integer
   GetCursorPos mpos
   GetWindowRect Ctrl.hWnd, TbPos
   ToolBarGetClicked = -1
   For i = 0 To UBound(TbBtn)
      If Err Then Exit Function
      If mpos.x > TbBtn(i).Left + TbPos.Left And mpos.x < TbBtn(i).right + TbPos.Left Then
         If mpos.y > TbBtn(i).Top + TbPos.Top And mpos.y < TbBtn(i).bottom + TbPos.Top Then
            If TbBtn(i).enabled Then
               ToolBarGetClicked = i
               Exit Function
            End If
         End If
      End If
   Next
End Function

Sub ToolBarGrayButton (Ctrl As Control, TbBtn As ToolbarButtonType, SourceBitmap As PictureBox)
   '
   ' Button in Toolbar gray werden lassen
   '
   '
   '  Ctrl = Toolbar
   '  Nummer = Nummer des Buttons
   '
   On Error Resume Next
   Dim success As Integer
   success = BitBlt(Ctrl.hDC, TbBtn.Left, TbBtn.Top, 24, 22, SourceBitmap.hDC, (TbBtn.Nummer * 24) - 24, 44, SRCCOPY)
   TbBtn.enabled = False
   Ctrl.Refresh

End Sub

Sub ToolBarHideButton (Ctrl As Control, TbBtn As ToolbarButtonType, SourceBitmap As PictureBox)
   '
   ' Button in Toolbar verschwinden lassen
   '
   '
   '  Ctrl = Toolbar
   '  Nummer = Nummer des Buttons
   '
   On Error Resume Next
   Dim success As Integer
   success = BitBlt(Ctrl.hDC, TbBtn.Left, TbBtn.Top, 24, 22, SourceBitmap.hDC, 0, 66, SRCCOPY)   ' Graue Fläche
   TbBtn.enabled = False
   Ctrl.Refresh
End Sub

Sub ToolBarMousedown (Ctrl As Control, TbBtn() As ToolbarButtonType, x As Single, y As Single, SourceBitmap As PictureBox)
   '
   '
   '
   On Error Resume Next
   Dim i As Integer
   For i = 0 To UBound(TbBtn)
      If Err Then Exit Sub
      If x > TbBtn(i).Left And x < TbBtn(i).right Then
         If y > TbBtn(i).Top And y < TbBtn(i).bottom Then
            If TbBtn(i).enabled And Not TbBtn(i).pressed Then
               ToolbarPressButton Ctrl, TbBtn(i), SourceBitmap
               Exit Sub
            End If
         End If
      End If
   Next
End Sub

Sub ToolBarMouseUp (Ctrl As Control, TbBtn() As ToolbarButtonType, x As Single, y As Single, SourceBitmap As PictureBox)
   '
   '
   '
   On Error Resume Next
   Dim i As Integer
   For i = 0 To UBound(TbBtn)
      If Err Then Exit Sub
      If x > TbBtn(i).Left And x < TbBtn(i).right Then
         If y > TbBtn(i).Top And y < TbBtn(i).bottom Then
            If TbBtn(i).enabled And TbBtn(i).pressed Then
               ToolbarShowButton Ctrl, TbBtn(i), SourceBitmap
               Exit Sub
            End If
         End If
      End If
   Next
   '
   ' Knopf der tief ist releasen
   '
   For i = 0 To UBound(TbBtn)
      If TbBtn(i).pressed Then
         If TbBtn(i).enabled Then ToolbarShowButton Ctrl, TbBtn(i), SourceBitmap
         Exit For
      End If
   Next

End Sub

Sub ToolbarPressButton (Ctrl As Control, TbBtn As ToolbarButtonType, SourceBitmap As PictureBox)
   '
   ' Button in Toolbar versenken
   '
   '
   '  Ctrl = Toolbar
   '  Nummer = Nummer des Buttons
   '
   On Error Resume Next
   Dim success As Integer
   If Not TbBtn.enabled Then Exit Sub
   success = BitBlt(Ctrl.hDC, TbBtn.Left, TbBtn.Top, 24, 22, SourceBitmap.hDC, (TbBtn.Nummer * 24) - 24, 22, SRCCOPY)
   Ctrl.Refresh
   TbBtn.pressed = True
   'DoEvents
End Sub

Sub ToolbarShowButton (Ctrl As Control, TbBtn As ToolbarButtonType, SourceBitmap As PictureBox)
   '
   ' Button in Toolbar versenken
   '
   '
   '  Ctrl = Toolbar
   '  Nummer = Nummer des Buttons
   '
   On Error Resume Next
   Dim success As Integer
   If Not TbBtn.visible Then Exit Sub
   success = BitBlt(Ctrl.hDC, TbBtn.Left, TbBtn.Top, 24, 22, SourceBitmap.hDC, (TbBtn.Nummer * 24) - 24, 0, SRCCOPY)
   Ctrl.Refresh
   TbBtn.pressed = False
   TbBtn.enabled = True
End Sub