animatedchart.ctl

The most perfect bubble.rar

        End If
        PopupMenu mnuMain
    End If
        
    RaiseEvent MouseDown(Button, Shift, X, Y)
    
TrackExit:
    Exit Sub
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim X1 As Long
    Dim oItem As ChartItem
    X1 = (uColWidth)
    
    On Error GoTo TrackExit
    
    If IsInDrawMode Then GoTo TrackExit
    
    If uHotTracking Then
        If (Y <= UserControl.ScaleHeight - uBottomMargin) And (uColumns((X - uLeftMargin) \ (X1)) <= Y) And uSelectable Then
           If Not bProcessingOver Then
               bProcessingOver = True
               uSelectedColumn = (X - uLeftMargin) \ (X1)
               If Not uSelectedColumn = uOldSelection Then
                   Cls
                   DrawChart
                   uOldSelection = uSelectedColumn
               End If
               bProcessingOver = False
           End If
        Else
            If Not bProcessingOver Then
               bProcessingOver = True
               uSelectedColumn = -1
               If Not uSelectedColumn = uOldSelection Then
                  Cls
                  DrawChart
                  uOldSelection = uSelectedColumn
               End If
                bProcessingOver = False
           End If
        End If
    ElseIf Button = vbLeftButton Then
        If (Y <= UserControl.ScaleHeight - uBottomMargin) And (uColumns((X - uLeftMargin) \ (X1)) <= Y) And uSelectable Then
           If Not bProcessingOver Then
               bProcessingOver = True
               uSelectedColumn = (X - uLeftMargin) \ (X1)
               If Not uSelectedColumn = uOldSelection Then
                   Cls
                   DrawChart
                   uOldSelection = uSelectedColumn
                   oItem = cItems(uSelectedColumn + 1)
                   RaiseEvent ItemClick(oItem)
               End If
   

       
               bProcessingOver = False
           End If
        End If
    End If

TrackExit:

    Exit Sub
End Sub

Public Sub Refresh()
    DrawChart
End Sub

Public Sub Clear()
    Dim X As Integer
    
    Set cItems = Nothing
    Set cItems = New Collection
    If bLegendAdded Then
        ClearLegendItems
    End If
    DrawChart
End Sub


'*************************************************************************
'**函 数 名：DrawChart
'**输    入：无
'**输    出：无
'**功能描述：绘制图表
'**全局变量：
'**调用模块：
'*************************************************************************
Public Sub DrawChart()
    Dim CurrentColor    As Integer
    Dim iCols           As Integer
    Dim X               As Long
    Dim X1              As Double
    Dim X2              As Double
    Dim Y1              As Double
    Dim y2              As Double
    Dim xTemp           As Double
    Dim yTemp           As Double
    Dim sDescription    As String
    Dim oChartItem      As ChartItem
    Dim lTopYValue      As Long
    
    If IsInDrawMode Then Exit Sub
    
    IsInDrawMode = True
    
    'If uIntersectMajor = 0 Then uIntersectMajor = 10
    'If uIntersectMinor = 0 Then uIntersectMinor = 2
    
    lTopYValue = GetYTopLegend(uMaxYValue)
    
    uIntersectMajor = lTopYValue / 10

    lblInfo.Visible = False
    lblDescription(0).ForeColor = UserControl.ForeColor
    
    iCols = cItems.Count
    
    mnuSelectionInfo.Checked = uDisplayDescript
    lblInfo.Visible = False
    If uDisplayDescript And uSelectedColumn > -1 And IsDrawedOnce Then lblInfo.Visible = True
    
    
    '清除已在图例
    If bDisplayLegend Then
        vsbContainer.Visible = False
        picContainer.Visible = False
    End If
    
    If Not bResize Then ClearLegendItems
    
    uRowHeight = lTopYValue
    For X = 1 To cItems.Count
        oChartItem = cItems(X)
        If uRowHeight - CDbl(oChartItem.Value) < 0 Then uRowHeight = CDbl(oChartItem.Value)
    Next X
    
    If uRowHeight = 0 Then uRowHeight = 0.001
    
    If uMaxYValue < uRowHeight Then uMaxYValue = uRowHeight
    
    uRowHeight = ((UserControl.ScaleHeight - (uTopMargin + uBottomMargin)) / uRowHeight)
    If iCols Then uColWidth = ((UserControl.ScaleWidth - (uLeftMargin + uRightMargin)) / iCols)
    
    'UserControl.AutoRedraw = True
   
    DrawBackTheme
    
    
    If iCols Then ReDim uColumns(iCols - 1)

    On Error Resume Next
    '相交线
    
    UserControl.CurrentX = (UserControl.ScaleWidth / 2) - (UserControl.TextWidth(uChartTitle) / 2)
    UserControl.CurrentY = 0
    UserControl.FontName = "宋体"
    UserControl.FontSize = 9
    UserControl.FontBold = True
    UserControl.Print uChartTitle
    UserControl.FontBold = False
        
    UserControl.FontSize = UserControl.FontSize - 2
    UserControl.CurrentX = (UserControl.ScaleWidth / 2) - (UserControl.TextWidth(uChartSubTitle) / 2)
    UserControl.Print uChartSubTitle
    UserControl.FontSize = UserControl.FontSize + 2
    
    If uDisplayYAxis Then
        Dim Counter  As Double
        Dim LastLine As Double
        For X = 0 To lTopYValue Step 10
            X1 = uLeftMargin + (2 * Screen.TwipsPerPixelX): X2 = UserControl.ScaleWidth - uRightMargin
            Y1 = (UserControl.ScaleHeight - uBottomMargin) - (X * uRowHeight)
            If (X) Mod uIntersectMajor = 0 Then
                Counter = Counter + 1
                
                If Counter Mod 2 = 0 Then
                  DrawIntersect X1, Y1, X2, LastLine
                Else
                  LastLine = Y1
                End If

                
                UserControl.Line (X1, Y1)-(X2 + 1, Y1 + 15), GetThemeLineColor, BF
                UserControl.FontSize = UserControl.FontSize - 2
                UserControl.CurrentX = uLeftMargin - UserControl.TextWidth(X) - (5 * Screen.TwipsPerPixelX)
                UserControl.CurrentY = Y1 - (UserControl.TextHeight("0") / 2)
                UserControl.Print (X)
                UserControl.FontSize = UserControl.FontSize + 2
            End If
        Next X
    End If
   
    ReDim cItem(cItems.Count - 1)
    
    On Error GoTo 0
    If uContentBorder Then
      UserControl.Line (uLeftMargin - 15, uTopMargin)-(uLeftMargin, UserControl.ScaleHeight - uBottomMargin), GetThemeLineColor, BF
    End If
    
    
    
    For X = 0 To cItems.Count - 1
        oChartItem = cItems(X + 1)
        
        X1 = (X * uColWidth) + uLeftMargin + (2 * Screen.TwipsPerPixelX)
        X2 = X1 + uColWidth - (2 * Screen.TwipsPerPixelX)
        Y1 = (UserControl.ScaleHeight - uBottomMargin) - (CDbl(oChartItem.Value) * uRowHeight)
        y2 = UserControl.ScaleHeight - uBottomMargin
                
        uColumns(X) = Y1
                     
        '选定 Bar
        If X = uSelectedColumn And uSelectable And IsDrawedOnce Then
            'DrawItem RGB(254, 0, 0), RGB(122, 0, 0), (X1 + 1) / 15, Y1 / 15, (X2 - X1 - 1) / 15, (y2 - Y1) / 15, False
            DrawItem RGB(252, 233, 179), RGB(244, 192, 51), (X1 + 1) / 15, Y1 / 15, (X2 - X1 - 1) / 15, (y2 - Y1) / 15, False
            '添加图例项
            If Not bResize Then AddLegendItem oChartItem.SelectedDescription, 9
                                                      
            If uDisplayDescript Then
                lblInfo.Visible = False
                lblInfo = "记录: " & oChartItem.XAxisDescription & vbCr & "金额: " & Format(oChartItem.Value, "#,0") & "元" & vbCr & oChartItem.SelectedDescription
                If lblInfo.Tag <> "Fix" Then lblInfo.Move X1 + ((X2 - X1) - lblInfo.Width) / 2, y2 + 20
                If IsDrawedOnce Then lblInfo.Visible = True
            End If
        Else
            CurrentColor = (oChartItem.ItemID - 1) Mod 10
            
            If Not IsDrawedOnce Then
               cItem(X) = (X1 + 1) / 15 & "|" & Y1 / 15 & "|" & (X2 - X1 - 1) / 15 & "|" & (y2 - Y1) / 15 & "|" & IIf(uColorBars, Colors(CurrentColor, 0), Colors(2, 0)) & "|" & IIf(uColorBars, Colors(CurrentColor, 1), Colors(2, 1))
            Else
               DrawItem IIf(uColorBars, Colors(CurrentColor, 0), Colors(2, 0)), IIf(uColorBars, Colors(CurrentColor, 1), Colors(2, 1)), (X1 + 1) / 15, Y1 / 15, (X2 - X1 - 1) / 15, (y2 - Y1) / 15, Not IsDrawedOnce
            End If
            
            
            '添加图例项
            If Not bResize Then AddLegendItem oChartItem.SelectedDescription, IIf(uColorBars, CurrentColor, 1)
            
            'CurrentColor = CurrentColor + 1
            'If CurrentColor >= 10 Then CurrentColor = 0
        End If
        
        If uDisplayXAxis Then
            UserControl.FontSize = UserControl.FontSize - 1
            
            xTemp = (((X2 - X1) / 2) + X1) / Screen.TwipsPerPixelX
            yTemp = (UserControl.ScaleHeight - uBottomMargin + UserControl.TextWidth(oChartItem.XAxisDescription) / 1.25) / Screen.TwipsPerPixelY
            
            PrintRotText UserControl.hDC, oChartItem.XAxisDescription, xTemp, yTemp, 270
            
            UserControl.Line (X1 - 1 * Screen.TwipsPerPixelX, y2)-(X1 - 1 * Screen.TwipsPerPixelX, y2 + UserControl.TextHeight(oChartItem.XAxisDescription) / 2), GetThemeLineColor
            UserControl.FontSize = UserControl.FontSize + 1
        End If
        
    Next X
    
    If Not IsDrawedOnce Then DrawAllItems
    
    
    
    
    '垂直标签
    If LenB(StrConv(uXAxisLabel, vbFromUnicode)) Then
        UserControl.FontSize = UserControl.FontSize - 1
        UserControl.CurrentY = UserControl.ScaleHeight - UserControl.TextHeight(uXAxisLabel) * 1.5
        UserControl.CurrentX = (UserControl.ScaleWidth / 2) - (UserControl.TextWidth(uXAxisLabel) / 2)
        UserControl.Print uXAxisLabel
        UserControl.FontSize = UserControl.FontSize + 2  '文字大小
    End If
    
    '水平标签
    If LenB(StrConv(uYAxisLabel, vbFromUnicode)) Then
        UserControl.FontSize = UserControl.FontSize - 1
        PrintRotText UserControl.hDC, uYAxisLabel, UserControl.TextHeight(uYAxisLabel) / Screen.TwipsPerPixelX, UserControl.ScaleHeight / 2 / Screen.TwipsPerPixelY, 90
        UserControl.FontSize = UserControl.FontSize + 1
    End If

    '图例
    If bDisplayLegend Then
        If uSelectable And uSelectedColumn > -1 Then
            Dim perScreen As Integer
            Dim scrollValue As Integer
                        
            perScreen = Abs((picLegend.ScaleHeight / ((Box(0).Height + (10 * Screen.TwipsPerPixelY)))) - 1)
                        
            If (uSelectedColumn + 1) > perScreen Then
                scrollValue = ((uSelectedColumn + 1) * ((Box(0).Height / Screen.TwipsPerPixelY) + 10)) - (Box(perScreen).Top / Screen.TwipsPerPixelY)
                If scrollValue > vsbContainer.Max Then scrollValue = vsbContainer.Max
                vsbContainer.Value = scrollValue
            Else
                vsbContainer.Value = 0
            End If
                        
            DrawContainer
            picContainer.Line ((Box(uSelectedColumn).Left - 3 * Screen.TwipsPerPixelX), (Box(uSelectedColumn).Top - 3 * Screen.TwipsPerPixelY))-(lblDescription(uSelectedColumn).Left + lblDescription(uSelectedColumn).Width + 2 * Screen.TwipsPerPixelX, Box(uSelectedColumn).Top + Box(uSelectedColumn).Height + 2 * Screen.TwipsPerPixelY), vbWhite, B
            
        End If
        picContainer.Visible = True
    End If
    
    IsInDrawMode = False
    
End Sub

Public Function ShowLegend(Optional bHidden As Boolean = False)
    lblSlider.Height = picLegend.ScaleHeight
    'picLegend.Line (0, 0)-(picLegend.ScaleWidth - Screen.TwipsPerPixelX, picLegend.ScaleHeight - Screen.TwipsPerPixelY), &HFFE0E0, B
    
    If bHidden Then bDisplayLegend = False Else bDisplayLegend = True
    
    If bDisplayLegend Then
        uRightMargin = uRightMargin + picLegend.ScaleWidth
        picLegend.Move UserControl.ScaleWidth - picLegend.Width + Screen.TwipsPerPixelX, 0, picLegend.Width, UserControl.ScaleHeight
        DrawContainer
        lblSlider = Chr(187)
    Else
        uRightMargin = uRightMargin - picLegend.Width
        picLegend.Move UserControl.ScaleWidth - lblSlider.Width
        lblSlider = Chr(171)
    End If
End Function

Private Sub AddLegendItem(sDescription As String, ColorIndex As Long)
    Dim X As Integer
    Dim ShortDescript As String
    
    ShortDescript = sDescription
    If Len(ShortDescript) > 17 Then ShortDescript = Left(ShortDescript, 15) & ".."
    
    If bLegendAdded Then
        X = Box.Count
        Load Box(X)
        Load lblDescription(X)
        
        Box(X).BackColor = Colors(ColorIndex, 0)
        
        Box(X).Top = Box(X - 1).Top + Box(X - 1).Height + 10 * Screen.TwipsPerPixelY
        lblDescription(X).Top = Box(X).Top
                
        lblDescription(X) = ShortDescript
        lblDescription(X).ToolTipText = sDescription
    Else
        X = 0
        Box(X).BackColor = Colors(ColorIndex, 0)
        
        lblDescription(X) = ShortDescript
        lblDescription(X).ToolTipText = sDescription
        bLegendAdded = True
    End If
    
    DoGradient Colors(ColorIndex, 1), Colors(ColorIndex, 0), FillVer, 0, 0, Box(X).Width / 15, Box(X).Height / 15, Box(X).hDC
    DoGradient Colors(ColorIndex, 0), Colors(ColorIndex, 1), FillVer, 1, 1, Box(X).Width / 15 - 2, Box(X).Height / 15 - 2, Box(X).hDC
    Box(X).Visible = True
    lblDescription(X).Visible = True
            
    picContainer.Height = ((Box(0).Height + (10 * Screen.TwipsPerPixelY)) * Box.Count - 1) + 10 * Screen.TwipsPerPixelY
    If picContainer.ScaleHeight > picLegend.ScaleHeight Then
        vsbContainer.Max = (picContainer.ScaleHeight / Screen.TwipsPerPixelY) - (picLegend.ScaleHeight / Screen.TwipsPerPixelY)
        If Not vsbContainer.Visible Then vsbContainer.Visible = True
    Else
        vsbContainer.Visible = False