📄 candybutton.ctl
字号:
Dim g1 As Long
Dim b1 As Long
Dim r2 As Long
Dim g2 As Long
Dim b2 As Long
Dim uH As Long
Dim uW As Long
uH = ScaleHeight - 1
uW = ScaleWidth - 1
On Error Resume Next
Line (0, 0)-(uW, uH), Parent.BackColor, BF
On Error GoTo 0
If vState = ePressed Then
r1 = 209
g1 = 204
b1 = 193
r2 = 229
g2 = 228
b2 = 221
For i = 0 To 3
Line (0, 1 + i)-(uW, 1 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
Next i
r1 = 229
g1 = 228
b1 = 221
r2 = 226
g2 = 226
b2 = 218
For i = 4 To uH - 4
Line (0, i)-(uW, i), RGB(r2 * (i / (uH - 6)) + r1 - (r1 * (i / (uH - 6))), g2 * (i / (uH - 6)) + g1 - (g1 * (i / (uH - 6))), b2 * (i / (uH - 6)) + b1 - (b1 * (i / (uH - 6))))
Next i
r1 = 226
g1 = 226
b1 = 218
r2 = 242
g2 = 241
b2 = 238
For i = 0 To 4
Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
Next i
Else
r1 = 236
g1 = 235
b1 = 230
r2 = 214
g2 = 208
b2 = 197
For i = 0 To uH - 3
Line (1, i)-(uW, i), RGB(r1 * (i / (uH - 3)) + 255 - (255 * (i / (uH - 3))), g1 * (i / (uH - 3)) + 255 - (255 * (i / (uH - 3))), b1 * (i / (uH - 3)) + 255 - (255 * (i / (uH - 3))))
Next i
For i = 0 To 3
Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
Next i
End If
Select Case vState
Case eFocus
Line (0, 1)-(uW, 1), RGB(206, 231, 255)
Line (0, 2)-(uW, 2), RGB(188, 212, 246)
r1 = 188
g1 = 212
b1 = 246
r2 = 137
g2 = 173
b2 = 228
For i = 3 To uH - 3
Line (0, i)-(3, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
Line (uW - 2, i)-(uW, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
Next i
Line (0, uH - 2)-(uW, uH - 2), RGB(137, 173, 228)
Line (0, uH - 1)-(uW, uH - 1), RGB(105, 130, 238)
Case eHover
Line (0, 1)-(uW, 1), RGB(255, 240, 202)
Line (0, 2)-(uW, 2), RGB(253, 216, 137)
r1 = 253
g1 = 216
b1 = 137
r2 = 248
g2 = 178
b2 = 48
For i = 3 To uH - 3
Line (0, i)-(3, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
Line (uW - 2, i)-(uW, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
Next i
Line (0, uH - 2)-(uW, uH - 2), RGB(248, 178, 48)
Line (0, uH - 1)-(uW, uH - 1), RGB(229, 151, 0)
End Select
PSet (0, 1), RGB(122, 149, 168)
PSet (1, 0), RGB(122, 149, 168)
Line (0, 2)-(2, 0), RGB(37, 87, 131) '7617536
Line (2, 0)-(uW - 2, 0), 7617536
PSet (uW - 1, 0), RGB(122, 149, 168)
PSet (uW, 1), RGB(122, 149, 168)
Line (uW - 2, 0)-(uW, 2), RGB(37, 87, 131) '7617536
Line (uW, 2)-(uW, uH - 2), 7617536
PSet (uW, uH - 1), RGB(122, 149, 168)
PSet (uW - 1, uH), RGB(122, 149, 168)
Line (uW, uH - 2)-(uW - 2, uH), RGB(37, 87, 131) ' 7617536
Line (uW - 2, uH)-(2, uH), 7617536
PSet (1, uH), RGB(122, 149, 168)
PSet (0, uH - 1), RGB(122, 149, 168)
Line (2, uH)-(0, uH - 2), RGB(37, 87, 131) '7617536
Line (0, uH - 2)-(0, 2), 7617536
End Function
Private Function DrawXPToolbarButton(vState As eState)
Dim i As Long
Dim r1 As Long
Dim g1 As Long
Dim b1 As Long
Dim r2 As Long
Dim g2 As Long
Dim b2 As Long
Dim uH As Long
Dim uW As Long
uH = ScaleHeight - 1
uW = ScaleWidth - 1
On Error Resume Next
Line (0, 0)-(uW, uH), Parent.BackColor, BF
On Error GoTo 0
If vState = ePressed Then
r1 = 220
g1 = 218
b1 = 209
r2 = 231
g2 = 230
b2 = 224
For i = 0 To 3
Line (0, 1 + i)-(uW, 1 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
Next i
r1 = 231
g1 = 230
b1 = 224
r2 = 225
g2 = 224
b2 = 216
For i = 4 To uH - 4
Line (0, i)-(uW, i), RGB(r2 * (i / (uH - 6)) + r1 - (r1 * (i / (uH - 6))), g2 * (i / (uH - 6)) + g1 - (g1 * (i / (uH - 6))), b2 * (i / (uH - 6)) + b1 - (b1 * (i / (uH - 6))))
Next i
r1 = 225
g1 = 224
b1 = 216
r2 = 235
g2 = 234
b2 = 229
For i = 0 To 3
Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
Next i
PSet (1, 0), RGB(215, 215, 204)
PSet (0, 1), RGB(215, 215, 204)
Line (0, 2)-(2, 0), RGB(179, 179, 168) '7617536
Line (2, 0)-(uW - 2, 0), RGB(157, 157, 146)
PSet (uW - 1, 0), RGB(215, 215, 204)
PSet (uW, 1), RGB(215, 215, 204)
Line (uW - 2, 0)-(uW, 2), RGB(179, 179, 168) '7617536
Line (uW, 2)-(uW, uH - 2), RGB(157, 157, 146)
PSet (uW, uH - 1), RGB(215, 215, 204)
PSet (uW - 1, uH), RGB(215, 215, 204)
Line (uW, uH - 2)-(uW - 2, uH), RGB(179, 179, 168) ' 7617536
Line (uW - 2, uH)-(2, uH), RGB(157, 157, 146)
PSet (1, uH), RGB(215, 215, 204)
PSet (0, uH - 1), RGB(215, 215, 204)
Line (2, uH)-(0, uH - 2), RGB(179, 179, 168) '7617536
Line (0, uH - 2)-(0, 2), RGB(157, 157, 146)
ElseIf vState = eHover Then
r1 = 254
g1 = 254
b1 = 253
r2 = 252
g2 = 252
b2 = 249
For i = 0 To 3
Line (0, 1 + i)-(uW, 1 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
Next i
r1 = 252
g1 = 252
b1 = 249
r2 = 238
g2 = 237
b2 = 229
For i = 4 To uH - 4
Line (0, i)-(uW, i), RGB(r2 * (i / (uH - 6)) + r1 - (r1 * (i / (uH - 6))), g2 * (i / (uH - 6)) + g1 - (g1 * (i / (uH - 6))), b2 * (i / (uH - 6)) + b1 - (b1 * (i / (uH - 6))))
Next i
r1 = 238
g1 = 237
b1 = 229
r2 = 215
g2 = 210
b2 = 198
For i = 0 To 3
Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
Next i
PSet (1, 0), RGB(232, 232, 221)
PSet (0, 1), RGB(232, 232, 221)
Line (0, 2)-(2, 0), RGB(216, 216, 205) '7617536
Line (2, 0)-(uW - 2, 0), RGB(206, 206, 195)
PSet (uW - 1, 0), RGB(232, 232, 221)
PSet (uW, 1), RGB(232, 232, 221)
Line (uW - 2, 0)-(uW, 2), RGB(216, 216, 205) '7617536
Line (uW, 2)-(uW, uH - 2), RGB(206, 206, 195)
PSet (uW, uH - 1), RGB(232, 232, 221)
PSet (uW - 1, uH), RGB(232, 232, 221)
Line (uW, uH - 2)-(uW - 2, uH), RGB(216, 216, 205) ' 7617536
Line (uW - 2, uH)-(2, uH), RGB(206, 206, 195)
PSet (1, uH), RGB(232, 232, 221)
PSet (0, uH - 1), RGB(232, 232, 221)
Line (2, uH)-(0, uH - 2), RGB(216, 216, 205) '7617536
Line (0, uH - 2)-(0, 2), RGB(206, 206, 195)
ElseIf vState = eChecked Then
Line (1, 1)-(uW - 1, uH - 1), vbWhite, BF
PSet (1, 0), RGB(203, 213, 214)
PSet (0, 1), RGB(203, 213, 214)
Line (0, 2)-(2, 0), RGB(152, 175, 190) '7617536
Line (2, 0)-(uW - 2, 0), RGB(122, 152, 175)
PSet (uW - 1, 0), RGB(203, 213, 214)
PSet (uW, 1), RGB(203, 213, 214)
Line (uW - 2, 0)-(uW, 2), RGB(152, 175, 190) '7617536
Line (uW, 2)-(uW, uH - 2), RGB(122, 152, 175)
PSet (uW, uH - 1), RGB(203, 213, 214)
PSet (uW - 1, uH), RGB(203, 213, 214)
Line (uW, uH - 2)-(uW - 2, uH), RGB(152, 175, 190) ' 7617536
Line (uW - 2, uH)-(2, uH), RGB(122, 152, 175)
PSet (1, uH), RGB(203, 213, 214)
PSet (0, uH - 1), RGB(203, 213, 214)
Line (2, uH)-(0, uH - 2), RGB(152, 175, 190) '7617536
Line (0, uH - 2)-(0, 2), RGB(122, 152, 175)
End If
End Function
Public Property Get Enabled() As Boolean
On Error GoTo Handler
Enabled = m_bEnabled
Refresh
Exit Property
Handler:
End Property
'Description: Enable or disable the control
Public Property Let Enabled(bEnabled As Boolean)
On Error GoTo Handler
m_bEnabled = bEnabled
PropertyChanged "Enabled"
'/*** added
DrawButton (eNormal)
Handler:
End Property
Private Sub ExcludePixelsFromRegion(hRgn As Long, _
X1 As Long, _
Y1 As Long, _
X2 As Long, _
Y2 As Long)
Dim hRgnTemp As Long
hRgnTemp = CreateRectRgn(X1, Y1, X2, Y2)
CombineRgn hRgn, hRgn, hRgnTemp, RGN_XOR
DeleteObject hRgnTemp
End Sub
Public Property Get Font() As StdFont
Set Font = UserControl.Font
End Property
Public Property Set Font(ByVal NewFont As StdFont)
Set UserControl.Font = NewFont
PropertyChanged "Font"
DrawButton (eNormal)
End Property
Public Property Get ForeColor() As OLE_COLOR
ForeColor = m_ForeColor
End Property
Public Property Let ForeColor(ByVal NewForeColor As OLE_COLOR)
m_ForeColor = NewForeColor
UserControl.ForeColor = m_ForeColor
PropertyChanged "ForeColor"
DrawButton (eNormal)
End Property
Public Sub GetRGB(r As Long, _
g As Long, _
b As Long, _
Color As Long)
Dim TempValue As Long
TranslateColor Color, 0, TempValue
r = TempValue And &HFF&
g = (TempValue And &HFF00&) \ &H100&
b = (TempValue And &HFF0000) \ &H10000
End Sub
Private Function HiWord(lDWord As Long) As Integer
HiWord = (lDWord And &HFFFF0000) \ &H10000
End Function
'/*** enable icon mouse over highliting
Public Property Get IconHighLite() As Boolean
IconHighLite = m_bIconHighLite
End Property
Public Property Let IconHighLite(PropVal As Boolean)
m_bIconHighLite = PropVal
PropertyChanged "IconHighLite"
End Property
'/*** enable icon mouse over highliting
Public Property Get IconHighLiteColor() As OLE_COLOR
IconHighLiteColor = m_lIconHighLiteColor
End Property
Public Property Let IconHighLiteColor(PropVal As OLE_COLOR)
m_lIconHighLiteColor = PropVal
PropertyChanged "IconHighLiteColor"
End Property
'/----------------------------------------------------------------------------------/
'/ /
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -