Option Explicit
 
Const DT_CENTER = &H1
Const DT_SINGLELINE As Long = &H20
Const DT_VCENTER As Long = &H4
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Enum tBtnState
   Normal
   Clicked
   Over
End Enum
 
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As _
  Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal _
  wFormat As Long) As Long
Private 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
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
 
Public Event Click()       ' wird ausgelöst, wenn auf den Button geklickt wird
Public Event MouseEnter()  ' wird ausgelöst, wenn die Maus den Button "betritt"
Public Event MouseLeave()  ' wird ausgelöst, wenn die Maus den Button verlässt
 
Private m_Caption As String
Private m_tBtnState As tBtnState
 
Public Property Get Caption() As String
    Caption = m_Caption
End Property
 
Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    PropertyChanged "Caption"
End Property
 
 
Private Sub UserControl_Initialize()
  m_tBtnState = Normal
  btnpic(Normal).ZOrder 0
End Sub
 
Private Sub UserControl_InitProperties()
  Caption = "FlatButton"
End Sub
 
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As _
  Single, y As Single)
   CheckMouse x, y, Button
   btnpic(m_tBtnState).ZOrder 0
End Sub
 
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As _
  Single, y As Single)
    CheckMouse x, y, Button
    btnpic(m_tBtnState).ZOrder 0
End Sub
 
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As _
  Single, y As Single)
    CheckMouse x, y, Button
    btnpic(m_tBtnState).ZOrder 0
End Sub
 
 
'Eigenschaftenwerte vom Speicher laden
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Caption = PropBag.ReadProperty("Caption", "FlatButton")
End Sub
 
Private Sub UserControl_Show()
  Dim m_rect As RECT
 
 
  SetRect m_rect, 0, 0, ScaleWidth / Screen.TwipsPerPixelX, ScaleHeight / _
    Screen.TwipsPerPixelY
  DrawText hdc, m_Caption, Len(m_Caption), m_rect, DT_CENTER + DT_SINGLELINE + _
  DT_VCENTER
End Sub
 
'Eigenschaftenwerte in den Speicher schreiben
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Caption", m_Caption, "FlatButton")
End Sub
 
Private Sub UserControl_Resize()
On Error Resume Next
Width = 2130
Height = 375
End Sub
 
Private Sub CheckMouse(ByVal x As Single, ByVal y As Single, ByVal Button As _
  Integer)
  ' Hier wird überprüft, ob sich die Maus innerhalb des
  ' Controls befindet oder eben nicht
  With UserControl
    If x < 0 Or y < 0 Or x > .ScaleWidth Or y > .ScaleHeight Then
      ReleaseCapture
      m_tBtnState = Normal
    Else
      SetCapture .hWnd
      If Button = vbLeftButton Then
        m_tBtnState = Clicked
      Else
        m_tBtnState = Over
      End If
    End If
  End With
End Sub

Gru?

Ralf