📄 wwbutton.ctl
字号:
'#@#@#@#@#@# 按钮按下 #@#@#@#@#@#
Select Case MyButtonType
Case 1 'Windows XP
Select Case MyXpType
Case 1
DrawJianBian 171, 170, 188, 1, He - 2, 1 'XP银色效果
Case 2
stepXP1 = 15 / He
XPface = ShiftColor(cFace, &H30, True)
XPface = ShiftColor(XPface, -32, True)
For I = 1 To He
DrawLine 0, He - I, Wi, He - I, ShiftColor(XPface, -stepXP1 * I, True)
Next
Case 3
DrawJianBian 224, 224, 216, 1, He - 2, 1 'XP蓝色效果
End Select
SetTextColor UserControl.hdc, cText
If UserControl.TextWidth(m_Caption) <= Wi Then
DrawText UserControl.hdc, m_Caption, -1, rc2, DT_CENTERABS
Else
rc2.Top = Rc.Top + 2
DrawText .hdc, m_Caption, -1, rc2, DT_CENTER Or DT_WORDBREAK '
End If
DrawXPFrame &H733C00, &H7B4D10
If hasFocus = True Then DrawFocusR
Case 2 'Mac
DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cShadow, -&H10)
DrawLine 2, 0, Wi - 2, 0, cDarkShadow
DrawLine 2, He - 1, Wi - 2, He - 1, cDarkShadow
DrawLine 0, 2, 0, He - 2, cDarkShadow
DrawLine Wi - 1, 2, Wi - 1, He - 2, cDarkShadow
DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cShadow, -&H40), True
DrawRectangle 2, 2, Wi - 4, He - 4, ShiftColor(cShadow, -&H20), True
mSetPixel 2, 2, ShiftColor(cShadow, -&H40)
mSetPixel 3, 3, ShiftColor(cShadow, -&H20)
mSetPixel 1, 1, cDarkShadow
mSetPixel 1, He - 2, cDarkShadow
mSetPixel Wi - 2, 1, cDarkShadow
mSetPixel Wi - 2, He - 2, cDarkShadow
DrawLine Wi - 3, 1, Wi - 3, He - 3, cShadow
DrawLine 1, He - 3, Wi - 2, He - 3, cShadow
mSetPixel Wi - 4, He - 4, cShadow
DrawLine Wi - 2, 3, Wi - 2, He - 2, ShiftColor(cShadow, -&H10)
DrawLine 3, He - 2, Wi - 2, He - 2, ShiftColor(cShadow, -&H10)
mSetPixel Wi - 2, He - 3, ShiftColor(cShadow, -&H20)
mSetPixel Wi - 3, He - 2, ShiftColor(cShadow, -&H20)
mSetPixel 2, He - 2, ShiftColor(cShadow, -&H20)
mSetPixel 2, He - 3, ShiftColor(cShadow, -&H10)
mSetPixel 1, He - 3, ShiftColor(cShadow, -&H10)
mSetPixel Wi - 2, 2, ShiftColor(cShadow, -&H20)
mSetPixel Wi - 3, 2, ShiftColor(cShadow, -&H10)
mSetPixel Wi - 3, 1, ShiftColor(cShadow, -&H10)
SetTextColor .hdc, cLight
If UserControl.TextWidth(m_Caption) <= Wi Then
DrawText UserControl.hdc, m_Caption, -1, rc2, DT_CENTERABS
Else
rc2.Top = Rc.Top + 2
DrawText .hdc, m_Caption, -1, rc2, DT_CENTER Or DT_WORDBREAK '
End If
'DrawText .hdc, m_Caption, -1, rc2, DT_CENTERABS
Case 3
If MyColorType = 1 Then
DrawMacOS m_MouseDownMidColor, RGB(203, 130, 62), m_MouseDownEndColor, m_Percent
Else
DrawMacOS m_MouseDownMidColor, RGB(84, 157, 84), m_MouseDownEndColor, m_Percent, True
End If
SetTextColor .hdc, cText
If .TextWidth(m_Caption) <= Wi Then
DrawText .hdc, m_Caption, -1, rc2, DT_CENTERABS
Else
rc2.Top = Rc.Top + 2
DrawText .hdc, m_Caption, -1, rc2, DT_CENTER Or DT_WORDBREAK '
End If
If hasFocus = True Then DrawFocusR
Case 4
DrawLonghorn m_MouseDownMidColor, RGB(81, 107, 148), m_MouseDownEndColor, m_Percent
SetTextColor .hdc, cText
If .TextWidth(m_Caption) <= Wi Then
DrawText .hdc, m_Caption, -1, rc2, DT_CENTERABS
Else
rc2.Top = Rc.Top + 2
DrawText .hdc, m_Caption, -1, rc2, DT_CENTER Or DT_WORDBREAK '
End If
If hasFocus = True Then DrawFocusR
Case 5
DrawRectangle 0, 0, Wi, He, m_OfficeXpMousemoveFrameColor, True
If MyColorType = 3 Then
DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColorCustom(m_OfficeXpMousemoveFillColor, -40, -30, -15, RGB(250, 250, 250))
Else
DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColorCustom(m_OfficeXpMousemoveFillColor, -30, -30, -60, RGB(250, 250, 250))
End If
If .TextWidth(m_Caption) <= Wi Then
DrawText .hdc, m_Caption, -1, rc2, DT_CENTERABS
Else
rc2.Top = Rc.Top + 2
DrawText .hdc, m_Caption, -1, rc2, DT_CENTER Or DT_WORDBREAK '
End If
If hasFocus = True Then DrawFocusR
End Select
End If
Else
'#~#~#~#~#~# DISABLED STATUS #~#~#~#~#~#
Select Case MyButtonType
Case 1 'Windows XP
DrawRectangle 0, 0, Wi, He, RGB(244, 244, 234)
SetTextColor UserControl.hdc, RGB(161, 162, 146)
If .TextWidth(m_Caption) <= Wi Then
DrawText .hdc, m_Caption, -1, Rc, DT_CENTERABS
Else
NumLine = (.TextWidth(m_Caption) \ Wi) + 1
Rc.Top = (He - .TextHeight(m_Caption) * NumLine) \ 2
DrawText .hdc, m_Caption, -1, Rc, DT_CENTER Or DT_WORDBREAK '
End If
DrawXPFrame RGB(201, 199, 186), RGB(201, 199, 186)
Case 2 'Mac
DrawRectangle 1, 1, Wi - 2, He - 2, cLight
SetTextColor .hdc, cShadow
DrawText .hdc, m_Caption, -1, Rc, DT_CENTERABS
DrawLine 2, 0, Wi - 2, 0, cDarkShadow
DrawLine 2, He - 1, Wi - 2, He - 1, cDarkShadow
DrawLine 0, 2, 0, He - 2, cDarkShadow
DrawLine Wi - 1, 2, Wi - 1, He - 2, cDarkShadow
mSetPixel 1, 1, cDarkShadow
mSetPixel 1, He - 2, cDarkShadow
mSetPixel Wi - 2, 1, cDarkShadow
mSetPixel Wi - 2, He - 2, cDarkShadow
mSetPixel 1, 2, cFace
mSetPixel 2, 1, cFace
DrawLine 3, 2, Wi - 3, 2, cHighLight
DrawLine 2, 2, 2, He - 3, cHighLight
mSetPixel 3, 3, cHighLight
DrawLine Wi - 3, 1, Wi - 3, He - 3, cFace
DrawLine 1, He - 3, Wi - 3, He - 3, cFace
mSetPixel Wi - 4, He - 4, cFace
DrawLine Wi - 2, 3, Wi - 2, He - 2, cShadow
DrawLine 3, He - 2, Wi - 2, He - 2, cShadow
mSetPixel Wi - 3, He - 3, cShadow
mSetPixel 2, He - 2, cFace
mSetPixel 2, He - 3, cLight
mSetPixel Wi - 2, 2, cFace
mSetPixel Wi - 3, 2, cLight
SetTextColor .hdc, cHighLight
If .TextWidth(m_Caption) <= Wi Then
DrawText .hdc, m_Caption, -1, rc2, DT_CENTERABS
Else
NumLine = (.TextWidth(m_Caption) \ Wi) + 1
rc2.Top = (He - .TextHeight(m_Caption) * NumLine) \ 2 + 2
DrawText .hdc, m_Caption, -1, Rc, DT_CENTER Or DT_WORDBREAK '
End If
Case 3
DrawRectangle 1, 1, Wi - 2, He - 2, RGB(241, 242, 237)
DrawXPFrame RGB(204, 204, 202), RGB(204, 204, 202)
SetTextColor .hdc, RGB(171, 168, 153)
If .TextWidth(m_Caption) <= Wi Then
DrawText .hdc, m_Caption, -1, Rc, DT_CENTERABS
Else
NumLine = (.TextWidth(m_Caption) \ Wi) + 1
Rc.Top = (He - .TextHeight(m_Caption) * NumLine) \ 2
DrawText .hdc, m_Caption, -1, Rc, DT_CENTER Or DT_WORDBREAK '
End If
Case 4
DrawLonghorn RGB(198, 218, 255), RGB(128, 140, 162), RGB(232, 242, 255), 53
SetTextColor .hdc, RGB(171, 168, 153)
If .TextWidth(m_Caption) <= Wi Then
DrawText .hdc, m_Caption, -1, Rc, DT_CENTERABS
Else
NumLine = (.TextWidth(m_Caption) \ Wi) + 1
Rc.Top = (He - .TextHeight(m_Caption) * NumLine) \ 2
DrawText .hdc, m_Caption, -1, Rc, DT_CENTER Or DT_WORDBREAK '
End If
Case 5
If MyColorType = [Force Standard] Then
DrawRectangle 0, 0, Wi, He, m_OfficeXpFrameColor, True
DrawRectangle 1, 1, Wi - 2, He - 2, m_OfficeXpFillColor
SetTextColor .hdc, m_OfficeXpFrameColor
Else
DrawRectangle 0, 0, Wi, He, RGB(188, 188, 64), True
DrawRectangle 1, 1, Wi - 2, He - 2, RGB(238, 239, 208)
SetTextColor .hdc, RGB(188, 188, 64)
End If
If .TextWidth(m_Caption) <= Wi Then
DrawText .hdc, m_Caption, -1, Rc, DT_CENTERABS
Else
NumLine = (.TextWidth(m_Caption) \ Wi) + 1
Rc.Top = (He - .TextHeight(m_Caption) * NumLine) \ 2
DrawText .hdc, m_Caption, -1, Rc, DT_CENTER Or DT_WORDBREAK '
End If
End Select
End If
End With
'restore focus value
hasFocus = preFocusValue
End Sub
Private Sub DrawRectangle(ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Color As Long, Optional OnlyBorder As Boolean = False)
'this is my custom function to draw rectangles and frames
'it's faster and smoother than using the line method
Dim bRect As RECT
Dim hBrush As Long
Dim Ret As Long
bRect.Left = x
bRect.Top = y
bRect.Right = x + Width
bRect.Bottom = y + Height
hBrush = CreateSolidBrush(Color)
If OnlyBorder = False Then
Ret = FillRect(UserControl.hdc, bRect, hBrush)
Else
Ret = FrameRect(UserControl.hdc, bRect, hBrush)
End If
Ret = DeleteObject(hBrush)
End Sub
Private Sub DrawLine(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Color As Long)
'a fast way to draw lines
Dim pt As POINTAPI
UserControl.ForeColor = Color
MoveToEx UserControl.hdc, X1, Y1, pt
LineTo UserControl.hdc, X2, Y2
End Sub
Private Sub DrawJianBian(ByVal R As Long, ByVal G As Long, ByVal B As Long, ByVal Lower As Long, ByVal Uper As Long, ByVal Steper As Long)
Dim I As Integer
Dim rval As Single
Dim gval As Single
Dim bval As Single
rval = R
gval = G
bval = B
For I = Lower To Uper Step Steper
rval = rval + (255 - R) / (He - 5)
gval = gval + (255 - G) / (He - 5) '画XP渐变色
bval = bval + (255 - B) / (He - 5)
If rval > 255 Then rval = 255
If gval > 255 Then gval = 255
If bval > 255 Then bval = 255
DrawLine 1, I, Wi - 1, I, RGB(rval, gval, bval)
Next
End Sub
Private Sub DrawXPFrame(ByVal FrameColor As Long, ByVal PointColor As Long)
DrawLine 2, 0, Wi - 2, 0, FrameColor
DrawLine 2, He - 1, Wi - 2, He - 1, FrameColor
DrawLine 0, 2, 0, He - 2, FrameColor '画XP外框和字
DrawLine Wi - 1, 2, Wi - 1, He - 2, FrameColor
mSetPixel 1, 1, PointColor
mSetPixel 1, He - 2, PointColor
mSetPixel Wi - 2, 1, PointColor
mSetPixel Wi - 2, He - 2, PointColor
End Sub
Private Sub DrawMacOS(ByVal SaturatedColor As Long, ByVal FrameColor As Long, ByVal TingeColor As Long, ByVal mPercent As Integer, Optional isFill As Boolean = False)
'画Mac OS 形状
Dim I As Integer
Dim RedColor As Long, BlueColor As Long, GreenColor As Long
Dim RedColor1 As Long, BlueColor1 As Long, GreenColor1 As Long
Dim rval As Single, gval As Single, bval As Single
Dim Rcl As Single, Bcl As Single, Gcl As Single
Dim rval1 As Single, gval1 As Single, bval1 As Single
BlueColor1 = ((TingeColor \ &H10000) Mod &H100)
GreenColor1 = ((TingeColor \ &H100) Mod &H100)
RedColor1 = (TingeColor And &HFF)
BlueColor = ((SaturatedColor \ &H10000) Mod &H100)
GreenColor = ((SaturatedColor \ &H100) Mod &H100)
RedColor = (SaturatedColor And &HFF)
If isFill = False Then
rval = RedColor
gval = GreenColor
bval = BlueColor
Bcl = (BlueColor1 - BlueColor) / (He * mPercent / 100 - 1)
Gcl = (GreenColor1 - GreenColor) / (He * mPercent / 100 - 1)
Rcl = (RedColor1 - RedColor) / (He * mPercent / 100 - 1)
For I = He * mPercent / 100 To 1 Step -1
DrawLine 1, I, Wi - 1, I, RGB(rval, gval, bval)
rval = rval + Rcl
gval = gval + Gcl
bval = bval + Bcl
If rval > 255 Then rval = 255
If rval < 0 Then rval = 0
If gval > 255 Then gval = 255
If gval < 0 Then gval = 0
If bval > 255 Then bval = 255
If bval < 0 Then bval = 0
Next
rval = rval - 2 * Rcl: rval1 = rval - 3 * Rcl
gval = gval - 2 * Gcl: gval1 = gval - 3 * Gcl
bval = bval - 2 * Bcl: bval1 = bval - 3 * Bcl
For I = 0 To Wi - 4
rval = 255 - I * (255 - RedColor1) \ (Wi - 10)
gval = 255 - I * (255 - GreenColor1) \ (Wi - 10) '画一条渐变亮色线
bval = 255 - I * (255 - BlueColor1) \ (Wi - 10)
If rval < 0 Then rval = 0
If gval < 0 Then gval = 0
If bval < 0 Then bval = 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -