jcframes.ctl

simple supermarket for beginners

            m_GradientHeaderStyle = VerticalGradient: m_HeaderStyle = Gradient
            jcColorFromIni = RGB(192, 192, 192)
            jcColorToIni = RGB(51, 51, 51)
            jcColorBorderPicIni = RGB(51, 51, 51)
            If (Style = jcGradient) Or (Style = Messenger) Or (Style = Windows) Or (Style = TextBox) Then
                m_TextColor = RGB(235, 235, 235)
                m_FillColorIni = RGB(235, 235, 235) '=
                m_BackColor = RGB(235, 235, 235) '=
            End If
        Case 13 'xThemeDarkBlue2
            m_GradientHeaderStyle = VerticalGradient: m_HeaderStyle = Gradient
            jcColorFromIni = RGB(81, 128, 208)
            jcColorToIni = dBlendColor(RGB(11, 63, 153), vbBlack, 230)
            jcColorBorderPicIni = RGB(0, 45, 150)
            If (Style = jcGradient) Or (Style = Messenger) Or (Style = Windows) Or (Style = TextBox) Then
                m_TextColor = vbRed
                m_FillColorIni = RGB(142, 179, 231) '=
                m_BackColor = RGB(142, 179, 231) '=
            End If
        Case 14 'xThemeMoney
            m_GradientHeaderStyle = VerticalGradient: m_HeaderStyle = Gradient
            jcColorFromIni = RGB(160, 160, 160)
            jcColorToIni = dBlendColor(RGB(90, 90, 90), vbBlack, 230)
            jcColorBorderPicIni = RGB(68, 68, 68)
            If (Style = jcGradient) Or (Style = Messenger) Or (Style = Windows) Or (Style = TextBox) Then
                m_TextColor = vbWhite
                m_FillColorIni = RGB(112, 112, 112) '=
                m_BackColor = RGB(112, 112, 112) '=
            End If
        Case 15 'xThemeOffice2003Style1
            m_GradientHeaderStyle = VerticalGradient: m_HeaderStyle = Gradient
            jcColorFromIni = RGB(209, 227, 251)
            jcColorToIni = RGB(106, 140, 203)
            jcColorBorderPicIni = RGB(0, 0, 128)
            If (Style = jcGradient) Or (Style = Messenger) Or (Style = Windows) Or (Style = TextBox) Then
                m_TextColor = RGB(110, 109, 143)
                m_FillColorIni = RGB(255, 255, 255) '=
                m_BackColor = RGB(255, 255, 255) '=
            End If
        Case Else
            jcColorFromIni = RGB(153, 151, 180)
            jcColorToIni = RGB(244, 244, 251)
            jcColorBorderPicIni = RGB(75, 75, 111)
    End Select
End Sub


Public Property Get dBlendColor(ByVal oColorFrom As OLE_COLOR, ByVal oColorTo As OLE_COLOR, Optional ByVal Alpha As Long = 128) As Long

    Dim lSrcR As Long

    Dim lSrcG As Long
    Dim lSrcB As Long
    Dim lDstR As Long
    Dim lDstG As Long
    Dim lDstB As Long
    Dim lCFrom As Long
    Dim lCTo As Long
    lCFrom = TranslateColor(oColorFrom)
    lCTo = TranslateColor(oColorTo)
    lSrcR = lCFrom And &HFF
    lSrcG = (lCFrom And &HFF00&) \ &H100&
    lSrcB = (lCFrom And &HFF0000) \ &H10000
    lDstR = lCTo And &HFF
    lDstG = (lCTo And &HFF00&) \ &H100&
    lDstB = (lCTo And &HFF0000) \ &H10000
    dBlendColor = RGB(((lSrcR * Alpha) / 255) + ((lDstR * (255 - Alpha)) / 255), ((lSrcG * Alpha) / 255) + ((lDstG * (255 - Alpha)) / 255), ((lSrcB * Alpha) / 255) + ((lDstB * (255 - Alpha)) / 255))

End Property


'==================
' Main drawing sub
'==================
Private Sub PaintFrame()
    Dim R As RECT, R_Caption As RECT, Rc As RECT
    Dim iX As Integer, iY As Integer
    
    m_Height = 3
    m_Indentation = 15
    m_Space = 6
    iX = 0
    iY = 0
    EraseRegion
    
    'Clear user control
    UserControl.Cls
    
    'Set caption height and width
    If Len(m_Caption) <> 0 Then
        m_TextWidth = UserControl.TextWidth(m_Caption)
        m_TextHeight = UserControl.TextHeight(m_Caption)
        jcTextBoxCenter = m_TextHeight / 2
    Else
        jcTextBoxCenter = 0
    End If
    
    'Select colors according to enabled property
    If m_Enabled = False Then
        m_FrameColor = m_FrameColorDis
        m_TextBoxColor = m_TextBoxColorDis
        m_FillColor = m_FillColorDis
        jcColorTo = jcColorToDis
        jcColorFrom = jcColorFromDis
        jcColorBorderPic = jcColorBorderPicDis
    Else
        m_FrameColor = m_FrameColorIni
        m_TextBoxColor = m_TextBoxColorIni
        m_FillColor = m_FillColorIni
        jcColorTo = jcColorToIni
        jcColorFrom = jcColorFromIni
        jcColorBorderPic = jcColorBorderPicIni
    End If
  
    'select frame style
    Select Case m_style
        Case Is = XPDefault
            Draw_XPDefault R_Caption
        Case Is = jcGradient
            Draw_jcGradient R_Caption, iY
        Case Is = TextBox
            Draw_TextBox R_Caption, iX, iY
        Case Is = Windows
            Draw_Windows R_Caption, iY
        Case Is = Messenger
            Draw_Messenger R_Caption, iY
        Case Is = InnerWedge
            Draw_InnerWedge R_Caption, iY
        Case Is = OuterWedge
            Draw_OuterWedge R_Caption, iY
        Case Is = Header
            Draw_Header R_Caption
        Case Is = Panel
            Draw_Panel R_Caption, iY
        Case Else
            Draw_jcGradient R_Caption, iY
    End Select
    
    'caption and icon alignments
    If Not (m_icon Is Nothing Or m_style = XPDefault) Then
        If m_IconAlignment = vbLeftAligment Then
            If m_Alignment = vbLeftJustify Then
                R_Caption.left = R_Caption.left + m_Space + m_IconSize
            ElseIf m_Alignment = vbRightJustify Then
                R_Caption.left = R_Caption.left + m_Space + m_IconSize
            Else
                R_Caption.left = R_Caption.left + m_Space + m_IconSize
                R_Caption.Right = R_Caption.Right - (m_Space + m_IconSize)
            End If
            If m_style = TextBox Then
                iX = m_Indentation + m_Space * 2
            Else
                iX = m_Space
            End If
        ElseIf m_IconAlignment = vbRightAligment Then
            If m_Alignment = vbLeftJustify Then
                R_Caption.Right = R_Caption.Right - (m_Space + m_IconSize)
            ElseIf m_Alignment = vbRightJustify Then
                R_Caption.Right = R_Caption.Right - (m_Space + m_IconSize)
            Else
                R_Caption.left = R_Caption.left + m_Space + m_IconSize
                R_Caption.Right = R_Caption.Right - (m_Space + m_IconSize)
            End If
            If m_style = TextBox Then
                iX = UserControl.ScaleWidth - m_Space * 2 - m_IconSize - m_Indentation
            Else
                iX = UserControl.ScaleWidth - m_Space - m_IconSize
            End If
        End If
    End If

    'Draw caption
    If Len(m_Caption) <> 0 Then
        'Set text color
        Dim m_caption_aux As String
        m_caption_aux = TrimWord(m_Caption, R_Caption.Right - R_Caption.left)
        
        'Draw text
        UserControl.ForeColor = IIf(m_Enabled, m_TextColor, TranslateColor(TEXT_INACTIVE))
        
        If m_style = Panel Then
            CopyRect Rc, R_Caption
            DrawTextEx UserControl.hdc, m_Caption, Len(m_Caption), Rc, DT_CALCRECT Or DT_WORDBREAK, ByVal 0&
            OffsetRect Rc, (R_Caption.Right - Rc.Right) \ 2, (R_Caption.Bottom - Rc.Bottom) \ 2
            DrawTextEx UserControl.hdc, m_Caption, Len(m_Caption), Rc, jcTextDrawParams, ByVal 0&
        Else
            DrawTextEx UserControl.hdc, m_caption_aux, Len(m_caption_aux), R_Caption, jcTextDrawParams, ByVal 0&
        End If
        
    End If
    
    'draw picture
    If Not (m_icon Is Nothing Or m_style = XPDefault Or m_style = InnerWedge Or m_style = OuterWedge) Then
        If m_style = Messenger Then
            If iY < m_Height * 2 + 2 Then iY = m_Height * 2 + 2
        ElseIf m_style = jcGradient Then
            If iY < m_Height + 2 Then iY = m_Height + 2
        Else
            If iY < 0 Then iY = m_Space / 2
        End If
        
        If m_Enabled Then
            UserControl.PaintPicture m_icon, iX, iY, m_IconSize, m_IconSize
            'TransBlt UserControl.hDC, Ix, Iy, m_IconSize, m_IconSize, m_Icon, vbBlack, , , False, False
        Else
            TransBlt UserControl.hdc, iX, iY, m_IconSize, m_IconSize, m_icon, vbBlack, , , True, False
        End If
    End If
    
    Select Case m_style
        Case Messenger: iY = 5
        Case jcGradient: iY = 8
        Case XPDefault: iY = 6
        Case InnerWedge: iY = 11
        Case OuterWedge: iY = 11
        Case Windows: iY = 11
    End Select
    Label.Move UserControl.ScaleWidth - 30, CInt(ScaleY((ScaleY(m_TextBoxHeight, vbPixels, vbTwips) - Label.Height) / 2, vbTwips, vbPixels)) - iY
End Sub

Private Sub SetDefault()
    Select Case m_style
        Case Is = XPDefault
            m_TextColor = &HCF3603
            m_FrameColorIni = RGB(195, 195, 195)
            m_TextBoxColorIni = vbWhite
            m_TextBoxHeight = 22
            m_Alignment = vbLeftJustify
            m_FillColorIni = TranslateColor(Ambient.BackColor)
            SetjcTextDrawParams
        Case Is = jcGradient
            m_TextColor = vbBlack
            m_FrameColorIni = vbBlack
            m_TextBoxColorIni = vbWhite
            m_TextBoxHeight = 22
            m_Alignment = vbCenter
            m_ThemeColor = Blue
            SetjcTextDrawParams
        Case Is = TextBox
            m_TextColor = vbBlack
            m_FrameColorIni = &H6A6A6A
            m_TextBoxColorIni = &HB0EFF0
            m_TextBoxHeight = 22
            m_Alignment = vbCenter
            m_RoundedCornerTxtBox = True
            m_FillColorIni = TranslateColor(Ambient.BackColor)
            SetjcTextDrawParams
        Case Is = Windows
            m_TextColor = vbBlack
            m_FrameColorIni = vbBlack
            m_TextBoxColorIni = &HB0EFF0
            m_TextBoxHeight = 22
            m_Alignment = vbCenter
            m_RoundedCorner = True
            m_RoundedCornerTxtBox = False
            m_FillColorIni = &HE0FFFF
            m_GradientHeaderStyle = horizontalGradient
            m_HeaderStyle = TxtBoxColor
            SetjcTextDrawParams
        Case Is = Messenger
            m_TextColor = vbBlack
            m_FrameColorIni = vbBlack
            m_TextBoxColorIni = vbWhite
            m_TextBoxHeight = 22
            m_Alignment = vbCenter
            m_ThemeColor = Blue
            m_GradientHeaderStyle = VerticalGradient
            m_HeaderStyle = TxtBoxColor
            SetjcTextDrawParams
        Case Is = InnerWedge
            m_TextColor = vbWhite
            m_FrameColorIni = 192
            m_TextBoxColorIni = 192
            m_TextBoxHeight = 22
            m_Alignment = vbLeftJustify
            m_FillColorIni = TranslateColor(Ambient.BackColor)
            SetjcTextDrawParams
        Case Is = OuterWedge
            m_TextColor = vbWhite
            m_FrameColorIni = 10878976
            m_TextBoxColorIni = 10878976
            m_TextBoxHeight = 22
            m_Alignment = vbLeftJustify
            m_FillColorIni = TranslateColor(Ambient.BackColor)
            SetjcTextDrawParams
        Case Is = Header
            m_TextColor = &HCF3603
            m_FrameColorIni = RGB(195, 195, 195)
            m_TextBoxColorIni = vbWhite
            m_TextBoxHeight = 22
            m_Alignment = vbLeftJustify
            m_FillColorIni = TranslateColor(Ambient.BackColor)
            SetjcTextDrawParams
        Case Is = Panel
            m_TextColor = vbBlack
            m_FrameColorIni = vbBlack
            m_TextBoxColorIni = vbWhite
            m_TextBoxHeight = 22
            m_Alignment = vbCenter
            m_ThemeColor = Blue
            m_GradientHeaderStyle = VCilinderGradient
            m_HeaderStyle = Gradient
            SetjcTextDrawParams
    End Select
    
End Sub

Private Sub PaintShpInBar(iColorA As Long, iColorB As Long, m_Height As Long)
    Dim i As Integer, x_left As Integer, y_top As Integer, SpaceBtwnShp As Integer, NumShp As Integer
    Dim RectHeight As Long, RectWidth As Long, R As RECT

    SpaceBtwnShp = 2    'space between shapes
    NumShp = 9          'number of points
    RectHeight = 2      'shape height
    RectWidth = 2       'shape width
    
    'x and y shape  coordinates
    x_left = (UserControl.ScaleWidth - NumShp * RectWidth - (NumShp - 1) * SpaceBtwnShp) / 2
    y_top = (m_Height - RectHeight) / 2
    
    For i = 0 To NumShp - 1
        SetRect R, x_left + i * SpaceBtwnShp + i * RectWidth + 1, y_top + 1, 1, 1
        APIRectangle UserControl.hdc, R.left, R.tOp, R.Right, R.Bottom, iColorA
        SetRect R, x_left + i * SpaceBtwnShp + i * RectWidth, y_top, 1, 1
        APIRectangle UserControl.hdc, R.left, R.tOp, R.Right, R.Bottom, iColorB
    Next i
End Sub

Private Sub Draw_XPDefault(R_Caption As RECT)
    Dim p_left As Long, m_roundedRadius As Long, R As RECT, lpp As Point