candybutton.ctl

simple supermarket for beginners

End Sub

Private Sub UserControl_EnterFocus()
    m_hasFocus = True
    If Not m_bEnabled Then Exit Sub
    If Not m_Checked And Not IsHover Then DrawButton (eFocus)
End Sub

Private Sub UserControl_ExitFocus()
    m_hasFocus = False
    If Not m_bEnabled Then Exit Sub
    If Not m_Checked Then DrawButton (eNormal)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
        .WriteProperty "Enabled", m_bEnabled, True
        .WriteProperty "Font", UserControl.Font, Ambient.Font
        .WriteProperty "Caption", m_Caption, UserControl.Name
        .WriteProperty "IconHighLite", m_bIconHighLite, False
        .WriteProperty "IconHighLiteColor", m_lIconHighLiteColor, &HFF00&
        .WriteProperty "CaptionHighLite", m_bCaptionHighLite, False
        .WriteProperty "CaptionHighLiteColor", m_lCaptionHighLiteColor, &HFF00&
        .WriteProperty "ForeColor", m_ForeColor, m_def_ForeColor
        .WriteProperty "Picture", m_StdPicture, Nothing
        .WriteProperty "PictureAlignment", m_PictureAlignment, m_def_PictureAlignment
        .WriteProperty "Style", m_Style, 0
        .WriteProperty "Checked", m_Checked
        .WriteProperty "ColorButtonHover", m_ColorButtonHover
        .WriteProperty "ColorButtonUp", m_ColorButtonUp
        .WriteProperty "ColorButtonDown", m_ColorButtonDown
        .WriteProperty "BorderBrightness", m_BorderBrightness
        .WriteProperty "ColorBright", m_ColorBright
        .WriteProperty "DisplayHand", m_DisplayHand
        .WriteProperty "ColorScheme", m_ColorScheme
    End With
End Sub

Private Sub UserControl_Resize()
    Init_Style
    DrawButton (eNormal)
End Sub

Private Sub UserControl_Show()
    Init_Style
    DrawButton (eNormal)
End Sub

Private Sub DrawButton(vState As eState)
    If m_Checked Then vState = eChecked
    If m_InitCompleted Then
        UserControl.Picture = LoadPicture("")
        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

Public Sub DrawIconWCaption(vState As eState)
    Dim pW As Long, pH As Long, lW As Long, lH As Long
    Dim StartX As Long, StartY As Long, lBrush As Long, lFlags As Long
    Dim lTemp As Long, XCoord As Long, 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(m_Caption) Then
        lW = TextWidth(m_Caption)
        lH = TextHeight(m_Caption)
    End If
    
    Select Case m_PictureAlignment
        Case Is = 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 Is = 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 Is = PIC_LEFT
            If CornerRadius Then StartX = CornerRadius Else StartX = 8
            StartY = (ScaleHeight - pH) \ 2 + 1
            XCoord = Abs(ScaleWidth \ 2 - lW \ 2)
            YCoord = Abs(ScaleHeight \ 2 - lH \ 2)
        Case Is = PIC_RIGHT
            If CornerRadius Then StartX = ScaleWidth - CornerRadius - pW Else StartX = ScaleWidth - 8 - pW
            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
    
    If vState = eHover And m_bCaptionHighLite Then
        lTemp = UserControl.ForeColor
        UserControl.ForeColor = m_lCaptionHighLiteColor
    End If
    If LenB(m_Caption) Then Call DrawStateText(hdc, 0&, 0&, m_Caption, Len(m_Caption), _
               XCoord, YCoord, 0&, 0&, lFlags)
    'Return the old forecolor state
    If vState = eHover And m_bCaptionHighLite Then UserControl.ForeColor = lTemp
    
    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
    
    UserControl.Refresh
End Sub

Private Function DrawXPToolbarButton(vState As eState)
Dim i As Long
Dim r1 As Long, g1 As Long, b1 As Long
Dim r2 As Long, g2 As Long, b2 As Long
Dim uH As Long, uW As Long
    uH = ScaleHeight - 1
    uW = ScaleWidth - 1
    On Error Resume Next
        Line (0, 0)-(uW, uH), Parent.BackColor, BF
    On Error GoTo 0
    If vState = ePressed Then
        r1 = 220: g1 = 218: b1 = 209
        r2 = 231: g2 = 230: b2 = 224
        For i = 0 To 3
            Line (0, 1 + i)-(uW, 1 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
        Next
        r1 = 231: g1 = 230: b1 = 224
        r2 = 225: g2 = 224: b2 = 216
        For i = 4 To uH - 4
            Line (0, i)-(uW, i), RGB(r2 * (i / (uH - 6)) + r1 - (r1 * (i / (uH - 6))), g2 * (i / (uH - 6)) + g1 - (g1 * (i / (uH - 6))), b2 * (i / (uH - 6)) + b1 - (b1 * (i / (uH - 6))))
        Next
        r1 = 225: g1 = 224: b1 = 216
        r2 = 235: g2 = 234: b2 = 229
        For i = 0 To 3
            Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
        Next
        PSet (1, 0), RGB(215, 215, 204): PSet (0, 1), RGB(215, 215, 204)
        Line (0, 2)-(2, 0), RGB(179, 179, 168) '7617536
        Line (2, 0)-(uW - 2, 0), RGB(157, 157, 146)
        PSet (uW - 1, 0), RGB(215, 215, 204): PSet (uW, 1), RGB(215, 215, 204)
        Line (uW - 2, 0)-(uW, 2), RGB(179, 179, 168) '7617536
        Line (uW, 2)-(uW, uH - 2), RGB(157, 157, 146)
        PSet (uW, uH - 1), RGB(215, 215, 204): PSet (uW - 1, uH), RGB(215, 215, 204)
        Line (uW, uH - 2)-(uW - 2, uH), RGB(179, 179, 168) ' 7617536
        Line (uW - 2, uH)-(2, uH), RGB(157, 157, 146)
        PSet (1, uH), RGB(215, 215, 204): PSet (0, uH - 1), RGB(215, 215, 204)
        Line (2, uH)-(0, uH - 2), RGB(179, 179, 168) '7617536
        Line (0, uH - 2)-(0, 2), RGB(157, 157, 146)
    ElseIf vState = eHover Then
        r1 = 254: g1 = 254: b1 = 253
        r2 = 252: g2 = 252: b2 = 249
        For i = 0 To 3
            Line (0, 1 + i)-(uW, 1 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
        Next
        r1 = 252: g1 = 252: b1 = 249
        r2 = 238: g2 = 237: b2 = 229
        For i = 4 To uH - 4
            Line (0, i)-(uW, i), RGB(r2 * (i / (uH - 6)) + r1 - (r1 * (i / (uH - 6))), g2 * (i / (uH - 6)) + g1 - (g1 * (i / (uH - 6))), b2 * (i / (uH - 6)) + b1 - (b1 * (i / (uH - 6))))
        Next
        r1 = 238: g1 = 237: b1 = 229
        r2 = 215: g2 = 210: b2 = 198
        For i = 0 To 3
            Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
        Next
        
        PSet (1, 0), RGB(232, 232, 221): PSet (0, 1), RGB(232, 232, 221)
        Line (0, 2)-(2, 0), RGB(216, 216, 205) '7617536
        Line (2, 0)-(uW - 2, 0), RGB(206, 206, 195)
        PSet (uW - 1, 0), RGB(232, 232, 221): PSet (uW, 1), RGB(232, 232, 221)
        Line (uW - 2, 0)-(uW, 2), RGB(216, 216, 205) '7617536
        Line (uW, 2)-(uW, uH - 2), RGB(206, 206, 195)
        PSet (uW, uH - 1), RGB(232, 232, 221): PSet (uW - 1, uH), RGB(232, 232, 221)
        Line (uW, uH - 2)-(uW - 2, uH), RGB(216, 216, 205) ' 7617536
        Line (uW - 2, uH)-(2, uH), RGB(206, 206, 195)
        PSet (1, uH), RGB(232, 232, 221): PSet (0, uH - 1), RGB(232, 232, 221)
        Line (2, uH)-(0, uH - 2), RGB(216, 216, 205) '7617536
        Line (0, uH - 2)-(0, 2), RGB(206, 206, 195)
    ElseIf vState = eChecked Then
        Line (1, 1)-(uW - 1, uH - 1), vbWhite, BF
        PSet (1, 0), RGB(203, 213, 214): PSet (0, 1), RGB(203, 213, 214)
        Line (0, 2)-(2, 0), RGB(152, 175, 190) '7617536
        Line (2, 0)-(uW - 2, 0), RGB(122, 152, 175)
        PSet (uW - 1, 0), RGB(203, 213, 214): PSet (uW, 1), RGB(203, 213, 214)
        Line (uW - 2, 0)-(uW, 2), RGB(152, 175, 190) '7617536
        Line (uW, 2)-(uW, uH - 2), RGB(122, 152, 175)
        PSet (uW, uH - 1), RGB(203, 213, 214): PSet (uW - 1, uH), RGB(203, 213, 214)
        Line (uW, uH - 2)-(uW - 2, uH), RGB(152, 175, 190) ' 7617536
        Line (uW - 2, uH)-(2, uH), RGB(122, 152, 175)
        PSet (1, uH), RGB(203, 213, 214): PSet (0, uH - 1), RGB(203, 213, 214)
        Line (2, uH)-(0, uH - 2), RGB(152, 175, 190) '7617536
        Line (0, uH - 2)-(0, 2), RGB(122, 152, 175)
    End If
End Function

Private Function DrawXPButton(vState As eState)
Dim i As Long
Dim r1 As Long, g1 As Long, b1 As Long
Dim r2 As Long, g2 As Long, b2 As Long
Dim uH As Long, uW As Long
    uH = ScaleHeight - 1
    uW = ScaleWidth - 1
    On Error Resume Next
        Line (0, 0)-(uW, uH), Parent.BackColor, BF
    On Error GoTo 0
    If vState = ePressed Then
        r1 = 209: g1 = 204: b1 = 193
        r2 = 229: g2 = 228: b2 = 221
        For i = 0 To 3
            Line (0, 1 + i)-(uW, 1 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
        Next
        r1 = 229: g1 = 228: b1 = 221
        r2 = 226: g2 = 226: b2 = 218
        For i = 4 To uH - 4
            Line (0, i)-(uW, i), RGB(r2 * (i / (uH - 6)) + r1 - (r1 * (i / (uH - 6))), g2 * (i / (uH - 6)) + g1 - (g1 * (i / (uH - 6))), b2 * (i / (uH - 6)) + b1 - (b1 * (i / (uH - 6))))
        Next
        r1 = 226: g1 = 226: b1 = 218
        r2 = 242: g2 = 241: b2 = 238
        For i = 0 To 4
            Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
        Next
    Else
        r1 = 236: g1 = 235: b1 = 230
        r2 = 214: g2 = 208: b2 = 197
        For i = 0 To uH - 3
            Line (1, i)-(uW, i), RGB(r1 * (i / (uH - 3)) + 255 - (255 * (i / (uH - 3))), g1 * (i / (uH - 3)) + 255 - (255 * (i / (uH - 3))), b1 * (i / (uH - 3)) + 255 - (255 * (i / (uH - 3))))
        Next
    
        For i = 0 To 3
            Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
        Next
    End If
    
    Select Case vState
        Case Is = eFocus
            Line (0, 1)-(uW, 1), RGB(206, 231, 255)
            Line (0, 2)-(uW, 2), RGB(188, 212, 246)
            r1 = 188: g1 = 212: b1 = 246
            r2 = 137: g2 = 173: b2 = 228
            For i = 3 To uH - 3
                Line (0, i)-(3, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
                Line (uW - 2, i)-(uW, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
            Next
            Line (0, uH - 2)-(uW, uH - 2), RGB(137, 173, 228)
            Line (0, uH - 1)-(uW, uH - 1), RGB(105, 130, 238)
        Case Is = eHover
            Line (0, 1)-(uW, 1), RGB(255, 240, 202)
            Line (0, 2)-(uW, 2), RGB(253, 216, 137)
            r1 = 253: g1 = 216: b1 = 137
            r2 = 248: g2 = 178: b2 = 48
            For i = 3 To uH - 3
                Line (0, i)-(3, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
                Line (uW - 2, i)-(uW, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
            Next
            Line (0, uH - 2)-(uW, uH - 2), RGB(248, 178, 48)
            Line (0, uH - 1)-(uW, uH - 1), RGB(229, 151, 0)
    End Select
    
    PSet (0, 1), RGB(122, 149, 168): PSet (1, 0), RGB(122, 149, 168)
    Line (0, 2)-(2, 0), RGB(37, 87, 131) '7617536
    Line (2, 0)-(uW - 2, 0), 7617536