animatedchart.ctl

The most perfect bubble.rar

    End If
    
    
   
End Sub

Private Sub ClearLegendItems()
    Dim X As Integer
    
    On Error Resume Next
    
    If bLegendAdded Then
        bLegendAdded = False
        
        For X = 1 To Box.Count
            Unload Box(X)
            Unload lblDescription(X)
            vsbContainer.Value = 0
            Box(0).Visible = False
            lblDescription(0).Visible = False
        Next X
    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)
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    On Error Resume Next
    With PropBag
        uTopMargin = .ReadProperty("uTopMargin")
        uBottomMargin = .ReadProperty("uBottomMargin")
        uLeftMargin = .ReadProperty("uLeftMargin")
        uRightMargin = .ReadProperty("uRightMargin")
        uContentBorder = .ReadProperty("uContentBorder")
        uSelectable = .ReadProperty("uSelectable", False)
        uHotTracking = .ReadProperty("uHotTracking", False)
        uSelectedColumn = .ReadProperty("uSelectedColumn", -1)
        uChartTitle = .ReadProperty("uChartTitle", UserControl.Name)
        uChartSubTitle = .ReadProperty("uChartSubTitle", uChartSubTitle)
        uDisplayYAxis = .ReadProperty("uDisplayXAxis", uDisplayXAxis)
        uDisplayXAxis = .ReadProperty("uDisplayYAxis", uDisplayYAxis)
        uColorBars = .ReadProperty("uColorBars", False)
        uIntersectMajor = .ReadProperty("uIntersectMajor", 10)
        uIntersectMinor = .ReadProperty("uIntersectMinor", 2)
        uMaxYValue = .ReadProperty("uMaxYValue", 100)
        uDisplayDescript = .ReadProperty("uDisplayDescript", False)
        uXAxisLabel = .ReadProperty("uXAxisLabel")
        uYAxisLabel = .ReadProperty("uYAxisLabel")
        UserControl.BackColor = .ReadProperty("BackColor")
        UserControl.ForeColor = .ReadProperty("ForeColor")
        uOldSelection = -1
        m_ActiveTheme = .ReadProperty("ActiveTheme", ThemePersianGulf)
    End With
End Sub

Private Sub UserControl_Resize()
    If bDisplayLegend Then
        picLegend.Left = UserControl.ScaleWidth - picLegend.Width
    Else
        picLegend.Left = UserControl.ScaleWidth - lblSlider.Width
    End If
    picLegend.Height = UserControl.ScaleHeight
    vsbContainer.Height = picLegend.ScaleHeight
    lblSlider.Height = picLegend.ScaleHeight

    If IsDrawedOnce Then
      bResize = True
      DrawChart
      bResize = False
    End If


End Sub

Private Sub UserControl_Show()
    'DrawChart
    Call SetStyle
    
    UserControl.Cls
    DrawBackTheme

    tmrStart.Enabled = True
End Sub

Private Sub UserControl_Terminate()
    Set cItems = Nothing
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
        .WriteProperty "uTopMargin", uTopMargin
        .WriteProperty "uBottomMargin", uBottomMargin
        .WriteProperty "uLeftMargin", uLeftMargin
        .WriteProperty "uRightMargin", uRightMargin
        .WriteProperty "uContentBorder", uContentBorder
        .WriteProperty "uSelectable", uSelectable
        .WriteProperty "uHotTracking", uHotTracking
        .WriteProperty "uSelectedColumn", uSelectedColumn
        .WriteProperty "uChartTitle", uChartTitle
        .WriteProperty "uChartSubTitle", uChartSubTitle
        .WriteProperty "uDisplayXAxis", uDisplayXAxis
        .WriteProperty "uDisplayYAxis", uDisplayYAxis
        .WriteProperty "uColorBars", uColorBars
        .WriteProperty "uIntersectMajor", uIntersectMajor
        .WriteProperty "uIntersectMinor", uIntersectMinor
        .WriteProperty "uMaxYValue", uMaxYValue
        .WriteProperty "uDisplayDescript", uDisplayDescript
        .WriteProperty "uXAxisLabel", uXAxisLabel
        .WriteProperty "uYAxislabel", uYAxisLabel
        .WriteProperty "BackColor", UserControl.BackColor
        .WriteProperty "ForeColor", UserControl.ForeColor
        .WriteProperty "ActiveTheme", m_ActiveTheme
    End With
End Sub

Private Sub vsbContainer_Change()
    picContainer.Top = -vsbContainer.Value * Screen.TwipsPerPixelY
End Sub

Private Sub vsbContainer_Scroll()
    picContainer.Top = -vsbContainer.Value * Screen.TwipsPerPixelY
End Sub

Private Function DoGradient(FromColor As Long, ToColor As Long, _
                     Optional DrawHorVer As GRADIENT_FILL_RECT = FillHor, _
                     Optional Left As Long = 0, Optional Top As Long = 0, _
                     Optional Width As Long = -1, _
                     Optional Height As Long = -1, _
                     Optional ByVal Drawhdc As Long = -1) As Boolean
    Dim Vert(1) As TRIVERTEX
    Dim gRect As GRADIENT_RECT
    Dim r As Byte, G As Byte, B As Byte
       
    Long2RGB FromColor, r, G, B
    With Vert(0)
        .X = Left
        .Y = Top
        .Red = Val("&h" & Hex(r) & "00")
        .Green = Val("&h" & Hex(G) & "00")
        .Blue = Val("&h" & Hex(B) & "00")
        .Alpha = 0&
    End With
    
    Long2RGB ToColor, r, G, B
    With Vert(1)
        .X = Left + Width
        .Y = Top + Height
        .Red = Val("&h" & Hex(r) & "00")
        .Green = Val("&h" & Hex(G) & "00")
        .Blue = Val("&h" & Hex(B) & "00")
        .Alpha = 0&
    End With

    gRect.UPPERLEFT = 0
    gRect.LOWERRIGHT = 1

    DoGradient = GradientFillRect(IIf(Drawhdc = -1, UserControl.hDC, Drawhdc), Vert(0), 2, gRect, 1, DrawHorVer)
    
End Function

Private Function Long2RGB(nColor As Long, Red As Byte, Green As Byte, Blue As Byte)
    Red = (nColor And &HFF&)
    Green = (nColor And &HFF00&) / &H100
    Blue = (nColor And &HFF0000) / &H10000
End Function


Private Sub DrawItem(ByVal ColorOne As Long, ByVal ColorTwo As Long, _
                     ByVal Left As Long, ByVal Top As Long, _
                     ByVal Width As Long, ByVal Height As Long, _
                     Optional ByVal Animated As Boolean = False)

   Select Case m_ActiveTheme
      Case ThemePersianGulf
         DoGradient ColorTwo, ColorOne, FillVer, Left, Top, Width, Height
         DoGradient ColorOne, ColorTwo, FillVer, Left + 2, Top + 2, Width - 4, Height - 4
      Case Else
         DoGradient ColorTwo, ColorOne, FillHor, Left, Top, Width, Height
         
         DoGradient ColorOne, ColorTwo, FillHor, Left + 2, Top + 2, (Width / 3) * 2 - 4, Height - 4
         DoGradient ColorTwo, ColorOne, FillHor, Left + (Width / 3) * 2 - 2, Top + 2, (Width / 3) - 1, Height - 4
   End Select
End Sub

Private Sub DrawAllItems()
   Dim i          As Double
   Dim Down       As Long
   Dim ColorOne   As Long
   Dim ColorTwo   As Long
   Dim Left       As Long
   Dim Top        As Long
   Dim Width      As Long
   Dim Height     As Long
   Dim Item       As Variant
   Dim lStep      As Long
   
   On Error GoTo Er
   For i = 1 To 10
      For j = 0 To UBound(cItem)
         Item = Split(cItem(j), "|")
         Left = Item(0): Top = Item(1): Width = Item(2): Height = Item(3)
         ColorOne = Item(4): ColorTwo = Item(5)
         
         Down = Top + Height
         
         If Height >= (Height / 10) * i Then _
            DrawItem ColorOne, ColorTwo, Left, Down - ((Height / 10) * i), Width, (Height / 10) * i
         
      Next j
      
      Tim = Timer
      Do While Timer - Tim < 0.07: Loop
      
      UserControl.Refresh
      
   Next i
   
Er:
   IsDrawedOnce = True
   
End Sub


Private Sub SetColors()
   Colors(0, 0) = RGB(185, 239, 255): Colors(0, 1) = RGB(30, 155, 230)
   Colors(1, 0) = RGB(255, 125, 79): Colors(1, 1) = RGB(129, 0, 0)
   Colors(2, 0) = RGB(0, 254, 0): Colors(2, 1) = RGB(0, 122, 0)
   Colors(3, 0) = RGB(233, 131, 255): Colors(3, 1) = RGB(214, 23, 255)
   Colors(4, 0) = RGB(95, 206, 255): Colors(4, 1) = RGB(0, 116, 210)
   Colors(5, 0) = RGB(255, 193, 66): Colors(5, 1) = RGB(185, 0, 0)
   Colors(6, 0) = RGB(215, 255, 168): Colors(6, 1) = RGB(99, 163, 23)
   Colors(7, 0) = RGB(201, 61, 154): Colors(7, 1) = RGB(153, 13, 106)
   Colors(8, 0) = RGB(0, 0, 254): Colors(8, 1) = RGB(0, 0, 122)
   Colors(9, 0) = RGB(255, 255, 160): Colors(9, 1) = RGB(250, 197, 12)
   
End Sub


Public Function GetYTopLegend(ByVal MaxChartValue As Long) As Long
   Dim Text    As String
   Dim MyStr   As String
   Dim Num     As Long
   
   Text = CStr(MaxChartValue)
   
   If Val(Text) > 10 Then
      MyStr = String(LenB(StrConv(Text, vbFromUnicode)) - 2, "0")
      
      Num = Val(Left(Text, 2))
      
      If Num Mod 10 = 0 Then
         MyStr = Num & MyStr
      ElseIf Num Mod 10 > 5 Then
         MyStr = CStr(Int(Num / 10) + 1) & "0" & MyStr
      Else
         MyStr = CStr(Int(Num / 10)) & "5" & MyStr
      End If
   Else
      MyStr = 10
   End If
   
   GetYTopLegend = CLng(MyStr)
End Function

Public Property Get ActiveTheme() As Theme
   ActiveTheme = m_ActiveTheme
End Property

Public Property Let ActiveTheme(ByVal NewTheme As Theme)
   m_ActiveTheme = NewTheme
   
   SetStyle

   PropertyChanged "ActiveTheme"
   
   DrawChart
End Property

Public Sub DrawBackTheme()
   Dim lWidth     As Long
   Dim lHeight    As Long
   lWidth = (UserControl.ScaleWidth) / Screen.TwipsPerPixelX
   lHeight = (UserControl.ScaleHeight / Screen.TwipsPerPixelY)
   
    UserControl.Cls
    Select Case m_ActiveTheme
      Case ThemePersianGulf
         DoGradient RGB(0, 3, 102), RGB(0, 100, 202), FillVer, 0, 0, lWidth, lHeight, UserControl.hDC
      Case ThemeSky
         DoGradient RGB(158, 190, 230), RGB(185, 210, 239), FillVer, 0, 0, lWidth, lHeight
      Case ThemeNeon
         DoGradient RGB(0, 0, 0), RGB(75, 75, 75), FillVer, 0, 0, lWidth, lHeight
   End Select
End Sub

Public Sub DrawIntersect(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal LastLine As Long)
   Dim lHeight As Long
   Dim lWidth  As Long
   Dim lLeft   As Long
   Dim lTop    As Long
   
   lHeight = ((Y1 - LastLine) / 15) - 1
   lWidth = (X2 - X1) / 15 + 1
   lLeft = X1 / 15
   lTop = (Y1 / 15) + 1
   Select Case m_ActiveTheme
      Case ThemePersianGulf
         DoGradient RGB(0, 54, 144), RGB(0, 59, 149), FillVer, lLeft, lTop, lWidth, lHeight
         UserControl.Line (X1, Y1)-(X2 + 1, Y1 + 30), RGB(0, 129, 199), BF
      Case ThemeSky
         DoGradient RGB(227, 239, 255), RGB(201, 224, 255), FillVer, lLeft, lTop, lWidth, (lHeight / 2)
         DoGradient RGB(183, 214, 255), RGB(190, 218, 255), FillVer, lLeft, lTop + (lHeight / 2), lWidth, lHeight - (lHeight / 2) + 1
      Case ThemeNeon
         DoGradient RGB(66, 70, 81), RGB(58, 61, 69), FillVer, lLeft, lTop, lWidth, (lHeight / 8) * 3
         DoGradient RGB(46, 47, 47), RGB(59, 59, 59), FillVer, lLeft, lTop + (lHeight / 8) * 3, lWidth, (lHeight / 8) * 4
         DoGradient RGB(68, 68, 68), RGB(75, 75, 75), FillVer, lLeft, lTop + ((lHeight / 8) * 7) - 1, lWidth, lHeight - (lHeight / 8) * 7 + 1
   End Select
End Sub

Public Function GetThemeLineColor() As Long
   Select Case m_ActiveTheme
      Case ThemePersianGulf
         GetThemeLineColor = RGB(0, 129, 199)
      Case ThemeNeon
         GetThemeLineColor = RGB(40, 40, 40)
      Case ThemeSky
         GetThemeLineColor = RGB(141, 178, 227) 'RGB(173, 209, 255) '
   End Select
End Function

Private Sub DrawLegend()
   picLegend.Cls
   
   Select Case m_ActiveTheme
      Case ThemePersianGulf
         DoGradient RGB(0, 100, 202), RGB(0, 3, 102), FillVer, 0, 0, picLegend.ScaleWidth / 15, picLegend.ScaleHeight / 15, picLegend.hDC
      Case ThemeNeon
         DoGradient RGB(75, 75, 75), RGB(0, 0, 0), FillVer, 0, 0, picLegend.ScaleWidth / 15, picLegend.ScaleHeight / 15, picLegend.hDC
      Case ThemeSky
         DoGradient RGB(185, 210, 239), RGB(158, 190, 230), FillVer, 0, 0, picLegend.ScaleWidth / 15, picLegend.ScaleHeight / 15, picLegend.hDC
   End Select
End Sub

Private Sub SetStyle()
    Select Case m_ActiveTheme
      Case ThemePersianGulf
         lblSlider.BackColor = &H400000
         lblSlider.ForeColor = vbWhite
         UserControl.ForeColor = vbWhite
      Case ThemeSky
         lblSlider.BackColor = RGB(158, 190, 230)
         lblSlider.ForeColor = vbBlack
         UserControl.ForeColor = vbBlack 'RGB(131, 200, 240)
      Case ThemeNeon
         lblSlider.BackColor = vbBlack
         lblSlider.ForeColor = vbWhite
         UserControl.ForeColor = vbWhite
   End Select
End Sub