rendered paste bodyDim 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