candybutton.ctl

simple supermarket for beginners

    PSet (uW - 1, 0), RGB(122, 149, 168): PSet (uW, 1), RGB(122, 149, 168)
    Line (uW - 2, 0)-(uW, 2), RGB(37, 87, 131)  '7617536
    Line (uW, 2)-(uW, uH - 2), 7617536
    PSet (uW, uH - 1), RGB(122, 149, 168): PSet (uW - 1, uH), RGB(122, 149, 168)
    Line (uW, uH - 2)-(uW - 2, uH), RGB(37, 87, 131) ' 7617536
    Line (uW - 2, uH)-(2, uH), 7617536
    PSet (1, uH), RGB(122, 149, 168): PSet (0, uH - 1), RGB(122, 149, 168)
    Line (2, uH)-(0, uH - 2), RGB(37, 87, 131)  '7617536
    Line (0, uH - 2)-(0, 2), 7617536
End Function

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
        CrystalParam.RadialGOffsetX = ScaleWidth / 2
        CrystalParam.RadialGOffsetY = ScaleHeight
        CrystalParam.RadialGIntensity = 130
    ElseIf m_Style = WMP Then 'WMP
        CrystalParam.Ref_Intensity = 40
        CrystalParam.Ref_Left = -CornerRadius \ 2 - 1
        CrystalParam.Ref_Top = -CornerRadius
        CrystalParam.Ref_Height = (CornerRadius) + 1
        CrystalParam.Ref_Width = ScaleWidth + 2 * CornerRadius
        CrystalParam.Ref_Radius = CornerRadius
        CrystalParam.RadialGXPercent = 60
        CrystalParam.RadialGYPercent = 60
        CrystalParam.RadialGOffsetX = ScaleWidth / 2
        CrystalParam.RadialGOffsetY = ScaleHeight
        CrystalParam.RadialGIntensity = 130
    ElseIf m_Style = Mac_Variation Then
        CrystalParam.Ref_Intensity = 70
        CrystalParam.Ref_Left = (CornerRadius \ 3) - 1
        CrystalParam.Ref_Height = CornerRadius
        CrystalParam.Ref_Width = ScaleWidth + 2 * CornerRadius
        'CrystalParam.Ref_Top = 0
        CrystalParam.Ref_Radius = (CornerRadius \ 2)
        CrystalParam.RadialGXPercent = 200
        CrystalParam.RadialGYPercent = 70
        CrystalParam.RadialGOffsetX = ScaleWidth / 2
        CrystalParam.RadialGOffsetY = ScaleHeight
        CrystalParam.RadialGIntensity = 130
    ElseIf m_Style = Crystal Then
        CrystalParam.Ref_Intensity = 50
        CrystalParam.Ref_Left = CornerRadius \ 2
        CrystalParam.Ref_Height = CornerRadius * 1.1
        CrystalParam.Ref_Width = ScaleWidth + 2 * CornerRadius
        CrystalParam.Ref_Top = 1
        CrystalParam.Ref_Radius = CornerRadius \ 2
        CrystalParam.RadialGXPercent = 300
        CrystalParam.RadialGYPercent = 60
        CrystalParam.RadialGOffsetX = ScaleWidth / 2
        CrystalParam.RadialGOffsetY = ScaleHeight
        CrystalParam.RadialGIntensity = 120
    ElseIf m_Style = Iceblock Then
        CrystalParam.Ref_Intensity = 50
        CrystalParam.Ref_Left = CornerRadius / 2
        CrystalParam.Ref_Top = 2
        CrystalParam.Ref_Height = CornerRadius + 1
        CrystalParam.Ref_Width = ScaleWidth - CornerRadius
        CrystalParam.Ref_Radius = CornerRadius / 2
        CrystalParam.RadialGXPercent = 60
        CrystalParam.RadialGYPercent = 60
        CrystalParam.RadialGOffsetX = ScaleWidth / 2
        CrystalParam.RadialGOffsetY = ScaleHeight / 2
        CrystalParam.RadialGIntensity = 100
    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 DrawCrystal(lWidth As Long, lHeight As Long, ByVal Color As Long, CrystalParam As tCrystalParam)
Dim i As Long, j As Long, ptColor As Long, ColorBright As Long
Dim RGXPercent As Single, RGYPercent As Single, RadialGradient As Long
Dim hHlRgn As Long, Bordercolor As Long, nBrush As Long, ClientRct As RECT
    
    If CornerRadius < 1 Then CornerRadius = 1
    ColorBright = m_ColorBright
    'In Disabled state Color = 11583680 (light gray)
    'and ColorBright = vbWhite
    If Not m_bEnabled Then Color = 11583680: ColorBright = vbWhite
    
    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
    '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 Sub DrawElipse(lhDC As Long, CrystalParam As tCrystalParam, lWidth, lHeight, FromColor As Long, ToColor As Long)
Dim oldBrush As Long, newBrush As Long, newPen As Long, oldPen As Long
Dim incX As Single, incY As Single, RadX As Long, RadY As Long
Dim klr As Long, rc As RECT
    klr = 1
    RadX = CrystalParam.RadialGXPercent * lWidth / 100
    RadY = CrystalParam.RadialGYPercent * lHeight / 100
    SetRect rc, CrystalParam.RadialGOffsetX - RadX, CrystalParam.RadialGOffsetY - RadY, _
                CrystalParam.RadialGOffsetX + RadX, CrystalParam.RadialGOffsetY + RadY
    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

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 Sub DrawPlastic(X As Long, Y As Long, lWidth As Long, lHeight As Long, Color As Long)
Dim i As Long, j As Long, HighlightColor As Long, ShadowColor As Long
Dim ptColor As Long, 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

'/----------------------------------------------------------------------------------/
'/                                                                                  /
'/ Init_Style                                                                       /
'/ -------------------                                                              /
'/ Description:                                                                     /
'/                                                                                  /
'/ Init_Style will create the window region according to the button style           /
'/ and will be responsible of storing the same region (but without the border)      /
'/ in hButtonRegion. This will be used later to determine if a point                /
'/ is inside the button region.                                                     /
'/----------------------------------------------------------------------------------/
Private Sub Init_Style()
Dim lCornerRad As Long
    'Remove the older Region
    If hButtonRegion Then DeleteObject hButtonRegion
    Select Case m_Style
        Case Crystal, WMP, Mac_Variation
            lCornerRad = SetBound(ScaleHeight \ 2 + 1, 1, ScaleWidth \ 2)
        Case Mac
            lCornerRad = 12
        Case Iceblock
            lCornerRad = SetBound(ScaleHeight \ 4 + 1, 1, ScaleWidth \ 4)
        Case Plastic
            lCornerRad = SetBound(ScaleHeight \ 3, 1, ScaleWidth \ 3)
    End Select

    If m_Style = Crystal Or m_Style = WMP Or m_Style = Mac Or _
        m_Style = Mac_Variation Or m_Style = Plastic Or m_Style = Iceblock Then
        hButtonRegion = CreateRoundedRegion(0, 0, ScaleWidth, ScaleHeight, lCornerRad)
        
        'Set the Button Region
        Call SetWindowRgn(hWnd, hButtonRegion, True)
        DeleteObject hButtonRegion
        'Store the region but exclude the border
        hButtonRegion = CreateRoundedRegion(1, 1, ScaleWidth - 2, ScaleHeight - 2, lCornerRad)
    Else
        Call SetWindowRgn(hWnd, 0, True)
    End If
End Sub

'/----------------------------------------------------------------------------------/
'/                                                                                  /
'/ 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, j As Long, i2 As Long, j2 As Long, i3 As Long, j3 As Long
Dim hRgn As Long
    CornerRadius = Radius
    If CornerRadius < 1 Then CornerRadius = 1
    '/* 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

Private Sub ExcludePixelsFromRegion(hRgn As Long, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long)
    Dim hRgnTemp As Long
    hRgnTemp = CreateRectRgn(X1, Y1, X2, Y2)
    CombineRgn hRgn, hRgn, hRgnTemp, RGN_XOR
    DeleteObject hRgnTemp
End Sub