?? chameleonbutton.ctl
字號:
'########## END OF PROPERTIES ##########
Private Sub UserControl_Resize()
He = UserControl.ScaleHeight
Wi = UserControl.ScaleWidth
rc.Bottom = He: rc.Right = Wi
rc2.Bottom = He: rc2.Right = Wi
rc3.left = 4: rc3.Top = 4: rc3.Right = Wi - 4: rc3.Bottom = He - 4
DeleteObject rgnNorm
Call MakeRegion
SetWindowRgn UserControl.hWnd, rgnNorm, True
Call Redraw(0, True)
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
MyButtonType = PropBag.ReadProperty("BTYPE", 2)
elTex = PropBag.ReadProperty("TX", "")
isEnabled = PropBag.ReadProperty("ENAB", True)
Set TextFont = PropBag.ReadProperty("FONT", UserControl.font)
MyColorType = PropBag.ReadProperty("COLTYPE", 1)
showFocusR = PropBag.ReadProperty("FOCUSR", True)
BackC = PropBag.ReadProperty("BCOL", GetSysColor(COLOR_BTNFACE))
ForeC = PropBag.ReadProperty("FCOL", GetSysColor(COLOR_BTNTEXT))
UserControl.Enabled = isEnabled
Set UserControl.font = TextFont
Call SetColors
Call SetAccessKeys
Call Redraw(0, True)
End Sub
Private Sub UserControl_Terminate()
DeleteObject rgnNorm
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("BTYPE", MyButtonType)
Call PropBag.WriteProperty("TX", elTex)
Call PropBag.WriteProperty("ENAB", isEnabled)
Call PropBag.WriteProperty("FONT", TextFont)
Call PropBag.WriteProperty("COLTYPE", MyColorType)
Call PropBag.WriteProperty("FOCUSR", showFocusR)
Call PropBag.WriteProperty("BCOL", BackC)
Call PropBag.WriteProperty("FCOL", ForeC)
End Sub
Private Sub Redraw(ByVal curStat As Byte, ByVal Force As Boolean)
'here is the CORE of the button, everything is drawn here
'it's not well commented but i think that everything is
'pretty self explanatory...
If Force = False Then 'check drawing redundancy
If (curStat = lastStat) And (TE = elTex) Then Exit Sub
End If
If He = 0 Then Exit Sub 'we don't want errors
lastStat = curStat
TE = elTex
Dim i As Long, stepXP1 As Single, XPface As Long
Dim preFocusValue As Boolean
preFocusValue = hasFocus 'save this value to restore it later
If hasFocus = True Then hasFocus = ShowFocusRect
With UserControl
.Cls
DrawRectangle 0, 0, Wi, He, cFace
If isEnabled = True Then
SetTextColor .hdc, cText 'restore font color
If curStat = 0 Then
'#@#@#@#@#@# BUTTON NORMAL STATE #@#@#@#@#@#
Select Case MyButtonType
Case 1 'Windows 16-bit
DrawText .hdc, elTex, Len(elTex), rc, DT_CENTERABS
DrawLine 1, 0, Wi - 1, 0, cDarkShadow
DrawLine 1, He - 1, Wi - 1, He - 1, cDarkShadow
DrawLine 0, 1, 0, He - 1, cDarkShadow
DrawLine Wi - 1, 1, Wi - 1, He - 1, cDarkShadow
DrawRectangle 1, 1, Wi - 2, He - 2, cHighLight, True
DrawRectangle 2, 2, Wi - 4, He - 4, cHighLight, True
DrawLine Wi - 2, 1, Wi - 2, He - 1, cShadow
DrawLine Wi - 3, 2, Wi - 3, He - 1, cShadow
DrawLine 1, He - 2, Wi - 1, He - 2, cShadow
DrawLine 2, He - 3, Wi - 2, He - 3, cShadow
If hasFocus = True Then DrawFocusR
Case 2 'Windows 32-bit
DrawText .hdc, elTex, Len(elTex), rc, DT_CENTERABS
If (Ambient.DisplayAsDefault = True) And (showFocusR = True) Then
DrawRectangle 1, 1, Wi - 2, He - 2, cHighLight, True
DrawRectangle 2, 2, Wi - 4, He - 4, cLight, True
DrawLine Wi - 2, 1, Wi - 2, He - 1, cDarkShadow
DrawLine Wi - 3, 2, Wi - 3, He - 1, cShadow
DrawLine 1, He - 2, Wi - 1, He - 2, cDarkShadow
DrawLine 2, He - 3, Wi - 2, He - 3, cShadow
If hasFocus = True Then DrawFocusR
DrawRectangle 0, 0, Wi, He, cDarkShadow, True
Else
DrawRectangle 0, 0, Wi - 1, He - 1, cHighLight, True
DrawRectangle 1, 1, Wi - 2, He - 2, cLight, True
DrawLine Wi - 1, 0, Wi - 1, He, cDarkShadow
DrawLine Wi - 2, 1, Wi - 2, He - 1, cShadow
DrawLine 0, He - 1, Wi - 1, He - 1, cDarkShadow
DrawLine 1, He - 2, Wi - 2, He - 2, cShadow
End If
Case 3 'Windows XP
stepXP1 = 25 / He
XPface = ShiftColor(cFace, &H30, True)
For i = 1 To He
DrawLine 0, i, Wi, i, ShiftColor(XPface, -stepXP1 * i, True)
Next
SetTextColor UserControl.hdc, cText
DrawText .hdc, elTex, Len(elTex), rc, DT_CENTERABS
DrawLine 2, 0, Wi - 2, 0, &H733C00
DrawLine 2, He - 1, Wi - 2, He - 1, &H733C00
DrawLine 0, 2, 0, He - 2, &H733C00
DrawLine Wi - 1, 2, Wi - 1, He - 2, &H733C00
mSetPixel 1, 1, &H7B4D10
mSetPixel 1, He - 2, &H7B4D10
mSetPixel Wi - 2, 1, &H7B4D10
mSetPixel Wi - 2, He - 2, &H7B4D10
If (hasFocus = True) Or ((Ambient.DisplayAsDefault = True) And (showFocusR = True)) Then
DrawRectangle 1, 2, Wi - 2, He - 4, &HE7AE8C, True
DrawLine 2, He - 2, Wi - 2, He - 2, &HEF826B
DrawLine 2, 1, Wi - 2, 1, &HFFE7CE
DrawLine 1, 2, Wi - 1, 2, &HF7D7BD
DrawLine 2, 3, 2, He - 3, &HF0D1B5
DrawLine Wi - 3, 3, Wi - 3, He - 3, &HF0D1B5
Else 'we do not draw the bevel always because the above code would repaint over it
DrawLine 2, He - 2, Wi - 2, He - 2, ShiftColor(XPface, -&H30, True)
DrawLine 1, He - 3, Wi - 2, He - 3, ShiftColor(XPface, -&H20, True)
DrawLine Wi - 2, 2, Wi - 2, He - 2, ShiftColor(XPface, -&H24, True)
DrawLine Wi - 3, 3, Wi - 3, He - 3, ShiftColor(XPface, -&H18, True)
DrawLine 2, 1, Wi - 2, 1, ShiftColor(XPface, &H10, True)
DrawLine 1, 2, Wi - 2, 2, ShiftColor(XPface, &HA, True)
DrawLine 1, 2, 1, He - 2, ShiftColor(XPface, -&H5, True)
DrawLine 2, 3, 2, He - 3, ShiftColor(XPface, -&HA, True)
End If
Case 4 'Mac
DrawRectangle 1, 1, Wi - 2, He - 2, cLight
DrawText .hdc, elTex, Len(elTex), 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
Case 5 'Java
.FontBold = True
DrawRectangle 1, 1, Wi - 1, He - 1, ShiftColor(cFace, &HC)
DrawText .hdc, elTex, Len(elTex), rc, DT_CENTERABS
DrawRectangle 1, 1, Wi - 1, He - 1, cHighLight, True
DrawRectangle 0, 0, Wi - 1, He - 1, ShiftColor(cShadow, -&H1A), True
mSetPixel 1, He - 2, ShiftColor(cShadow, &H1A)
mSetPixel Wi - 2, 1, ShiftColor(cShadow, &H1A)
If hasFocus = True Then DrawRectangle (Wi - UserControl.TextWidth(elTex)) \ 2 - 3, (He - UserControl.TextHeight(elTex)) \ 2 - 1, UserControl.TextWidth(elTex) + 6, UserControl.TextHeight(elTex) + 2, &HCC9999, True
.FontBold = TextFont.Bold
Case 6 'Netscape
DrawText .hdc, elTex, Len(elTex), rc, DT_CENTERABS
DrawRectangle 0, 0, Wi, He, ShiftColor(cLight, &H8), True
DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cLight, &H8), True
DrawLine Wi - 1, 0, Wi - 1, He, cShadow
DrawLine Wi - 2, 1, Wi - 2, He - 1, cShadow
DrawLine 0, He - 1, Wi, He - 1, cShadow
DrawLine 1, He - 2, Wi - 1, He - 2, cShadow
If hasFocus = True Then DrawFocusR
Case 7 'Flat
DrawText .hdc, elTex, Len(elTex), rc, DT_CENTERABS
DrawRectangle 0, 0, Wi, He, cHighLight, True
DrawLine Wi - 1, 0, Wi - 1, He, cShadow
DrawLine 0, He - 1, Wi, He - 1, cShadow
If hasFocus = True Then DrawFocusR
End Select
ElseIf curStat = 2 Then
'#@#@#@#@#@# BUTTON IS DOWN #@#@#@#@#@#
Select Case MyButtonType
Case 1 'Windows 16-bit
DrawText .hdc, elTex, Len(elTex), rc2, DT_CENTERABS
DrawLine 1, 0, Wi - 1, 0, cDarkShadow
DrawLine 1, He - 1, Wi - 1, He - 1, cDarkShadow
DrawLine 0, 1, 0, He - 1, cDarkShadow
DrawLine Wi - 1, 1, Wi - 1, He - 1, cDarkShadow
DrawRectangle 1, 1, Wi - 2, He - 2, cShadow, True
DrawRectangle 2, 2, Wi - 4, He - 4, cShadow, True
DrawLine Wi - 2, 1, Wi - 2, He - 1, cHighLight
DrawLine Wi - 3, 2, Wi - 3, He - 1, cHighLight
DrawLine 1, He - 2, Wi - 1, He - 2, cHighLight
DrawLine 2, He - 3, Wi - 2, He - 3, cHighLight
If hasFocus = True Then DrawFocusR
Case 2 'Windows 32-bit
DrawText .hdc, elTex, Len(elTex), rc2, DT_CENTERABS
If showFocusR = True Then
DrawRectangle 0, 0, Wi, He, cDarkShadow, True
DrawRectangle 1, 1, Wi - 2, He - 2, cShadow, True
If hasFocus = True Then DrawFocusR
Else
DrawRectangle 0, 0, Wi - 1, He - 1, cDarkShadow, True
DrawRectangle 1, 1, Wi - 2, He - 2, cShadow, True
DrawLine Wi - 1, 0, Wi - 1, He, cHighLight
DrawLine Wi - 2, 1, Wi - 2, He - 1, cLight
DrawLine 0, He - 1, Wi - 1, He - 1, cHighLight
DrawLine 1, He - 2, Wi - 2, He - 2, cLight
End If
Case 3 'Windows XP
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
SetTextColor .hdc, cText
DrawText .hdc, elTex, Len(elTex), rc2, DT_CENTERABS
DrawLine 2, 0, Wi - 2, 0, &H733C00
DrawLine 2, He - 1, Wi - 2, He - 1, &H733C00
DrawLine 0, 2, 0, He - 2, &H733C00
DrawLine Wi - 1, 2, Wi - 1, He - 2, &H733C00
mSetPixel 1, 1, &H7B4D10
mSetPixel 1, He - 2, &H7B4D10
mSetPixel Wi - 2, 1, &H7B4D10
mSetPixel Wi - 2, He - 2, &H7B4D10
DrawLine 2, He - 2, Wi - 2, He - 2, ShiftColor(XPface, &H10, True)
DrawLine 1, He - 3, Wi - 2, He - 3, ShiftColor(XPface, &HA, True)
DrawLine Wi - 2, 2, Wi - 2, He - 2, ShiftColor(XPface, &H5, True)
DrawLine Wi - 3, 3, Wi - 3, He - 3, XPface
DrawLine 2, 1, Wi - 2, 1, ShiftColor(XPface, -&H20, True)
DrawLine 1, 2, Wi - 2, 2, ShiftColor(XPface, -&H18, True)
DrawLine 1, 2, 1, He - 2, ShiftColor(XPface, -&H20, True)
DrawLine 2, 2, 2, He - 2, ShiftColor(XPface, -&H16, True)
' DrawRectangle 1, 2, Wi - 2, He - 4, &H31B2FF, True
' DrawLine 2, He - 2,Wi - 2, He - 2, &H96E7&
' DrawLine 2, 1,Wi - 2, 1, &HCEF3FF
' DrawLine 1, 2,Wi - 1, 2, &H8CDBFF
' DrawLine 2, 3,2, He - 3, &H6BCBFF
' DrawLine Wi - 3, 3,Wi - 3, He - 3, &H6BCBFF
Case 4 'Mac
DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cShadow, -&H10)
SetTextColor .hdc, cLight
DrawText .hdc, elTex, Len(elTex), rc2, 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
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)
Case 5 'Java
.FontBold = True
DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cShadow, &H10), False
DrawRectangle 0, 0, Wi - 1, He - 1, ShiftColor(cShadow, -&H1A), True
DrawLine Wi - 1, 1, Wi - 1, He, cHighLight
DrawLine 1, He - 1, Wi - 1, He - 1, cHighLight
DrawText .hdc, elTex, Len(elTex), rc, DT_CENTERABS
If hasFocus = True Then DrawRectangle (Wi - UserControl.TextWidth(elTex)) \ 2 - 3, (He - UserControl.TextHeight(elTex)) \ 2 - 1, UserControl.TextWidth(elTex) + 6, UserControl.TextHeight(elTex) + 2, &HCC9999, True
.FontBold = TextFont.Bold
Case 6 'Netscape
DrawText .hdc, elTex, Len(elTex), rc2, DT_CENTERABS
DrawRectangle 0, 0, Wi, He, cShadow, True
DrawRectangle 1, 1, Wi - 2, He - 2, cShadow, True
DrawLine Wi - 1, 0, Wi - 1, He, ShiftColor(cLight, &H8)
DrawLine Wi - 2, 1, Wi - 2, He - 1, ShiftColor(cLight, &H8)
DrawLine 0, He - 1, Wi, He - 1, ShiftColor(cLight, &H8)
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -