candybutton.ctl

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

'you could simply use IsInRoundRect(i ,j ,CrystalParam.Ref_Left, CrystalParam.Ref_Top, CrystalParam.Ref_Width, CrystalParam.Ref_Height, CrystalParam.Ref_Radius * 2, CrystalParam.Ref_Radius * 2)
'instead of PtInRegion and remove these lines, but will be slower.
    hHlRgn = CreateRoundRectRgn(CrystalParam.Ref_Left, CrystalParam.Ref_Top, CrystalParam.Ref_Width, CrystalParam.Ref_Height, CrystalParam.Ref_Radius * 2, CrystalParam.Ref_Radius * 2)
'Paint the Background Color
    SetRect ClientRct, 0, 0, lWidth, lHeight
    nBrush = CreateSolidBrush(Color)
    FillRect hdc, ClientRct, nBrush
    DeleteObject nBrush
'Draw a radial Gradient
    DrawElipse hdc, CrystalParam, lWidth, lHeight, Color, ColorBright
    For j = 0 To lHeight
        For i = 0 To lWidth \ 2
            If PtInRegion(hButtonRegion, i, j) Then
'We are inside the button
                If PtInRegion(hHlRgn, i, j) Then
                    ptColor = BlendColors(vbWhite, Color, CrystalParam.Ref_MixColorFrom + j * CrystalParam.Ref_Intensity \ CornerRadius)
                    Line (i, j)-(lWidth - i + 1, j), ptColor
                    i = 0
                    j = j + 1
                End If
            Else
'this draw a thin border
                SetPixelV hdc, i, j, Bordercolor
                SetPixelV hdc, lWidth - i, j, Bordercolor
            End If
        Next i
    Next j
    DeleteObject hHlRgn
End Sub
Private Function DrawCrystalButton(vState As eState)
Dim CrystalParam As tCrystalParam
    If m_Style = Mac Then 'Mac
'CrystalParam.Ref_MixColorFrom = 0 '20
        CrystalParam.Ref_Intensity = 70 '50
        CrystalParam.Ref_Left = (CornerRadius \ 3)
'CrystalParam.Ref_Top = 0
        CrystalParam.Ref_Height = 12 'CornerRadius - 2
        CrystalParam.Ref_Width = ScaleWidth + 2 * CornerRadius
        CrystalParam.Ref_Radius = 10 'CornerRadius \ 2
        CrystalParam.RadialGXPercent = 200
        CrystalParam.RadialGYPercent = 100 - (7 * 100 \ ScaleHeight)
        If CrystalParam.RadialGYPercent > 80 Then
            CrystalParam.RadialGYPercent = 80
        End If
        With CrystalParam
            .RadialGOffsetX = ScaleWidth / 2
            .RadialGOffsetY = ScaleHeight
            .RadialGIntensity = 130
        End With 'CrystalParam
    ElseIf m_Style = WMP Then 'WMP
        With CrystalParam
            .Ref_Intensity = 40
            .Ref_Left = -CornerRadius \ 2 - 1
            .Ref_Top = -CornerRadius
            .Ref_Height = (CornerRadius) + 1
            .Ref_Width = ScaleWidth + 2 * CornerRadius
            .Ref_Radius = CornerRadius
            .RadialGXPercent = 60
            .RadialGYPercent = 60
            .RadialGOffsetX = ScaleWidth / 2
            .RadialGOffsetY = ScaleHeight
            .RadialGIntensity = 130
        End With 'CrystalParam
    ElseIf m_Style = Mac_Variation Then
        With CrystalParam
            .Ref_Intensity = 70
            .Ref_Left = (CornerRadius \ 3) - 1
            .Ref_Height = CornerRadius
            .Ref_Width = ScaleWidth + 2 * CornerRadius
'CrystalParam.Ref_Top = 0
            .Ref_Radius = (CornerRadius \ 2)
            .RadialGXPercent = 200
            .RadialGYPercent = 70
            .RadialGOffsetX = ScaleWidth / 2
            .RadialGOffsetY = ScaleHeight
            .RadialGIntensity = 130
        End With 'CrystalParam
    ElseIf m_Style = Crystal Then
        With CrystalParam
            .Ref_Intensity = 50
            .Ref_Left = CornerRadius \ 2
            .Ref_Height = CornerRadius * 1.1
            .Ref_Width = ScaleWidth + 2 * CornerRadius
            .Ref_Top = 1
            .Ref_Radius = CornerRadius \ 2
            .RadialGXPercent = 300
            .RadialGYPercent = 60
            .RadialGOffsetX = ScaleWidth / 2
            .RadialGOffsetY = ScaleHeight
            .RadialGIntensity = 120
        End With 'CrystalParam
    ElseIf m_Style = Iceblock Then
        With CrystalParam
            .Ref_Intensity = 50
            .Ref_Left = CornerRadius / 2
            .Ref_Top = 2
            .Ref_Height = CornerRadius + 1
            .Ref_Width = ScaleWidth - CornerRadius
            .Ref_Radius = CornerRadius / 2
            .RadialGXPercent = 60
            .RadialGYPercent = 60
            .RadialGOffsetX = ScaleWidth / 2
            .RadialGOffsetY = ScaleHeight / 2
            .RadialGIntensity = 100
        End With 'CrystalParam
    End If
    Select Case vState
    Case eHover
        DrawCrystal ScaleWidth, ScaleHeight, m_ColorButtonHover, CrystalParam
    Case ePressed, eChecked
        DrawCrystal ScaleWidth, ScaleHeight, ColorButtonDown, CrystalParam
    Case eNormal, eFocus
        DrawCrystal ScaleWidth, ScaleHeight, m_ColorButtonUp, CrystalParam
    End Select
End Function
Private Sub DrawElipse(lhDC As Long, _
                       CrystalParam As tCrystalParam, _
                       lWidth, _
                       lHeight, _
                       FromColor As Long, _
                       ToColor As Long)
Dim oldBrush As Long
Dim newBrush As Long
Dim newPen   As Long
Dim oldPen   As Long
Dim incX     As Single
Dim incY     As Single
Dim RadX     As Long
Dim RadY     As Long
Dim klr      As Long
Dim rc       As RECT
    klr = 1
    With CrystalParam
        RadX = .RadialGXPercent * lWidth / 100
        RadY = .RadialGYPercent * lHeight / 100
        SetRect rc, .RadialGOffsetX - RadX, .RadialGOffsetY - RadY, .RadialGOffsetX + RadX, .RadialGOffsetY + RadY
    End With 'CrystalParam
    incX = 1: incY = 1
    If RadX > RadY Then
        incX = (RadX / RadY)
    Else
        incY = (RadY / RadX)
    End If
    newBrush = CreateSolidBrush(FromColor)
    oldBrush = SelectObject(lhDC, newBrush)
    newPen = CreatePen(5, 0, FromColor)
    oldPen = SelectObject(lhDC, newPen)
    Do Until Not IsRectEmpty(rc) = 0
        Ellipse lhDC, rc.Left, rc.Top, rc.Right, rc.Bottom
        InflateRect rc, -incX, -incY
        klr = klr + 1
        newBrush = CreateSolidBrush(BlendColors(FromColor, ToColor, klr * CrystalParam.RadialGIntensity / RadY))
        DeleteObject SelectObject(lhDC, newBrush)
    Loop
    DeleteObject SelectObject(lhDC, oldBrush)
    DeleteObject SelectObject(lhDC, oldPen)
End Sub
Public Sub DrawIconWCaption(vState As eState)
Dim pW     As Long
Dim pH     As Long
Dim lW     As Long
Dim lH     As Long
Dim StartX As Long
Dim StartY As Long
Dim lBrush As Long
Dim lFlags As Long
Dim lTemp  As Long
Dim XCoord As Long
Dim YCoord As Long
    If Not m_StdPicture Is Nothing Then
        pW = ScaleX(m_StdPicture.Width, vbHimetric, vbPixels)
        pH = ScaleY(m_StdPicture.Height, vbHimetric, vbPixels)
    End If
    If LenB(StrConv(m_Caption, vbFromUnicode)) Then
        lW = TextWidth(m_Caption)
        lH = TextHeight(m_Caption)
    End If
    Select Case m_PictureAlignment
    Case PIC_TOP
        StartX = ((ScaleWidth - pW) \ 2) + 1
        StartY = (ScaleHeight - (pH + lH)) \ 2 + 1
        XCoord = Abs(ScaleWidth \ 2 - lW \ 2)
        YCoord = Abs(ScaleHeight \ 2 + pH \ 2 - lH \ 2)
    Case PIC_BOTTOM
        StartX = (ScaleWidth - pW) \ 2
        StartY = (ScaleHeight - (pH - lH)) \ 2 + 1
        XCoord = Abs(ScaleWidth \ 2 - lW \ 2)
        YCoord = Abs(ScaleHeight \ 2 - (pH + lH) \ 2)
    Case PIC_LEFT
        If CornerRadius Then
            StartX = CornerRadius
        Else
            StartX = 8
        End If
        StartY = (ScaleHeight - pH) \ 2 + 1
        XCoord = Abs(ScaleWidth \ 2 - lW \ 2)
        YCoord = Abs(ScaleHeight \ 2 - lH \ 2)
    Case PIC_RIGHT
        If CornerRadius Then
            StartX = ScaleWidth - CornerRadius - pW
        Else
            StartX = ScaleWidth - 8 - pW
        End If
        StartY = (ScaleHeight - pH) \ 2 + 1
        XCoord = Abs(ScaleWidth \ 2 - lW \ 2)
        YCoord = Abs(ScaleHeight \ 2 - lH \ 2)
    End Select
    If vState = ePressed Then
        StartX = StartX + 1
        XCoord = XCoord + 1
        StartY = StartY + 1
        YCoord = YCoord + 1
    End If
    If m_bEnabled Then
        lFlags = DST_PREFIXTEXT Or DSS_NORMAL
    Else
        lFlags = DST_PREFIXTEXT Or DSS_DISABLED
    End If
    If vState = eHover And m_bCaptionHighLite Then
        lTemp = UserControl.ForeColor
        UserControl.ForeColor = m_lCaptionHighLiteColor
    End If
    If LenB(StrConv(m_Caption, vbFromUnicode)) Then
        Call DrawStateText(hdc, 0&, 0&, m_Caption, LenB(StrConv(m_Caption, vbFromUnicode)), XCoord, YCoord, 0&, 0&, lFlags)
    End If
'Return the old forecolor state
    If vState = eHover And m_bCaptionHighLite Then
        UserControl.ForeColor = lTemp
    End If
    If Not m_StdPicture Is Nothing Then
        If m_StdPicture.Type = vbPicTypeBitmap Then
            lFlags = DST_BITMAP
        ElseIf m_StdPicture.Type = vbPicTypeIcon Then
            lFlags = DST_ICON
        End If
        If Not m_bEnabled Then
            lFlags = lFlags Or DSS_DISABLED 'Draw disabled
        ElseIf vState = eHover And m_bIconHighLite Then
            lBrush = CreateSolidBrush(m_lIconHighLiteColor)
            lFlags = lFlags Or DSS_MONO 'Draw highlighted
        End If
        With m_StdPicture
            DrawState hdc, lBrush, 0, .Handle, 0, CLng(StartX), CLng(StartY), .Width, .Height, lFlags
        End With
'm_StdPicture.Render Usercontrol.hDC, CLng(StartX), CLng(StartY), CLng(pW), CLng(pH),
'0, m_StdPicture.Height, m_StdPicture.Width, -m_StdPicture.Height, ByVal 0&
        If vState = eHover And m_bIconHighLite Then
            DeleteObject lBrush
        End If
    End If
    UserControl.Refresh
End Sub
Private Sub DrawPlastic(X As Long, _
                        Y As Long, _
                        lWidth As Long, _
                        lHeight As Long, _
                        Color As Long)
Dim i              As Long
Dim j              As Long
Dim HighlightColor As Long
Dim ShadowColor    As Long
Dim ptColor        As Long
Dim LinearGPercent As Long
    ShadowColor = BlendColors(vbBlack, Color, 50)
    For j = 0 To lHeight
        If j < CornerRadius Then
            HighlightColor = BlendColors(vbWhite, Color, j * 30 \ CornerRadius)
        End If
        LinearGPercent = Abs((2 * j - lHeight) * 100 \ lHeight)
        For i = 0 To lWidth \ 2
            If IsInRoundRect(i, j, 1, 1, lWidth - 2, lHeight - 2, CornerRadius) Then
'Drawing the button properly
                If IsInRoundRect(i, j, 4, 2, lWidth - CornerRadius, 2 * CornerRadius - 1, 2 * CornerRadius \ 3) And Not IsInRoundRect(i, j, 4, CornerRadius \ 2, lWidth - CornerRadius, 2 * CornerRadius - 1, 2 * CornerRadius \ 3) Then
                    ptColor = HighlightColor 'draw reflected highlight
                Else
                    ptColor = BlendColors(Color, m_ColorBright, LinearGPercent)
                End If
                SetPixelV hdc, i, j, ptColor
                SetPixelV hdc, lWidth - i, j, ptColor
            ElseIf IsInRoundRect(i, j, 0, 0, lWidth, lHeight, CornerRadius) Then
'this draw a thin border
                SetPixelV hdc, i, j, ShadowColor
                SetPixelV hdc, lWidth - i, j, ShadowColor
            End If
        Next i
    Next j
End Sub
Private Function DrawPlasticButton(vState As eState)
    Select Case vState
    Case eHover
        DrawPlastic 0, 0, ScaleWidth - 1, ScaleHeight - 1, m_ColorButtonHover
    Case ePressed, eChecked
        DrawPlastic 0, 0, ScaleWidth - 1, ScaleHeight - 1, ColorButtonDown
    Case eNormal, eFocus
        DrawPlastic 0, 0, ScaleWidth - 1, ScaleHeight - 1, m_ColorButtonUp
    End Select
End Function
Private Function DrawXPButton(vState As eState)
Dim i  As Long
Dim r1 As Long