chameleonbutton.ctl

基于vb网络编程。有类似QQ的功能

Public Property Get Font() As Font
Set Font = TextFont
End Property

Public Property Set Font(ByRef newFont As Font)
Set TextFont = newFont
Set UserControl.Font = TextFont
Call Redraw(0, True)
PropertyChanged "FONT"
End Property

'is very common that a windows user uses custom color
'schemes to view his/her desktop, and is also very
'common that this color scheme has weird colors that
'would alter the nice look of my buttons.
'So if you want to force the button to use the windows
'standard colors you may change this property to "Force Standard"

'UPDATE!!!
'you may now use your custom colors to display the button!!!

Public Property Get ColorScheme() As ColorTypes
ColorScheme = MyColorType
End Property

Public Property Let ColorScheme(ByVal newValue As ColorTypes)
MyColorType = newValue
Call SetColors
Call Redraw(0, True)
PropertyChanged "COLTYPE"
End Property

Public Property Get ShowFocusRect() As Boolean
ShowFocusRect = showFocusR
End Property

Public Property Let ShowFocusRect(ByVal newValue As Boolean)
showFocusR = newValue
Call Redraw(lastStat, True)
PropertyChanged "FOCUSR"
End Property


Public Property Get hwnd() As Long
    hwnd = UserControl.hwnd
End Property

'########## 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, -1, 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, -1, 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, -1, 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, -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
'            Case 5 'Java
 '               .FontBold = True
 '               DrawRectangle 1, 1, Wi - 1, He - 1, ShiftColor(cFace, &HC)
 '               DrawText .hdc, elTex, -1, 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 5 'Netscape
                DrawText .hdc, elTex, -1, 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 6 'Flat
                DrawText .hdc, elTex, -1, 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, -1, 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, -1, 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, -1, 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, -1, 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)