animatedchart.ctl

The most perfect bubble.rar

    DrawChart
End Property
Public Property Get HotTracking() As Boolean
    HotTracking = uHotTracking
End Property

Public Property Let SelectedColumn(ColNumber As Long)
    Dim ret As Double
    Dim oItem As ChartItem
    On Error Resume Next
    
    uSelectedColumn = ColNumber
    DrawChart
    
    ret = uColumns(ColNumber)
    If Err.Number Then
        uSelectedColumn = -1
    Else
        oItem = cItems(ColNumber + 1)
        RaiseEvent ItemClick(oItem)
    End If

End Property
Public Property Get SelectedColumn() As Long
    SelectedColumn = uSelectedColumn
End Property

Public Property Let ChartTitle(sTitle As String)
    uChartTitle = sTitle
    DrawChart
End Property
Public Property Get ChartTitle() As String
    ChartTitle = uChartTitle
End Property

Public Property Let ChartSubTitle(sTitle As String)
    uChartSubTitle = sTitle
    DrawChart
End Property
Public Property Get ChartSubTitle() As String
    ChartSubTitle = uChartSubTitle
End Property

Public Property Let IntersectMajor(ISValue As Double)
    uIntersectMajor = ISValue
    DrawChart
End Property
Public Property Get IntersectMajor() As Double
    IntersectMajor = uIntersectMajor
End Property

Public Property Let IntersectMinor(ISValue As Double)
    uIntersectMinor = ISValue
    DrawChart
End Property
Public Property Get IntersectMinor() As Double
    IntersectMinor = uIntersectMinor
End Property

Public Property Let DisplayYAxis(DisplayAxis As Boolean)
    uDisplayYAxis = DisplayAxis
    DrawChart
End Property
Public Property Get DisplayYAxis() As Boolean
    DisplayYAxis = uDisplayYAxis
End Property

Public Property Let DisplayXAxis(DisplayAxis As Boolean)
    uDisplayXAxis = DisplayAxis
    DrawChart
End Property
Public Property Get DisplayXAxis() As Boolean
    DisplayXAxis = uDisplayXAxis
End Property

Public Property Let MaxY(dMax As Double)
    uMaxYValue = dMax
    DrawChart
End Property
Public Property Get MaxY() As Double
    MaxY = uMaxYValue
End Property

Public Property Let SelectionInformation(DisplayInfo As Boolean)
    uDisplayDescript = DisplayInfo
    DrawChart
End Property
Public Property Get SelectionInformation() As Boolean
    SelectionInformation = uDisplayDescript
End Property

Public Property Let AxisLabelY(sCaption As String)
    uYAxisLabel = sCaption
    DrawChart
End Property
Public Property Get AxisLabelY() As String
    AxisLabelY = uYAxisLabel
End Property

Public Property Let AxisLabelX(sCaption As String)
    uXAxisLabel = sCaption
    DrawChart
End Property
Public Property Get AxisLabelX() As String
    AxisLabelX = uXAxisLabel
End Property

Public Property Let BackColor(hColor As OLE_COLOR)
    UserControl.BackColor = hColor
    DrawChart
End Property
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

Public Property Let ForeColor(hColor As OLE_COLOR)
    UserControl.ForeColor = hColor
    DrawChart
End Property
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = UserControl.ForeColor
End Property

Public Property Let ColorBars(bUseColor As Boolean)
    uColorBars = bUseColor
    DrawChart
End Property
Public Property Get ColorBars() As Boolean
    ColorBars = uColorBars
End Property

Private Sub lblDescription_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        If uSelectable Then

            uSelectedColumn = Index
            uOldSelection = uSelectedColumn
            
            lScrollvalue = vsbContainer.Value
            
            bLegendClicked = True
            
            DrawChart
            
            bLegendClicked = False
        
            vsbContainer.Value = lScrollvalue
        End If
    End If
End Sub

Private Sub lblInfo_DblClick()
   lblInfo.Visible = False
   lblInfo.Tag = vbNullString
End Sub

Private Sub lblInfo_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        offsetX = X
        offsetY = Y
        lblInfo.Drag
        lblInfo.Tag = "Fix"
        mnuAutoMoveInfo.Checked = False
    Else
        PopupMenu mnuMain
    End If
End Sub

Private Sub mnuRefresh_Click()
    DrawChart
End Sub

Private Sub lblSlider_Click()
    mnuViewLegend.Checked = Not mnuViewLegend.Checked
    bDisplayLegend = mnuViewLegend.Checked
    ShowLegend Not (bDisplayLegend)
    DrawChart
End Sub

Private Sub mnuAutoMoveInfo_Click()
   mnuAutoMoveInfo.Checked = Not mnuAutoMoveInfo.Checked
   lblInfo.Tag = IIf(mnuAutoMoveInfo.Checked, "", "Fix")
End Sub

Private Sub mnuEditCopy_Click()
    Clipboard.SetData UserControl.Image
End Sub

Private Sub mnuLegendHide_Click()
    mnuViewLegend.Checked = Not mnuViewLegend.Checked
    bDisplayLegend = mnuViewLegend.Checked
    ShowLegend True
    DrawChart
End Sub


'另存为
Private Sub mnuSaveAs_Click()
   Dim blnReturn As Long
   Dim strBuffer As String
   strBuffer = Space(255)
   blnReturn = SHGetSpecialFolderPath(0, _
      strBuffer, _
      CSIDL_MYPICTURES, _
      False)
      
   strBuffer = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1)
   
   
   
   Dim sFilters As String
   Dim OFN As OPENFILENAME
   Dim lret As Long
   
   Dim buff As String
   Dim sLname As String
   Dim sSname As String

  '创建对话框
   sFilters = "Windows Bitmap" & vbNullChar & _
              "*.bmp" & vbNullChar & vbNullChar
  
   With OFN
      .nStructSize = Len(OFN)
      .hWndOwner = UserControl.hWnd
      .sFilter = sFilters
      .nFilterIndex = 0
      .sFile = "ActiveChart.bmp" & Space$(1024) & _
               vbNullChar & vbNullChar
      .nMaxFile = Len(.sFile)
      .sDefFileExt = "bmp" & vbNullChar & vbNullChar
      .sFileTitle = vbNullChar & Space$(512) & _
                    vbNullChar & vbNullChar
      .nMaxTitle = Len(OFN.sFileTitle)
      .sInitialDir = strBuffer & vbNullChar & vbNullChar
      .sDialogTitle = "保持图表为文件"
      .flags = OFS_FILE_SAVE_FLAGS

   End With
   
   
  '调用 API
   blnReturn = GetSaveFileName(OFN)
   
   If blnReturn Then
      SavePicture UserControl.Image, OFN.sFile
   End If
End Sub

Private Sub mnuSelectionInfo_Click()
    mnuSelectionInfo.Checked = Not mnuSelectionInfo.Checked
    uDisplayDescript = mnuSelectionInfo.Checked
    DrawChart
End Sub

Private Sub mnuViewLegend_Click()
    mnuViewLegend.Checked = Not mnuViewLegend.Checked
    bDisplayLegend = mnuViewLegend.Checked
    ShowLegend Not (bDisplayLegend)
    DrawChart
End Sub


Private Sub picContainer_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        PopupMenu mnuLegend
    End If
End Sub

Private Sub DrawContainer()
   Dim lColor As Long
   lColor = GetPixel(picLegend.hDC, 1, picContainer.Height / 15)
   
   picContainer.Cls
   
   Select Case m_ActiveTheme
      Case ThemePersianGulf
         DoGradient RGB(0, 100, 202), lColor, FillVer, 0, 0, picContainer.ScaleWidth / 15, picContainer.ScaleHeight / 15, picContainer.hDC
      Case ThemeNeon
         DoGradient RGB(75, 75, 75), lColor, FillVer, 0, 0, picContainer.ScaleWidth / 15, picContainer.ScaleHeight / 15, picContainer.hDC
      Case ThemeSky
         DoGradient RGB(185, 210, 239), lColor, FillVer, 0, 0, picContainer.ScaleWidth / 15, picContainer.ScaleHeight / 15, picContainer.hDC
   End Select
End Sub

Private Sub picLegend_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        PopupMenu mnuLegend
    End If
End Sub

Private Sub picLegend_Resize()
  Call DrawLegend
End Sub

Private Sub tmrStart_Timer()
   IsDrawedOnce = False
   tmrStart.Enabled = False
   Call SetColors
   Call DrawChart
End Sub

Private Sub UserControl_DragDrop(Source As Control, X As Single, Y As Single)
    Source.Left = X - offsetX
    Source.Top = Y - offsetY
End Sub

Private Sub UserControl_Initialize()
    Set cItems = New Collection
End Sub

Private Sub UserControl_InitProperties()
    Dim X As Integer
    Dim oChartItem As ChartItem
    
    uTopMargin = 50 * Screen.TwipsPerPixelY
    uBottomMargin = 55 * Screen.TwipsPerPixelY
    uLeftMargin = 55 * Screen.TwipsPerPixelX
    uRightMargin = 55 * Screen.TwipsPerPixelX
    uContentBorder = True
    uSelectable = False
    uHotTracking = False
    uSelectedColumn = -1
    uOldSelection = -1
    uChartTitle = UserControl.Name
    uChartSubTitle = "动画特效图表示例(支持换肤)"
    uDisplayYAxis = True
    uDisplayXAxis = True
    uColorBars = False
    uIntersectMajor = 10
    uIntersectMinor = 2
    uMaxYValue = 100
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim X1 As Single
    Dim oItem As ChartItem
    
    If IsInDrawMode Then GoTo TrackExit
    
    If Button = vbLeftButton Then
        X1 = (uColWidth)
        
        On Error GoTo TrackExit
        
        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
    ElseIf Button = vbRightButton Then
        mnuSelectionInfo.Visible = False
        If uSelectable Then
            mnuSelectionInfo.Visible = True
            mnuSeperator.Visible = True