-
Notifications
You must be signed in to change notification settings - Fork 1
/
ucCmdBtn.ctl
136 lines (118 loc) · 3.65 KB
/
ucCmdBtn.ctl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
VERSION 5.00
Begin VB.UserControl ucCmdBtn
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
ClientHeight = 1005
ClientLeft = 0
ClientTop = 0
ClientWidth = 3645
ScaleHeight = 1005
ScaleWidth = 3645
Begin VB.Timer tmrClr
Enabled = 0 'False
Interval = 50
Left = 0
Top = 0
End
Begin VB.Label lblCaption
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "΢ÈíÑźÚ"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1680
TabIndex = 0
Top = 360
Width = 60
End
End
Attribute VB_Name = "ucCmdBtn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Dim ColorTo As Long
Event Click()
Event DblClick()
Private Sub lblCaption_Click()
UserControl_Click
End Sub
Private Sub lblCaption_DblClick()
UserControl_DblClick
End Sub
Private Sub lblCaption_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
UserControl_MouseDown Button, Shift, X, Y
End Sub
Private Sub lblCaption_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
UserControl_MouseUp Button, Shift, X, Y
End Sub
Private Sub tmrClr_Timer()
With UserControl
Dim nc&
nc = (.BackColor And &HFF) Mod 256
If ColorTo > nc Then
.BackColor = RGB(nc + 5, nc + 5, nc + 5)
If nc >= ColorTo Then .BackColor = RGB(ColorTo, ColorTo, ColorTo): tmrClr.Enabled = False
Else
.BackColor = RGB(nc - 5, nc - 5, nc - 5)
If nc <= ColorTo Then .BackColor = RGB(ColorTo, ColorTo, ColorTo): tmrClr.Enabled = False
End If
End With
End Sub
Private Sub UserControl_Click()
RaiseEvent Click
End Sub
Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub
Private Sub UserControl_Initialize()
UserControl.BackColor = RGB(235, 235, 235)
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ColorTo = 224
tmrClr.Enabled = True
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (0 <= X) And (X <= UserControl.Width) And (0 <= Y) And (Y <= UserControl.Height) Then
ColorTo = 255
SetCapture UserControl.hwnd
Else
ColorTo = 235
ReleaseCapture
End If
tmrClr.Enabled = True
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ColorTo = 255
tmrClr.Enabled = True
End Sub
Private Sub UserControl_Paint()
UserControl_Initialize
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
lblCaption.Caption = PropBag.ReadProperty("Caption", "")
UserControl_Resize
End Sub
Private Sub UserControl_Resize()
lblCaption.Move (UserControl.ScaleWidth - lblCaption.Width) / 2, (UserControl.ScaleHeight - lblCaption.Height) / 2
End Sub
Public Property Get Caption() As String
Caption = lblCaption.Caption
End Property
Public Property Let Caption(ByVal nCap As String)
PropertyChanged "Caption"
lblCaption.Caption = nCap
UserControl_Resize
End Property
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "Caption", lblCaption.Caption
End Sub