jcframes.ctl

simple supermarket for beginners

    
    'Draw border rectangle
    SetRect R, 0&, jcTextBoxCenter, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1
    DrawAPIRoundRect m_RoundedCorner, 10&, m_FillColor, m_FrameColor, R

    If Len(m_Caption) <> 0 Then
        If m_Alignment = vbLeftJustify Then
            p_left = m_Indentation
        ElseIf m_Alignment = vbRightJustify Then
            p_left = UserControl.ScaleWidth - m_TextWidth - m_Indentation - m_Space - 1
        Else
            p_left = (UserControl.ScaleWidth - 1 - m_TextWidth) / 2
        End If

        'Draw a line
        APILineEx UserControl.hdc, p_left, jcTextBoxCenter, p_left + m_TextWidth + m_Space, jcTextBoxCenter, m_FillColor

        'set caption rect
        SetRect R_Caption, p_left + m_Space / 2, 0, m_TextWidth + p_left + m_Space / 2, m_TextHeight
    End If
End Sub

Private Sub Draw_jcGradient(R_Caption As RECT, iY As Integer)
    Dim R As RECT, m_roundedRadius As Long
    
    jcTextBoxCenter = m_TextBoxHeight / 2
    
    'Draw border rectangle
    SetRect R, 0&, jcTextBoxCenter, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1
    DrawAPIRoundRect m_RoundedCorner, 10&, BlendColors(jcColorFrom, vbWhite), IIf(m_ThemeColor = Custom, m_FrameColor, jcColorBorderPic), R

    'Draw header
    SetRect R, 0, 0, UserControl.ScaleWidth - 2, m_Height
    DrawGradientInRectangle UserControl.hdc, jcColorTo, jcColorFrom, R, VCilinderGradient, True, jcColorBorderPic
    
    If m_HeaderStyle = Gradient Then
         SetRect R, 0, m_Height, UserControl.ScaleWidth - 2, m_TextBoxHeight
         DrawGradientInRectangle UserControl.hdc, jcColorFrom, jcColorTo, R, m_GradientHeaderStyle, True, jcColorBorderPic
    Else
         SetRect R, 0, m_Height, UserControl.ScaleWidth - 1, m_TextBoxHeight + m_Height + 2
         DrawAPIRoundRect False, 0&, m_FillColor, m_FrameColor, R
    End If

    SetRect R, 0, m_Height + m_TextBoxHeight, UserControl.ScaleWidth - 2, m_Height
    DrawGradientInRectangle UserControl.hdc, jcColorTo, jcColorFrom, R, VCilinderGradient, True, jcColorBorderPic

    SetRect R, 1, m_Height * 2 + m_TextBoxHeight, UserControl.ScaleWidth - 3, UserControl.ScaleHeight - (2 + m_Height * 2 + m_TextBoxHeight) - UserControl.ScaleHeight * 0.2
    DrawGradientInRectangle UserControl.hdc, BlendColors(jcColorFrom, vbWhite), BlendColors(jcColorTo, vbWhite), R, VerticalGradient, False, m_TextBoxColor
    
    'set caption rect
    SetRect R_Caption, m_Space, m_Height + 1, UserControl.ScaleWidth - 2 - m_Space, m_TextBoxHeight + 2

    'set icon Y coordinate
    iY = (m_Height * 2 + m_TextBoxHeight - m_IconSize) / 2
End Sub

Private Sub Draw_TextBox(R_Caption As RECT, iX As Integer, iY As Integer)
     Dim m_roundedRadius As Long, R As RECT
     
     jcTextBoxCenter = m_TextBoxHeight / 2
     
     'Draw border rectangle
     SetRect R, 0&, jcTextBoxCenter, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1
     DrawAPIRoundRect m_RoundedCorner, 10&, m_FillColor, m_FrameColor, R

     'Draw textbox border rectangle
     If m_HeaderStyle = Gradient Then
         If m_TxtBoxShadow = Shadow Then
            SetRect R, m_Indentation, 0, UserControl.ScaleWidth - 1 - m_Indentation, m_TextBoxHeight
            OffsetRect R, 2, 2
            DrawAPIRoundRect False, m_TextBoxHeight, BlendColors(m_FillColor, &HA7A7A7), BlendColors(m_FillColor, &HA7A7A7), R
         End If
         SetRect R, m_Indentation, 0, UserControl.ScaleWidth - 2 - 2 * m_Indentation, m_TextBoxHeight - 1
         DrawGradientInRectangle UserControl.hdc, jcColorFrom, jcColorTo, R, m_GradientHeaderStyle, True, m_FrameColor ', 3.08
     Else
         SetRect R, m_Indentation, 0, UserControl.ScaleWidth - 1 - m_Indentation, m_TextBoxHeight
         If m_TxtBoxShadow = Shadow Then
            OffsetRect R, 2, 2
            DrawAPIRoundRect m_RoundedCornerTxtBox, m_TextBoxHeight, BlendColors(m_FillColor, &HA7A7A7), BlendColors(m_FillColor, &HA7A7A7), R
            OffsetRect R, -2, -2
         End If
         DrawAPIRoundRect m_RoundedCornerTxtBox, m_TextBoxHeight, m_TextBoxColor, m_FrameColor, R
     End If
    
     'set caption rect
     SetRect R_Caption, m_Indentation + m_Space * 1.5, 0, UserControl.ScaleWidth - 1 - m_Indentation - m_Space * 1.5, m_TextBoxHeight - 1
     
     'set icon coordinates
     iX = m_Indentation + m_Space * 2
     iY = (m_TextBoxHeight - m_IconSize) / 2

End Sub

Private Sub Draw_Windows(R_Caption As RECT, iY As Integer)
     Dim R As RECT, m_roundedRadius As Long
     
     jcTextBoxCenter = m_TextBoxHeight / 2
     
    'Draw border rectangle
    SetRect R, 0&, jcTextBoxCenter, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1
    DrawAPIRoundRect m_RoundedCorner, 10&, m_FillColor, m_FrameColor, R

    'Draw text box borders
    If m_HeaderStyle = Gradient Then
        SetRect R, 0&, 0&, UserControl.ScaleWidth - 2, m_TextBoxHeight - 1
        DrawGradientInRectangle UserControl.hdc, jcColorFrom, jcColorTo, R, m_GradientHeaderStyle, True, m_FrameColor ', 3.08
    Else
        SetRect R, 0&, 0&, UserControl.ScaleWidth - 1, m_TextBoxHeight
        DrawAPIRoundRect m_RoundedCornerTxtBox, 10&, m_TextBoxColor, m_FrameColor, R
    End If
     
    'set caption rect
    SetRect R_Caption, m_Space, 0, UserControl.ScaleWidth - m_Space, m_TextBoxHeight '- 1
     
    'set icon coordinates
    iY = (m_TextBoxHeight - m_IconSize) / 2
End Sub

Private Sub Draw_Messenger(R_Caption As RECT, iY As Integer)
    Dim R As RECT, m_roundedRadius As Long
    
    jcTextBoxCenter = 0
    
    'Draw border rectangle
    SetRect R, 0&, jcTextBoxCenter, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1
    DrawAPIRoundRect m_RoundedCorner, 10&, BlendColors(jcColorFrom, vbWhite), IIf(m_ThemeColor = Custom, m_FrameColor, jcColorBorderPic), R
    
    'Draw header
    SetRect R, 0, 0, UserControl.ScaleWidth - 2, m_Height * 2
    DrawGradientInRectangle UserControl.hdc, jcColorFrom, vbWhite, R, VerticalGradient, True, jcColorBorderPic, 2.01

    PaintShpInBar vbWhite, BlendColors(vbBlack, jcColorFrom), m_Height * 2

    If m_HeaderStyle = Gradient Or m_Enabled = False Then
        SetRect R, 0&, m_Height * 2, UserControl.ScaleWidth - 2, m_TextBoxHeight + 1
        DrawGradientInRectangle UserControl.hdc, jcColorFrom, jcColorTo, R, m_GradientHeaderStyle, True, jcColorBorderPic
    Else
        SetRect R, 0, m_Height * 2 + m_TextBoxHeight + 1, UserControl.ScaleWidth - 2, m_Height * 2 + m_TextBoxHeight + 1
        APILineEx UserControl.hdc, R.left, R.tOp, R.Right, R.Bottom, jcColorBorderPic 'vbBlack
    End If

    SetRect R, 1, 1 + m_Height * 2 + m_TextBoxHeight, UserControl.ScaleWidth - 3, UserControl.ScaleHeight - (2 + m_Height * 2 + m_TextBoxHeight) - UserControl.ScaleHeight * 0.2
    DrawGradientInRectangle UserControl.hdc, BlendColors(jcColorFrom, vbWhite), BlendColors(jcColorTo, vbWhite), R, VerticalGradient, False, m_TextBoxColor
    
    'set caption rect
    SetRect R_Caption, m_Space, m_Height * 2 + 2, UserControl.ScaleWidth - 1 - m_Space, m_TextBoxHeight + 6

    'set icon coordinates
    iY = m_Height * 2 + (m_TextBoxHeight - m_IconSize) / 2

End Sub

Private Sub Draw_InnerWedge(R_Caption As RECT, iY As Integer)
    Dim txtWidth As Integer, txtHeight As Integer, R As RECT
    Dim m_roundedRadius As Long, hFRgn As Long
    Dim poly(1 To 4) As Point, NumCoords As Long, hBrush As Long, hRgn As Long
    
    m_roundedRadius = IIf(m_RoundedCorner = False, 0&, 10&)

    txtWidth = m_TextWidth + 10
    If txtWidth < 100 Then txtWidth = 100
    txtHeight = m_TextHeight + 5
    NumCoords = 4
    
    SetRect R, 0&, 0&, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1
    If (txtWidth + R.left + txtHeight / 2) >= R.Right - m_Indentation Then
        txtWidth = R.Right - txtHeight / 2 - R.left - m_Indentation - 1
    End If
    
    'Assign values to points.
    poly(1).x = R.left:                               poly(1).y = R.tOp
    poly(2).x = R.left:                               poly(2).y = R.tOp + txtHeight
    poly(3).x = R.left + txtWidth:                    poly(3).y = R.tOp + txtHeight
    poly(4).x = R.left + txtWidth + txtHeight / 2:    poly(4).y = R.tOp
    
    'Creates first region to fill with color.
    hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
    'Creates second region to fill with color.
    hFRgn = CreateRoundRectRgn(R.left, R.tOp, R.Right, R.Bottom, m_roundedRadius, m_roundedRadius)
    'Combine our two regions
    CombineRgn hRgn, hRgn, hFRgn, RGN_AND
    'delete second region
    DeleteObject hFRgn
    
    'fill frame
    DrawAPIRoundRect m_RoundedCorner, 10&, m_FillColor, m_FillColor, R

    'If the creation of the region was successful then color.
    hBrush = CreateSolidBrush(m_TextBoxColor)
    If hRgn Then FillRgn UserControl.hdc, hRgn, hBrush
    
    'draw frame borders
    APILineEx UserControl.hdc, poly(2).x, poly(2).y, poly(3).x, poly(3).y, m_FrameColor
    APILineEx UserControl.hdc, poly(3).x, poly(3).y, poly(4).x, poly(4).y, m_FrameColor
    DrawAPIRoundRect m_RoundedCorner, 10&, m_FillColor, m_FrameColor, R, True
    
    'delete created region
    DeleteObject hRgn
    DeleteObject hBrush
    
    'set caption rectangle
    SetRect R_Caption, poly(1).x + m_Indentation / 2, poly(1).y, txtWidth + poly(1).x, txtHeight + poly(1).y + 2
    
'    'set icon coordinates
'    Iy = (txtHeight - m_IconSize) / 2
    UserControl.FillStyle = 0
End Sub

Private Sub Draw_OuterWedge(R_Caption As RECT, iY As Integer)
    Dim txtWidth As Integer, txtHeight As Integer, R As RECT, r1 As RECT
    Dim m_roundedRadius As Long, hFRgn As Long
    Dim poly(1 To 4) As Point, NumCoords As Long, hBrush As Long, hRgn As Long
    
    m_roundedRadius = IIf(m_RoundedCorner = False, 0&, 10&)

    txtWidth = m_TextWidth + 10
    If txtWidth < 100 Then txtWidth = 100
    txtHeight = m_TextHeight + 5
    NumCoords = 4
    
    SetRect R, 0&, 0&, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1
    If (txtWidth + R.left + txtHeight / 2) >= R.Right - m_Indentation Then
        txtWidth = R.Right - txtHeight / 2 - R.left - m_Indentation - 1
    End If
    
    'Assign values to points.
    poly(1).x = R.left + 6:                          poly(1).y = R.tOp
    poly(2).x = R.left + 6:                          poly(2).y = R.tOp + txtHeight
    poly(3).x = R.left + txtWidth + txtHeight / 2:   poly(3).y = R.tOp + txtHeight
    poly(4).x = R.left + txtWidth:                   poly(4).y = R.tOp
    
    'Creates first region to fill with color.
    hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
    
    'If the creation of the region was successful then color.
    hBrush = CreateSolidBrush(m_TextBoxColor)
    If hRgn Then FillRgn UserControl.hdc, hRgn, hBrush
    
    'fill frame
    SetRect r1, 0&, 0&, txtWidth * 0.9, txtHeight * 1.3
    DrawAPIRoundRect m_RoundedCorner, 10&, m_TextBoxColor, m_FrameColor, r1
    SetRect r1, txtWidth * 0.9 - 5, 1, txtWidth * 0.9 + 3, txtHeight * 1.3
    DrawAPIRoundRect m_RoundedCorner, 0&, m_TextBoxColor, m_TextBoxColor, r1
    
    SetRect r1, -1, -1, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1
    DrawAPIRoundRect m_RoundedCorner, 10&, m_FillColor, m_FillColor, r1, True
    
   'draw frame borders
    UserControl.ForeColor = m_FrameColor
    APILineEx UserControl.hdc, poly(1).x, poly(1).y, poly(4).x, poly(4).y, UserControl.ForeColor
    APILineEx UserControl.hdc, poly(4).x, poly(4).y, poly(3).x, poly(3).y, UserControl.ForeColor
    
    RoundRect UserControl.hdc, R.left, R.tOp + txtHeight, R.Right, R.Bottom, m_roundedRadius, m_roundedRadius
    RoundRect UserControl.hdc, R.left, R.tOp + txtHeight, R.left + 10, R.tOp + txtHeight + 10, 0, 0
    
    UserControl.ForeColor = m_FillColor
    RoundRect UserControl.hdc, R.left + 1, R.tOp + txtHeight + 1, R.left + 10, R.tOp + txtHeight + 10, 0, 0
    
    'delete created region
    DeleteObject hRgn
    DeleteObject hBrush
    
    'set caption rectangle
    SetRect R_Caption, poly(1).x + m_Indentation / 2 - 6, poly(1).y, txtWidth + poly(1).x - 6, txtHeight + poly(1).y + 2
    
End Sub

Private Sub Draw_Header(R_Caption As RECT)
    Dim p_left As Long
    
    APILineEx UserControl.hdc, 0&, jcTextBoxCenter, UserControl.ScaleWidth, jcTextBoxCenter, IIf(m_Enabled, TranslateColor(&H80000015), TranslateColor(TEXT_INACTIVE)) 'TranslateColor(&H80000015)&H808080
    APILineEx UserControl.hdc, 0&, jcTextBoxCenter + 1, UserControl.ScaleWidth, jcTextBoxCenter + 1, vbWhite
    
    If Len(m_Caption) <> 0 Then

        If m_Alignment = vbLeftJustify Then
            p_left = 0 'm_Indentation
        ElseIf m_Alignment = vbRightJustify Then
            p_left = UserControl.ScaleWidth - m_TextWidth - m_Space
        Else
            p_left = (UserControl.ScaleWidth - m_TextWidth) / 2
        End If

        'Draw a line
        APILineEx UserControl.hdc, p_left, jcTextBoxCenter, p_left + m_TextWidth + m_Space, jcTextBoxCenter, m_FillColor 'TranslateColor(Ambient.BackColor)
        APILineEx UserControl.hdc, p_left, jcTextBoxCenter + 1, p_left + m_TextWidth + m_Space, jcTextBoxCenter + 1, m_FillColor 'TranslateColor(Ambient.BackColor)
        
        'set caption rect
        SetRect R_Caption, p_left + m_Space / 2, 0, m_TextWidth + p_left + m_Space / 2, m_TextHeight
    End If
End Sub

Private Sub Draw_Panel(R_Caption As RECT, iY As Integer)
    Dim R As RECT, m_roundedRadius As Long, hFRgn As Long, hRgn As Long
    
    jcTextBoxCenter = m_TextBoxHeight / 2
    
    'Draw border rectangle
    UserControl.FillColor = m_FillColor
    
    If m_ThemeColor = Custom Or m_HeaderStyle = TxtBoxColor Then
        UserControl.ForeColor = m_FrameColor
    Else
        UserControl.ForeColor = jcColorBorderPic
    End If

    'If m_Enabled = False Then UserControl.ForeColor = m_Border_Inactive

    m_roundedRadius = IIf(m_RoundedCorner = False, 0&, 9&)

    SetRect R, 0&, 0&, UserControl.ScaleWidth, UserControl.ScaleHeight
    If m_HeaderStyle = Gradient Then
        DrawGradientInRectangle UserControl.hdc, jcColorFrom, jcColorTo, R, m_GradientHeaderStyle, False, UserControl.ForeColor, 2.03
    End If
    
    'Creates first region to fill with color.
    hRgn = CreateRoundRectRgn(R.left, R.tOp, R.Right, R.Bottom, 0&, 0&)
    'Creates second region to fill with color.
    hFRgn = CreateRoundRectRgn(R.left, R.tOp, R.Right, R.Bottom, m_roundedRadius, m_roundedRadius)
    'Combine our two regions
    CombineRgn hRgn, hRgn, hFRgn, RGN_AND
    'delete second region
    DeleteObject hFRgn
 
    SetWindowRgn UserControl.hwnd, hRgn, True
    
    UserControl.FillStyle = IIf(m_Head