candybutton.ctl

支持监控包括传输控制协议和 UDP 的所有的互联网传输协议。同时程序具有实时文件防修改监控功能

                                              ByVal Y2 As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, _
                                               ByVal X1 As Long, _
                                               ByVal Y1 As Long, _
                                               ByVal X2 As Long, _
                                               ByVal Y2 As Long) As Long
Private Declare Function IsRectEmpty Lib "user32" (lpRect As RECT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
                                                   ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, _
                                                ByVal nWidth As Long, _
                                                ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, _
                                                lpRect As RECT, _
                                                ByVal hBrush As Long) As Long
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, _
                                                       ByVal hWnd As Long, _
                                                       ByVal Msg As Long, _
                                                       ByVal wParam As Long, _
                                                       ByVal lParam As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
                                                        ByVal lpProcName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, _
                                                                lpdwProcessId As Long) As Long
Private Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, _
                                                      ByVal nIndex As Long, _
                                                      ByVal dwNewLong As Long) As Long
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, _
                                                      ByVal dwSize As Long, _
                                                      ByVal flAllocationType As Long, _
                                                      ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, _
                                                     ByVal dwSize As Long, _
                                                     ByVal dwFreeType As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal Destination As Long, _
                                                  ByVal Source As Long, _
                                                  ByVal Length As Long)
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
Private Declare Function TrackMouseEventComCtl Lib "Comctl32" Alias "_TrackMouseEvent" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
Public Function BlendColors(ByRef Color1 As Long, _
                            ByRef Color2 As Long, _
                            ByRef Percentage As Long) As Long
Dim r(2) As Long
Dim g(2) As Long
Dim b(2) As Long
    Percentage = SetBound(Percentage, 0, 100)
    GetRGB r(0), g(0), b(0), Color1
    GetRGB r(1), g(1), b(1), Color2
    r(2) = r(0) + (r(1) - r(0)) * Percentage \ 100
    g(2) = g(0) + (g(1) - g(0)) * Percentage \ 100
    b(2) = b(0) + (b(1) - b(0)) * Percentage \ 100
    BlendColors = RGB(r(2), g(2), b(2))
End Function
Public Property Get BorderBrightness() As Long
    BorderBrightness = m_BorderBrightness
End Property
Public Property Let BorderBrightness(NewValue As Long)
    m_BorderBrightness = SetBound(NewValue, -100, 100)
    PropertyChanged "m_BorderBrightness"
    DrawButton (eNormal)
End Property
Public Property Get Caption() As String
    Caption = m_Caption
End Property
Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    PropertyChanged "Caption"
    DrawButton (eNormal)
End Property
'/*** enable caption mouse over highliting
Public Property Get CaptionHighLite() As Boolean
    CaptionHighLite = m_bCaptionHighLite
End Property
Public Property Let CaptionHighLite(PropVal As Boolean)
    m_bCaptionHighLite = PropVal
    PropertyChanged "CaptionHighLite"
End Property
Public Property Get CaptionHighLiteColor() As OLE_COLOR
    CaptionHighLiteColor = m_lCaptionHighLiteColor
End Property
Public Property Let CaptionHighLiteColor(PropVal As OLE_COLOR)
    m_lCaptionHighLiteColor = PropVal
    PropertyChanged "CaptionHighLiteColor"
End Property
Public Property Get Checked() As Boolean
    Checked = m_Checked
End Property
Public Property Let Checked(Value As Boolean)
    m_Checked = Value
    If Value Then
        DrawButton (eChecked)
    Else
        If IsHover Then
            DrawButton (eHover)
        Else
            DrawButton (eNormal)
        End If
    End If
    PropertyChanged "Checked"
End Property
Public Property Get ColorBright() As OLE_COLOR
    ColorBright = m_ColorBright
End Property
Public Property Let ColorBright(NewValue As OLE_COLOR)
    m_ColorBright = NewValue
    If m_ColorScheme <> Custom Then
        m_ColorScheme = Custom
        PropertyChanged "m_ColorScheme"
    End If
    PropertyChanged "m_ColorBright"
    DrawButton (eNormal)
End Property
Public Property Get ColorButtonDown() As OLE_COLOR
    ColorButtonDown = m_ColorButtonDown
End Property
Public Property Let ColorButtonDown(NewValue As OLE_COLOR)
    m_ColorButtonDown = NewValue
    If m_ColorScheme <> Custom Then
        m_ColorScheme = Custom
        PropertyChanged "m_ColorScheme"
    End If
    PropertyChanged "m_ColorButtonDown"
    DrawButton (eNormal)
End Property
Public Property Get ColorButtonHover() As OLE_COLOR
    ColorButtonHover = m_ColorButtonHover
End Property
Public Property Let ColorButtonHover(NewValue As OLE_COLOR)
    m_ColorButtonHover = NewValue
    If m_ColorScheme <> Custom Then
        m_ColorScheme = Custom
        PropertyChanged "m_ColorScheme"
    End If
    PropertyChanged "m_ColorButtonHover"
    DrawButton (eNormal)
End Property
Public Property Get ColorButtonUp() As OLE_COLOR
    ColorButtonUp = m_ColorButtonUp
End Property
Public Property Let ColorButtonUp(NewValue As OLE_COLOR)
    m_ColorButtonUp = NewValue
    If m_ColorScheme <> Custom Then
        m_ColorScheme = Custom
        PropertyChanged "m_ColorScheme"
    End If
    PropertyChanged "m_ColorButtonUp"
    DrawButton (eNormal)
End Property
Public Property Get ColorScheme() As eColorScheme
    ColorScheme = m_ColorScheme
End Property
Public Property Let ColorScheme(NewValue As eColorScheme)
    Select Case NewValue
    Case Aqua
        ColorButtonUp = &HD06720
        ColorButtonHover = &HE99950
        ColorButtonDown = &HA06710
        ColorBright = &HFFEDB0
    Case WMP10
        ColorButtonUp = &HD09060
        ColorButtonHover = &HE06000
        ColorButtonDown = &HA98050
        ColorBright = &HFFFAFA
    Case DeepBlue
        ColorButtonUp = &H800000
        ColorButtonHover = &HA00000
        ColorButtonDown = &HF00000
        ColorBright = &HFF0000
    Case DeepRed
        ColorButtonUp = &H80&
        ColorButtonHover = &HA0&
        ColorButtonDown = &HF0&
        ColorBright = &HFF&
    Case DeepGreen
        ColorButtonUp = &H8000&
        ColorButtonHover = &HA000&
        ColorButtonDown = &HC000&
        ColorBright = &HFF00&
    Case DeepYellow
        ColorButtonUp = &H8080&
        ColorButtonHover = &HA0A0&
        ColorButtonDown = &HC0C0&
        ColorBright = &HFFFF&
    End Select
    m_ColorScheme = NewValue
    PropertyChanged "m_ColorScheme"
    DrawButton (eNormal)
End Property
'/----------------------------------------------------------------------------------/
'/                                                                                  /
'/ CreateRoundedRegion                                                              /
'/ -------------------                                                              /
'/ Description:                                                                     /
'/                                                                                  /
'/ CreateRoundedRegion returns a rounded region based on a given Width, Height      /
'/ and a CornerRadius. We will use this function instead of normal CreateRoundRect  /
'/ because this will give us a better rounded rectangle for our purposes.           /
'/----------------------------------------------------------------------------------/
Private Function CreateRoundedRegion(X As Long, _
                                     Y As Long, _
                                     lWidth As Long, _
                                     lHeight As Long, _
                                     Radius As Long) As Long
Dim i    As Long
Dim j    As Long
Dim i2   As Long
Dim j2   As Long
Dim i3   As Long
Dim j3   As Long
Dim hRgn As Long
    CornerRadius = Radius
    If CornerRadius < 1 Then
        CornerRadius = 1
    End If
'/* Create initial region
    hRgn = CreateRectRgn(0, 0, X + lWidth, Y + lHeight)
    For j = 0 To Y + lHeight
        For i = 0 To (X + lWidth) \ 2
            If Not IsInRoundRect(i, j, X, Y, lWidth, lHeight, CornerRadius) Then
'/* substract the pixels outside of the rounded rectangle
'/* (it doesn't exclude the border)
                If Not j = j2 Then
'*** If 2 * i2 <> Width Then i2 = i2 + 1
                    ExcludePixelsFromRegion hRgn, X + lWidth - i2, j2, lWidth - i, j
                    If Not 2 * i2 = X + lWidth Then
                        i2 = i2 + 1
                    End If
                    ExcludePixelsFromRegion hRgn, i, j, i2, j2
                End If
                i2 = i
                j2 = j
            End If
        Next i
    Next j
    CreateRoundedRegion = hRgn
End Function
Public Property Get DisplayHand() As Boolean
    DisplayHand = m_DisplayHand
End Property
Public Property Let DisplayHand(NewValue As Boolean)
    m_DisplayHand = NewValue
End Property
Private Sub DrawButton(vState As eState)
    If m_Checked Then
        vState = eChecked
    End If
    If m_InitCompleted Then
        Select Case m_Style
        Case XP_Button
            DrawXPButton vState
        Case Crystal, Mac, WMP, Mac_Variation, Iceblock
            DrawCrystalButton vState
        Case Plastic
            DrawPlasticButton vState
        Case XP_ToolBarButton
            DrawXPToolbarButton vState
        End Select
        DrawIconWCaption vState
    End If
End Sub
Private Sub DrawCrystal(lWidth As Long, _
                        lHeight As Long, _
                        ByVal Color As Long, _
                        CrystalParam As tCrystalParam)
Dim i              As Long
Dim j              As Long
Dim ptColor        As Long
Dim ColorBright    As Long
Dim RGXPercent     As Single
Dim RGYPercent     As Single
Dim RadialGradient As Long
Dim hHlRgn         As Long
Dim Bordercolor    As Long
Dim nBrush         As Long
Dim ClientRct      As RECT
    If CornerRadius < 1 Then
        CornerRadius = 1
    End If
    ColorBright = m_ColorBright
'In Disabled state Color = 11583680 (light gray)
'and ColorBright = vbWhite
    If Not m_bEnabled Then
        Color = 11583680
        ColorBright = vbWhite
    End If
    RGYPercent = (100 - CrystalParam.RadialGYPercent) / (lHeight * 2)
    RGXPercent = (100 - CrystalParam.RadialGXPercent) / lWidth
    If m_BorderBrightness >= 0 Then
        Bordercolor = BlendColors(Color, vbWhite, m_BorderBrightness)
    Else
        Bordercolor = BlendColors(Color, vbBlack, -m_BorderBrightness)
    End If
'Create Highlite region (hHlRgn), we will use PtInRegion to
'check if we are inside the highlite Rounded rectangle