VERSION 5.00
Begin VB.UserControl ButtonControl 
   BackColor       =   &H00C0C0C0&
   BackStyle       =   0  'Transparent
   ClientHeight    =   1605
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1980
   MaskColor       =   &H00000000&
   ScaleHeight     =   107
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   132
   ToolboxBitmap   =   "ButtonControl.ctx":0000
   Begin VB.Label lblText 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label"
      Height          =   195
      Left            =   225
      TabIndex        =   0
      Top             =   630
      Width           =   1380
   End
   Begin VB.Shape shpButton 
      BackColor       =   &H00FF8080&
      BackStyle       =   1  'Opaque
      BorderStyle     =   0  'Transparent
      Height          =   510
      Index           =   2
      Left            =   270
      Shape           =   2  'Oval
      Top             =   1035
      Width           =   780
   End
   Begin VB.Shape shpButton 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   1  'Opaque
      BorderStyle     =   0  'Transparent
      Height          =   555
      Index           =   1
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   555
   End
   Begin VB.Shape shpButton 
      BackColor       =   &H00404040&
      BackStyle       =   1  'Opaque
      BorderStyle     =   0  'Transparent
      Height          =   510
      Index           =   0
      Left            =   1215
      Shape           =   2  'Oval
      Top             =   270
      Width           =   600
   End
End
Attribute VB_Name = "ButtonControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Event Click()
Event DblClick()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Const m_def_ShadowDisplacement = 1
Dim m_ShadowDisplacement As Byte
Public Property Get Shape() As ShapeConstants
On Error GoTo Get_Err

Shape = shpButton(0).Shape

Exit Property
Get_Err:
Exit Property

End Property
Public Property Let Shape(ByVal New_Shape As ShapeConstants)
On Error GoTo Let_Err

shpButton(0).Shape = New_Shape
shpButton(1).Shape = New_Shape
shpButton(2).Shape = New_Shape

Exit Property
Let_Err:
Exit Property

End Property
Public Property Get Enabled() As Boolean
On Error GoTo Get_Err

Enabled = UserControl.Enabled

Exit Property
Get_Err:
Exit Property

End Property
Public Property Get Caption() As String
On Error GoTo Get_Err

Caption = lblText.Caption

Exit Property
Get_Err:
Exit Property

End Property
Public Property Let Caption(ByVal New_Caption As String)
On Error GoTo Let_Err

lblText.Caption = New_Caption
PropertyChanged "Caption"

Exit Property
Let_Err:
Exit Property

End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
On Error GoTo Let_Err

UserControl.Enabled() = New_Enabled
PropertyChanged "Enabled"

Exit Property
Let_Err:
Exit Property

End Property
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
Set Font = UserControl.Font
End Property
Public Property Set Font(ByVal New_Font As Font)
Set UserControl.Font = New_Font
Set lblText.Font = New_Font
Call ReCalculatePositions
PropertyChanged "Font"
End Property
Public Property Get BackStyle() As Integer
Attribute BackStyle.VB_Description = "Indicates whether a Label or the background of a Shape is transparent or opaque."
BackStyle = UserControl.BackStyle
End Property
Public Property Let BackStyle(ByVal New_BackStyle As Integer)
UserControl.BackStyle() = New_BackStyle
PropertyChanged "BackStyle"
End Property
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
UserControl.Refresh
End Sub
Private Sub lblText_Click()
RaiseEvent Click
End Sub
Private Sub lblText_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ShiftColors
End Sub
Private Sub lblText_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ShiftColors
End Sub
Private Sub UserControl_Click()
RaiseEvent Click
End Sub
Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub UserControl_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ShiftColors
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ShiftColors
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
Private Sub UserControl_InitProperties()
Set Font = Ambient.Font
m_ShadowDisplacement = m_def_ShadowDisplacement
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
Set Font = PropBag.ReadProperty("Font", Ambient.Font)
UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 0)
UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
shpButton(0).BackColor = PropBag.ReadProperty("ShadowColor", &H404040)
shpButton(1).BackColor = PropBag.ReadProperty("BackColor", &HFFFFFF)
shpButton(2).BackColor = PropBag.ReadProperty("ForeColor", &HFF8080)
lblText.Caption = PropBag.ReadProperty("Caption", "Caption")
m_ShadowDisplacement = PropBag.ReadProperty("ShadowDisplacement", m_def_ShadowDisplacement)
shpButton(0).Shape = PropBag.ReadProperty("Shape", 2)
shpButton(1).Shape = PropBag.ReadProperty("Shape", 2)
shpButton(2).Shape = PropBag.ReadProperty("Shape", 2)

End Sub
Private Sub UserControl_Resize()

Call ReCalculatePositions

End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
Call PropBag.WriteProperty("Font", Font, Ambient.Font)
Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 0)
Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
Call PropBag.WriteProperty("ShadowColor", shpButton(0).BackColor, &HFF8080)
Call PropBag.WriteProperty("BackColor", shpButton(1).BackColor, &H404040)
Call PropBag.WriteProperty("ForeColor", shpButton(2).BackColor, &HFF8080)
Call PropBag.WriteProperty("ShadowDisplacement", m_ShadowDisplacement, m_def_ShadowDisplacement)
Call PropBag.WriteProperty("Caption", lblText.Caption, "Caption")
Call PropBag.WriteProperty("Shape", shpButton(0).Shape, 2)

End Sub
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
BackColor = shpButton(1).BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
shpButton(1).BackColor = New_BackColor
PropertyChanged "BackColor"
End Property
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
ForeColor = shpButton(2).BackColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
shpButton(2).BackColor = New_ForeColor
PropertyChanged "ForeColor"
End Property
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
BorderStyle = shpButton(2).BorderStyle
End Property
Public Property Get BorderColor() As Long
Attribute BorderColor.VB_Description = "Returns/sets the color of an object's border."
    BorderColor = shpButton(2).BorderColor
End Property
Public Property Let BorderColor(ByVal New_BorderColor As Long)
    shpButton(2).BorderColor = New_BorderColor
    PropertyChanged "BorderColor"
End Property
Public Property Get hWnd() As Long
Attribute hWnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
    hWnd = UserControl.hWnd
End Property
Public Property Get hDC() As Long
Attribute hDC.VB_Description = "Returns a handle (from Microsoft Windows) to the object's device context."
hDC = UserControl.hDC
End Property
Public Property Get ShadowColor() As OLE_COLOR
Attribute ShadowColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
ShadowColor = shpButton(0).BackColor
End Property
Public Property Let ShadowColor(ByVal New_ShadowColor As OLE_COLOR)
shpButton(0).BackColor = New_ShadowColor
PropertyChanged "ShadowColor"
End Property
Public Property Get ShadowDisplacement() As Byte
Attribute ShadowDisplacement.VB_Description = "Displacement of the Shadow color and the Back color."
ShadowDisplacement = m_ShadowDisplacement
End Property
Public Property Let ShadowDisplacement(ByVal New_ShadowDisplacement As Byte)
m_ShadowDisplacement = New_ShadowDisplacement
Call ReCalculatePositions
PropertyChanged "ShadowDisplacement"
End Property
Private Sub ReCalculatePositions()
    With lblText
    .Left = 0
    .Width = UserControl.ScaleWidth
    .Top = (UserControl.ScaleHeight - .Height) / 2
    End With
    
    With shpButton(0)
    .Left = m_ShadowDisplacement
    .Top = m_ShadowDisplacement
    .Width = UserControl.ScaleWidth
    .Height = UserControl.ScaleHeight
    End With
    
    With shpButton(1)
    .Left = 0
    .Top = 0
    .Width = UserControl.ScaleWidth - m_ShadowDisplacement
    .Height = UserControl.ScaleHeight - m_ShadowDisplacement
    End With
    
    With shpButton(2)
    .Left = m_ShadowDisplacement / 2
    .Top = m_ShadowDisplacement / 2
    .Width = UserControl.ScaleWidth - (m_ShadowDisplacement / 2)
    .Height = UserControl.ScaleHeight - (m_ShadowDisplacement / 2)
    End With

End Sub
Sub ShiftColors()

Dim N As Long
N = shpButton(0).BackColor
shpButton(0).BackColor = shpButton(1).BackColor
shpButton(1).BackColor = N
End Sub
