jcframes.ctl

simple supermarket for beginners

Dim m_AtivarResizeDoForm As Boolean

Dim m_Collapsar As Boolean

'Eventos
Function PanelOrTitle(y As Single) As m_PanelArea
    If (y <= 0) Or (y < m_TextBoxHeight) Then
        PanelOrTitle = xTitle
    Else
        PanelOrTitle = xPanel
    End If
End Function


Private Sub Label_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent CollapseClick(Button)
    If (Button = 1) Then
        Dim iY As Integer
        If m_Collapsar Then
            Select Case m_style
                Case Messenger: iY = 9
                Case jcGradient: iY = 8
                Case XPDefault: iY = 6
                Case InnerWedge: iY = -1
                Case OuterWedge: iY = -2
                Case Windows: iY = 1
            End Select
            If Collapsado Then
                Label.Caption = "6"
                Collapsado = False
                UserControl.Height = temp_height
            Else
                Label.Caption = "5"
                Collapsado = True
                temp_height = UserControl.Height
                UserControl.Height = ScaleY(m_TextBoxHeight + iY, vbPixels, vbTwips)
            End If
        End If
        PaintFrame
    End If
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseDown(Button, Shift, x, y, PanelOrTitle(y))
    If (Button <> vbLeftButton) Then Exit Sub
    Select Case PanelOrTitle(y)
        Case xTitle
            RaiseEvent TileClick
        Case xPanel
            RaiseEvent PanelClick
    End Select
    
    Dim iHwnd As Long
    If m_AllowDraging Then
        If m_AllowParentDraging Then
            If (m_Responsavel = jcAmbos) Or (m_Responsavel = PanelOrTitle(y)) Then
                iHwnd = UserControl.Parent.hwnd
                jcTransp 70
            End If
        Else
            iHwnd = UserControl.hwnd
        End If
        Call ReleaseCapture
        Call SendMessage(iHwnd, &HA1, 2, 0&)
        If m_AllowParentDraging Then jcTransp 255
    End If
    
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseUp(Button, Shift, x, y, PanelOrTitle(y))
End Sub


'==========================================================================
' Init, Initialize, Read & Write UserControl
'==========================================================================
Private Sub UserControl_InitProperties()
    'Set default properties
    m_Caption = Ambient.DisplayName
    m_Responsavel = m_def_Responsavel
    m_AllowDraging = m_def_AllowDraging
    m_AtivarResizeDoForm = m_def_AtivarResizeDoForm
    m_AllowParentDraging = False
    m_Collapsar = m_def_Collapsar
    m_BackColor = TranslateColor(Ambient.BackColor)
    m_FillColorIni = TranslateColor(Ambient.BackColor)
    m_RoundedCorner = True
    m_RoundedCornerTxtBox = False
    m_style = jcGradient
    m_ThemeColor = Blue
    m_TextColor = TranslateColor(vbBlack)
    m_FrameColorIni = TranslateColor(vbBlack)
    m_TextBoxColorIni = TranslateColor(vbWhite)
    m_TxtBoxShadow = [No shadow]
    m_TextBoxHeight = 22
    m_HeaderStyle = Gradient
    m_GradientHeaderStyle = VerticalGradient
    SetjcTextDrawParams
End Sub

Private Sub UserControl_Initialize()
    Set m_Font = New StdFont
    Set UserControl.Font = m_Font
    m_IconSize = 16
    m_ColorFrom = 10395391
    m_ColorTo = 15790335
    m_TxtBoxShadow = [No shadow]
    m_ThemeColor = Blue
    m_Enabled = True
    Call SetDefaultThemeColor(m_ThemeColor)
    m_TextBoxHeight = 22
    m_Alignment = vbCenter
    m_IconAlignment = vbLeftAligment
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    'On Error Resume Next
    With PropBag
        m_FrameColorIni = .ReadProperty("FrameColor", vbBlack)
        m_BackColor = .ReadProperty("BackColor", Ambient.BackColor)
        m_AtivarResizeDoForm = PropBag.ReadProperty("AtivarResizeDoForm", m_def_AtivarResizeDoForm)
        m_Responsavel = PropBag.ReadProperty("MoverResponsavel", m_def_Responsavel)
        m_AllowDraging = PropBag.ReadProperty("MoverControle", m_def_AllowDraging)
        m_Collapsar = PropBag.ReadProperty("Collapsar", m_def_Collapsar)
        m_AllowParentDraging = PropBag.ReadProperty("MoverForm", False)
        m_FillColorIni = .ReadProperty("FillColor", Ambient.BackColor)
        m_TextBoxColorIni = .ReadProperty("TextBoxColor", vbWhite)
        m_TxtBoxShadow = .ReadProperty("TxtBoxShadow", [No shadow])
        m_style = .ReadProperty("Style", jcGradient)
        m_RoundedCorner = .ReadProperty("RoundedCorner", True)
        m_Enabled = .ReadProperty("Enabled", True)
        m_RoundedCornerTxtBox = .ReadProperty("RoundedCornerTxtBox", False)
        m_Caption = .ReadProperty("Caption", Ambient.DisplayName)
        m_TextBoxHeight = .ReadProperty("TextBoxHeight", 22)
        m_TextColor = .ReadProperty("TextColor", vbBlack)
        m_Alignment = .ReadProperty("Alignment", vbCenter)
        m_IconAlignment = .ReadProperty("IconAlignment", vbLeftAligment)
        Set m_Font = .ReadProperty("Font", Ambient.Font)
        Set m_icon = .ReadProperty("Picture", Nothing)
        m_IconSize = .ReadProperty("IconSize", 16)
        m_ThemeColor = .ReadProperty("ThemeColor", Blue)
        m_ColorFrom = .ReadProperty("ColorFrom", 10395391)
        m_ColorTo = .ReadProperty("ColorTo", 15790335)
        m_HeaderStyle = .ReadProperty("HeaderStyle", TxtBoxColor)
        m_GradientHeaderStyle = .ReadProperty("GradientHeaderStyle", VerticalGradient)
    End With
    
    If m_Collapsar Then
        Select Case m_style
            Case Header, Panel, TextBox: Label.Visible = False
            Case Else: Label.Visible = True
        End Select
    End If
    
    'Add properties
    UserControl.BackColor = TranslateColor(m_BackColor)
    SetjcTextDrawParams
    SetFont m_Font
    Call SetDefaultThemeColor(m_ThemeColor)
    SetDisabledColor
    'Paint control
    PaintFrame
    
    If m_AtivarResizeDoForm Then
        If Ambient.UserMode Then
            Set frm = Parent
            SetWindowLong frm.hwnd, GWL_STYLE, GetWindowLong(frm.hwnd, GWL_STYLE) And Not (WS_CAPTION)
        End If
    End If
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
        .WriteProperty "FrameColor", m_FrameColorIni, vbBlack
        .WriteProperty "BackColor", m_BackColor, Ambient.BackColor
        .WriteProperty "FillColor", m_FillColorIni, Ambient.BackColor
        .WriteProperty "TextBoxColor", m_TextBoxColorIni, vbWhite
        .WriteProperty "MoverForm", m_AllowParentDraging, False
        .WriteProperty "MoverControle", m_AllowDraging, m_def_AllowDraging
        .WriteProperty "AtivarResizeDoForm", m_AtivarResizeDoForm, m_def_AtivarResizeDoForm
        .WriteProperty "MoverResponsavel", m_Responsavel, m_def_Responsavel
        .WriteProperty "Collapsar", m_Collapsar, m_def_Collapsar
        .WriteProperty "TxtBoxShadow", m_TxtBoxShadow, [No shadow]
        .WriteProperty "Style", m_style, jcGradient
        .WriteProperty "RoundedCorner", m_RoundedCorner, True
        .WriteProperty "Enabled", m_Enabled, True
        .WriteProperty "RoundedCornerTxtBox", m_RoundedCornerTxtBox, False
        .WriteProperty "Caption", m_Caption, Ambient.DisplayName
        .WriteProperty "TextBoxHeight", m_TextBoxHeight, 22
        .WriteProperty "TextColor", m_TextColor, vbBlack
        .WriteProperty "Alignment", m_Alignment, vbCenter
        .WriteProperty "IconAlignment", m_IconAlignment, vbLeftAligment
        .WriteProperty "Font", m_Font, Ambient.Font
        .WriteProperty "Picture", m_icon, Nothing
        .WriteProperty "IconSize", m_IconSize, 16
        .WriteProperty "ThemeColor", m_ThemeColor, Blue
        .WriteProperty "ColorFrom", m_ColorFrom, 10395391
        .WriteProperty "ColorTo", m_ColorTo, 15790335
        .WriteProperty "HeaderStyle", m_HeaderStyle, TxtBoxColor
        .WriteProperty "GradientHeaderStyle", m_GradientHeaderStyle, VerticalGradient
    End With
End Sub

'==========================================================================
' Usercontrol events
'==========================================================================

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

Private Sub UserControl_Resize()
    If (m_Collapsar = False) Then
        If UserControl.Width < 700 Then UserControl.Width = 700
        If UserControl.Height < 400 Then UserControl.Height = 400
    End If
    PaintFrame
End Sub

'==========================================================================
' Properties
'==========================================================================
Public Property Let FrameColor(ByRef new_FrameColor As OLE_COLOR)
    m_FrameColorIni = TranslateColor(new_FrameColor)
    If m_ThemeColor = Custom Then jcColorBorderPic = m_FrameColor
    PropertyChanged "FrameColor"
    PaintFrame
End Property

Public Property Get FrameColor() As OLE_COLOR
    FrameColor = m_FrameColorIni
End Property

Public Property Let FillColor(ByRef new_FillColor As OLE_COLOR)
Attribute FillColor.VB_Description = "Returns/Sets the Fill color for TextBox and Windows style"
    m_FillColorIni = TranslateColor(new_FillColor)
    PropertyChanged "FillColor"
    PaintFrame
End Property

Public Property Get FillColor() As OLE_COLOR
    FillColor = m_FillColorIni
End Property

Public Property Let RoundedCornerTxtBox(ByRef new_RoundedCornerTxtBox As Boolean)
    m_RoundedCornerTxtBox = new_RoundedCornerTxtBox
    PropertyChanged "RoundedCornerTxtBox"
    PaintFrame
End Property

Public Property Get RoundedCornerTxtBox() As Boolean
    RoundedCornerTxtBox = m_RoundedCornerTxtBox
End Property

Public Property Let Enabled(ByRef New_Enabled As Boolean)
    m_Enabled = New_Enabled
    PropertyChanged "Enabled"
    PaintFrame
    FrameEnabled m_Enabled
End Property

Public Property Get Enabled() As Boolean
    Enabled = m_Enabled
End Property
Public Property Let TxtBoxShadow(ByRef new_TxtBoxShadow As jcShadowConst)
    m_TxtBoxShadow = new_TxtBoxShadow
    PropertyChanged "TxtBoxShadow"
    PaintFrame
End Property

Public Property Get TxtBoxShadow() As jcShadowConst
    TxtBoxShadow = m_TxtBoxShadow
End Property

Public Property Let RoundedCorner(ByRef new_RoundedCorner As Boolean)
    m_RoundedCorner = new_RoundedCorner
    PropertyChanged "RoundedCorner"
    PaintFrame
End Property

Public Property Get RoundedCorner() As Boolean
    RoundedCorner = m_RoundedCorner
End Property

Public Property Let Caption(ByRef New_Caption As String)
    m_Caption = New_Caption
    PaintFrame
End Property

Public Property Get Caption() As String
    Caption = m_Caption
End Property

Public Property Let Alignment(ByRef New_Alignment As AlignmentConstants)
    m_Alignment = New_Alignment
    SetjcTextDrawParams
    PropertyChanged "Alignment"
    PaintFrame
End Property

Public Property Get Alignment() As AlignmentConstants
    Alignment = m_Alignment
End Property

Public Property Let Style(ByRef New_Style As jcStyleConst)
    m_style = New_Style
    PropertyChanged "Style"
    If (New_Style = Header) Or (New_Style = Panel) Or (New_Style = TextBox) Then m_Collapsar = False: Label.Visible = False
    SetDefault ' m_ThemeColor
    PaintFrame
End Property

Public Property Get Style() As jcStyleConst
    If (m_style = Header) Or (m_style = Panel) Or (m_style = TextBox) Then m_Collapsar = False: Label.Visible = False
    Style = m_style
End Property

Public Property Let TextBoxHeight(ByRef new_TextBoxHeight As Long)
    m_TextBoxHeight = new_TextBoxHeight
    PropertyChanged "TextBoxHeight"
    PaintFrame
End Property

Public Property Get TextBoxHeight() As Long
    TextBoxHeight = m_TextBoxHeight
End Property

Public Property Let TextColor(ByRef new_TextColor As OLE_COLOR)
    m_TextColor = TranslateColor(new_TextColor)
    PropertyChanged "TextColor"