Dim xx, R1, R2, G1, G2, B1, B2, Rs, Gs, Bs, Rx, Gx, Bx
Dim LCol1, Border1, Border2

Public Enum AppearanceConst
    Flat = 0
    TABlue = 1
    TAGold = 2
    TAGreen = 3
    TAPink = 4
    TARed = 5
    Pink = 6
    Blue = 7
    Yellow = 8
    brown = 9
    GrayOrang = 10
    NeonBlue = 11
    NeonGreen = 12
    HardGray = 13
    TAChat1 = 14
    TAChat2 = 15
    TAMess = 16
End Enum

Private MyCaption As String
Private MyFont As Font
Private MyForeColor As OLE_COLOR
Private DefForeColor As OLE_COLOR
Private NewButtonIcon As Picture
Private MyAppearance As AppearanceConst
Private isEnabled As Boolean
Private Const MyDefAppearance = Flat
Private Const DefCaption = "KDC"

Public Event Click()
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event Resize()

Public Property Let Enabled(ByVal NewValue As Boolean)
isEnabled = NewValue
UserControl.Enabled = isEnabled
PropertyChanged "ENAB"
End Property

Private Sub Label1_Change()
    Call UserControl_Resize
End Sub
Private Sub Label1_Click()
    If isEnabled Then
        Call RaiseEventS("Click")
    End If
End Sub
Private Sub image1_Click()
    If isEnabled Then
        Call RaiseEventS("Click")
    End If
End Sub
Private Sub Pic1_Click()
    If isEnabled Then
      Call RaiseEventS("Click")
    End If
End Sub
Private Sub Pic1_KeyDown(KeyCode As Integer, Shift As Integer)
    Call RaiseEventS("KeyDown", KeyCode, Shift)
End Sub
Private Sub Pic1_KeyPress(KeyAscii As Integer)
    Call RaiseEventS("KeyPress", KeyAscii)
End Sub
Private Sub Pic1_KeyUp(KeyCode As Integer, Shift As Integer)
    Call RaiseEventS("KeyUp", KeyCode, Shift)
End Sub
Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
    Call RaiseEventS("Click")
End Sub
Private Sub UserControl_GotFocus()
    bHasFocus = True
End Sub
Private Sub UserControl_LostFocus()
    bHasFocus = False
End Sub
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call AllMouseDown
End Sub
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call AllMouseUP
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call AllMouseDown
End Sub
Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call AllMouseUP
End Sub
Private Sub pic1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call AllMouseDown
End Sub
Private Sub Pic1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call AllMouseUP
End Sub
Private Sub AllMouseDown()
    Pic1.Line (0, 0)-(Pic1.Width - 1, Pic1.Height - 1), Border2, B
    Pic1.Line (0, Pic1.Height - 10)-(Pic1.Width, Pic1.Height - 10), Border1
    Pic1.Line (Pic1.Width - 10, 0)-(Pic1.Width - 10, Pic1.Height - 10), Border1
    Image1.Move (Image1.Left + 11), Image1.Top + 11
    Label1.Move (Label1.Left + 20), Label1.Top + 11
End Sub
Private Sub AllMouseUP()
    Image1.Move (Image1.Left - 11), Image1.Top - 11
    Label1.Move (Label1.Left - 20), Label1.Top - 11
    Call UserControl_Resize
End Sub
Private Sub UserControl_Initialize()
    isEnabled = True
    Pic1.Left = 0
    Pic1.Top = 0
    UserControl.Height = Pic1.Height
    UserControl.Width = Pic1.Width
    Call UserControl_Resize
End Sub
Private Sub UserControl_Resize()
    If UserControl.Width <> 0 Then
        Pic1.Width = UserControl.Width
        Pic1.Height = UserControl.Height
        If Image1.Width > 15 Then
        Label1.Left = (Pic1.Width / 2) - ((Label1.Width + Image1.Width) / 2) + Image1.Width
        Image1.Left = (Pic1.Width / 2) - ((Label1.Width + Image1.Width) / 2) - 40
        Else
        Label1.Left = (Pic1.Width / 2) - ((Label1.Width + Image1.Width) / 2)
        End If
        Label1.Top = (Pic1.Height / 2) - (Label1.Height / 2)
        Image1.Top = (Pic1.Height / 2) - (Image1.Height / 2)
        Call SetGradient
    End If
End Sub
Private Function RaiseEventS(ByVal Name As String, ParamArray Params() As Variant)
  Select Case Name
        Case "Click"
            RaiseEvent Click
        Case "KeyDown"
            RaiseEvent KeyDown(CInt(Params(0)), CInt(Params(1)))
        Case "KeyPress"
            RaiseEvent KeyPress(CInt(Params(0)))
        Case "KeyUp"
            RaiseEvent KeyUp(CInt(Params(0)), CInt(Params(1)))
        Case "MouseDown"
            RaiseEvent MouseDown(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
        Case "MouseUp"
            RaiseEvent MouseUp(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
        Case "Resize"
            RaiseEvent Resize
    End Select
End Function
Public Property Get Caption() As String
    Caption = MyCaption
End Property

Public Property Get Enabled() As Boolean
On Error Resume Next
    Enabled = isEnabled
End Property

Public Property Let Caption(ByVal vData As String)
    MyCaption = vData
    Label1.Caption = vData
PropertyChanged "Caption"
End Property
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = MyForeColor
End Property
Public Property Let ForeColor(ByVal vData As OLE_COLOR)
    MyForeColor = vData
    Label1.ForeColor = MyForeColor
PropertyChanged "ForeColor"
End Property
Public Property Get Font() As Font
    Set Font = MyFont
End Property
Public Property Set Font(ByVal vData As Font)
    Set MyFont = vData
    Set UserControl.Font = vData
    Set Label1.Font = MyFont
    Call UserControl_Resize
PropertyChanged "Font"
End Property
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Appearance", MyAppearance, MyDefAppearance)
    Call PropBag.WriteProperty("Caption", MyCaption, DefCaption)
    Call PropBag.WriteProperty("ForeColor", MyForeColor, DefForeColor)
    Call PropBag.WriteProperty("Font", MyFont, Ambient.Font)
    Call PropBag.WriteProperty("ButtonIcon", Me.ButtonIcon, Nothing)
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Appearance = PropBag.ReadProperty("Appearance", MyDefAppearance)
    Caption = PropBag.ReadProperty("Caption", DefCaption)
    ForeColor = PropBag.ReadProperty("ForeColor", DefForeColor)
    Set Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set ButtonIcon = PropBag.ReadProperty("ButtonIcon", Nothing)
End Sub
Private Sub UserControl_InitProperties()
    Appearance = Yellow
    Caption = DefCaption
    ForeColor = DefForeColor
    Set Font = Ambient.Font
End Sub
Public Property Get Appearance() As AppearanceConst
    Appearance = MyAppearance
End Property
Public Property Let Appearance(ByVal vData As AppearanceConst)
    MyAppearance = vData
    Call SetGradient
    ForeColor = DefForeColor
PropertyChanged "ForeColor"
PropertyChanged "Appearance"
End Property
Public Property Get ButtonIcon() As Picture
    Set ButtonIcon = Image1.Picture
End Property
Public Property Set ButtonIcon(ByVal NewButtonIcon As Picture)
    Set Image1.Picture = NewButtonIcon
    Set Image1.Picture = NewButtonIcon
    UserControl_Resize
PropertyChanged "ButtonIcon"
End Property
Private Sub SetGradient()
    Select Case MyAppearance
        Case Is = Flat
            R1 = &H80: R2 = &H80
            G1 = &H80: G2 = &H80
            B1 = &H80: B2 = &H80
            DefForeColor = &HFFFFFF
            Border1 = &HE0E0E0
            Border2 = &H606060
        Case Is = TABlue
            R1 = 240: R2 = 240
            G1 = 245: G2 = 245
            B1 = 250: B2 = 250
            DefForeColor = RGB(87, 104, 106)
            Border1 = RGB(240, 245, 250)
            Border2 = RGB(240, 245, 250)
        Case Is = TAGold
            R1 = 240: R2 = 240
            G1 = 241: G2 = 241
            B1 = 207: B2 = 207
            DefForeColor = RGB(113, 114, 85)
            Border1 = RGB(240, 241, 207)
            Border2 = RGB(240, 241, 207)
        Case Is = TAGreen
            R1 = 240: R2 = 240
            G1 = 250: G2 = 250
            B1 = 239: B2 = 239
            DefForeColor = RGB(87, 113, 84)
            Border1 = RGB(240, 250, 239)
            Border2 = RGB(240, 250, 239)
        Case Is = TAPink
            R1 = 240: R2 = 240
            G1 = 223: G2 = 223
            B1 = 247: B2 = 247
            DefForeColor = RGB(107, 86, 115)
            Border1 = RGB(240, 223, 247)
            Border2 = RGB(240, 223, 247)
        Case Is = TARed
            R1 = 240: R2 = 240
            G1 = 227: G2 = 227
            B1 = 227: B2 = 227
            DefForeColor = RGB(128, 69, 69)
            Border1 = RGB(240, 227, 227)
            Border2 = RGB(240, 227, 227)
        Case Is = Pink
            R1 = &HD0: R2 = &H80
            G1 = &HA0: G2 = &H70
            B1 = &HA0: B2 = &H70
            DefForeColor = &H202080
            Border1 = &HC0C0F0
            Border2 = &H8080A0
        Case Is = Blue
            R2 = &H20: R1 = &H70
            G2 = &H20: G1 = &H80
            B2 = &H40: B1 = &HA0
            DefForeColor = &HFFFFFF
            Border1 = &HD05050
            Border2 = &H802020
        Case Is = Yellow
            R1 = &HF0: R2 = &HA0
            G1 = &HF0: G2 = &HA0
            B1 = &H80: B2 = &H20
            DefForeColor = &H206000
            Border1 = &H80FFFF
            Border2 = &H208080
        Case Is = brown
            R1 = &HF0: R2 = &H80
            G1 = &HA0: G2 = &H30
            B1 = &H60: B2 = &H20
            DefForeColor = &H20F0A0
            Border1 = &H2080F0
            Border2 = &H104080
        Case Is = GrayOrang
            R1 = &HFF: R2 = &HCC
            G1 = &HFF: G2 = &HCC
            B1 = &HFF: B2 = &HCC
            DefForeColor = &H80FF&
            Border1 = &H2080F0
            Border2 = &H104080
        Case Is = NeonBlue
            R1 = &H22: R2 = &H44
            G1 = &HCC: G2 = &H44
            B1 = &HFF: B2 = &H44
            DefForeColor = &HFFFFFF
            Border1 = &HF3CD69
            Border2 = &H6B5007
        Case Is = NeonGreen
            R1 = &H22: R2 = &H44
            G1 = &HCC: G2 = &H44
            B1 = &HCC: B2 = &H44
            DefForeColor = &HFFFFFF
            Border1 = &HBFBB0D
            Border2 = &H525805
        Case Is = HardGray
            R1 = &H77: R2 = &H11
            G1 = &H77: G2 = &H11
            B1 = &H77: B2 = &H11
            DefForeColor = &HFFFFFF
            Border1 = &HC0C0C0
            Border2 = &H404040
        Case Is = TAChat1
'            R1 = &HEE: R2 = &HAA
'            G1 = &HEE: G2 = &HAA
'            B1 = &HEE: B2 = &HAA
            R1 = 255: R2 = 240
            G1 = 255: G2 = 250
            B1 = 255: B2 = 255
            DefForeColor = &H5C5244
'            DefForeColor = &H0
            Border1 = &HC0C0C0
            Border2 = &H404040
        Case Is = TAChat2
'            R1 = &HEE: R2 = &HAA
'            G1 = &HEE: G2 = &HAA
'            B1 = &HEE: B2 = &HAA
            R1 = 240: R2 = 240
            G1 = 245: G2 = 245
            B1 = 250: B2 = 250
            DefForeColor = &H5C5244
'            DefForeColor = &H0
            Border1 = &HFAF5F0
            Border2 = &HFAF5F0
        Case Is = TAMess
'            R1 = 176: R2 = 240
'            G1 = 201: G2 = 250
'            B1 = 219: B2 = 255
            R1 = 255: R2 = 240
            G1 = 255: G2 = 250
            B1 = 255: B2 = 255
            DefForeColor = &H5C5244
            Border1 = &H7B6A53
            Border2 = &H7B6A53
    End Select

Rx = R1: Gx = G1: Bx = B1
Rs = (R1 - R2) / (Pic1.ScaleHeight - 1)
Gs = (G1 - G2) / (Pic1.ScaleHeight - 1)
Bs = (B1 - B2) / (Pic1.ScaleHeight - 1)
    For xx = 0 To Pic1.Height - 1
      Pic1.Line (0, xx)-(Pic1.Width, xx), RGB(Rx, Gx, Bx)
        Rx = Rx - Rs
        Gx = Gx - Gs
        Bx = Bx - Bs
    Next xx

Pic1.Line (0, 0)-(Pic1.Width - 1, Pic1.Height - 1), Border1, B
Pic1.Line (0, Pic1.Height - 10)-(Pic1.Width, Pic1.Height - 10), Border2
Pic1.Line (Pic1.Width - 10, 0)-(Pic1.Width - 10, Pic1.Height - 10), Border2

Bord1 = Pic1.Point(0, 0)
Bord2 = Pic1.Point(Pic1.Width - 10, Pic1.Height - 10)
End Sub