📄 animatedchart.ctl
字号:
VERSION 5.00
Begin VB.UserControl AnimatedChart
Alignable = -1 'True
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ClientHeight = 5580
ClientLeft = 0
ClientTop = 0
ClientWidth = 8400
ForeColor = &H00FFFFFF&
ScaleHeight = 5580
ScaleWidth = 8400
ToolboxBitmap = "AnimatedChart.ctx":0000
Begin VB.Timer tmrStart
Enabled = 0 'False
Interval = 100
Left = 3600
Top = 2565
End
Begin VB.PictureBox picLegend
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00F0F5F5&
BorderStyle = 0 'None
FillColor = &H00FFF0F0&
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF7040&
Height = 5430
Left = 3360
ScaleHeight = 5430
ScaleWidth = 2250
TabIndex = 1
Top = 0
Width = 2250
Begin VB.VScrollBar vsbContainer
Height = 5445
LargeChange = 5
Left = 1995
Max = 100
TabIndex = 4
TabStop = 0 'False
Top = 0
Width = 225
End
Begin VB.PictureBox picContainer
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 5205
Left = 150
ScaleHeight = 5205
ScaleWidth = 1830
TabIndex = 2
Top = 0
Width = 1830
Begin VB.PictureBox Box
AutoRedraw = -1 'True
BackColor = &H000000C0&
BorderStyle = 0 'None
BeginProperty Font
Name = "Tahoma"
Size = 9
Charset = 178
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 45
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 6
Top = 135
Visible = 0 'False
Width = 240
End
Begin VB.Label lblDescription
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Description"
ForeColor = &H00400000&
Height = 180
Index = 0
Left = 315
TabIndex = 3
Top = 135
Visible = 0 'False
Width = 990
End
End
Begin VB.Label lblSlider
Appearance = 0 'Flat
BackColor = &H00400000&
Caption = "fg"
BeginProperty Font
Name = "Webdings"
Size = 9
Charset = 2
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0FFFF&
Height = 5430
Left = 15
TabIndex = 5
ToolTipText = "显示图例"
Top = 0
Width = 90
End
End
Begin VB.Label lblInfo
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000018&
BorderStyle = 1 'Fixed Single
Caption = $"AnimatedChart.ctx":0312
ForeColor = &H80000017&
Height = 390
Left = 0
TabIndex = 0
Top = 0
UseMnemonic = 0 'False
Visible = 0 'False
Width = 1470
End
Begin VB.Menu mnuMain
Caption = "&Main"
Visible = 0 'False
Begin VB.Menu mnuSaveAs
Caption = "另存为(&A)"
End
Begin VB.Menu mnuEditCopy
Caption = "复制(&C)"
End
Begin VB.Menu mnuSeperator
Caption = "-"
End
Begin VB.Menu mnuSelectionInfo
Caption = "图例信息(&I)"
Checked = -1 'True
End
Begin VB.Menu mnuAutoMoveInfo
Caption = "图例信息跟随(&M)"
Checked = -1 'True
End
Begin VB.Menu mnuViewLegend
Caption = "显示图例(&D)"
End
End
Begin VB.Menu mnuLegend
Caption = "图例(&L)"
Begin VB.Menu mnuLegendHide
Caption = "隐藏图例(&H)"
End
End
End
Attribute VB_Name = "AnimatedChart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2008/07/23
'描 述：支持换肤动画特效图表源代码
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
'
'**********************************************************************************
'渐变色常数
Private Const GRADIENT_FILL_RECT_H As Long = &H0
Private Const GRADIENT_FILL_RECT_V As Long = &H1
Private Const GRADIENT_FILL_TRIANGLE As Long = &H2
Private Const GRADIENT_FILL_OP_FLAG As Long = &HFF
Private Type TRIVERTEX '渐变色绘制
X As Long
Y As Long
Red As Integer
Green As Integer
Blue As Integer
Alpha As Integer
End Type
Private Type GRADIENT_RECT
UPPERLEFT As Long
LOWERRIGHT As Long
End Type
Enum GRADIENT_FILL_RECT
FillHor = GRADIENT_FILL_RECT_H
FillVer = GRADIENT_FILL_RECT_V
End Enum
Private Type GRADIENT_TRIANGLE
Vertex1 As Long
Vertex2 As Long
Vertex3 As Long
End Type
Private Declare Function GradientFillRect Lib "msimg32" Alias "GradientFill" (ByVal hDC As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function LockWindowUpdate Lib "User32" (ByVal hwndLock As Long) As Long
Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private uColumns() As Double '列栏的高度值
'决定 hittest 技术.
Private uColWidth As Double '计算栏宽
Private uRowHeight As Double '计算栏高
Private uTopMargin As Double '--------------------------------------
Private uBottomMargin As Double '图表边界.
Private uLeftMargin As Double '
Private uRightMargin As Double '--------------------------------------
Private uContentBorder As Boolean '图表内容边界
Private uSelectable As Boolean '标记表明是否用户可以选择一栏
Private uHotTracking As Boolean '标记表明可以使用热追踪
Private uSelectedColumn As Double '标记显示选取栏
Private uOldSelection As Double
Private uDisplayDescript As Boolean '选中时显示描述
Private uChartTitle As String '图表标题
Private uChartSubTitle As String '图表副标题
Private uDisplayXAxis As Boolean '显示X轴
Private uDisplayYAxis As Boolean '显示Y轴
Private uColorBars As Boolean '使用不同颜色绘制图例条(Bar)
Private uIntersectMajor As Double '主要交叉值
Private uIntersectMinor As Double '副交叉值
Private uMaxYValue As Double '默认最大Y值
Private uXAxisLabel As String '下部X轴标签
Private uYAxisLabel As String '左侧Y轴标签
Private cItems As Collection '图表内容集合
Private offsetX As Double
Private offsetY As Double
Private bLegendAdded As Boolean
Private bLegendClicked As Boolean
Private bDisplayLegend As Boolean
Private bResize As Boolean
Private bProcessingOver As Boolean '标记，以加快用鼠标移过的效果。
Public Type ChartItem
ItemID As String
SelectedDescription As String
XAxisDescription As String
Value As Double
End Type
Public Enum Theme
[ThemePersianGulf] = 0
[ThemeSky] = 1
[ThemeNeon] = 2
[ThemeNormal] = 3
End Enum
Private m_ActiveTheme As Theme
Private IsDrawedOnce As Boolean
Private IsInDrawMode As Boolean
Private Colors(15, 1) As Long
Private cItem() As String
Public Event ItemClick(cItem As ChartItem)
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Function AddItem(cItem As ChartItem) As Boolean
cItems.Add cItem
If cItem.Value > uMaxYValue Then
uMaxYValue = cItem.Value
End If
End Function
Public Function EditCopy() As Boolean
Clipboard.SetData UserControl.Image
End Function
Public Property Let MarginTop(lMargin As Double)
uTopMargin = lMargin * Screen.TwipsPerPixelY
DrawChart
End Property
Public Property Get MarginTop() As Double
MarginTop = uTopMargin / Screen.TwipsPerPixelY
End Property
Public Property Let MarginBottom(lMargin As Double)
uBottomMargin = lMargin * Screen.TwipsPerPixelY
DrawChart
End Property
Public Property Get MarginBottom() As Double
MarginBottom = uBottomMargin / Screen.TwipsPerPixelY
End Property
Public Property Let MarginLeft(lMargin As Double)
uLeftMargin = lMargin * Screen.TwipsPerPixelX
DrawChart
End Property
Public Property Get MarginLeft() As Double
MarginLeft = uLeftMargin / Screen.TwipsPerPixelX
End Property
Public Property Let MarginRight(lMargin As Double)
uRightMargin = lMargin * Screen.TwipsPerPixelX
DrawChart
End Property
Public Property Get MarginRight() As Double
MarginRight = uRightMargin / Screen.TwipsPerPixelX
End Property
Public Property Let ContentBorder(DisplayBorder As Boolean)
uContentBorder = DisplayBorder
DrawChart
End Property
Public Property Get ContentBorder() As Boolean
ContentBorder = uContentBorder
End Property
Public Property Let Selectable(EnableSelection As Boolean)
uSelectable = EnableSelection
DrawChart
End Property
Public Property Get Selectable() As Boolean
Selectable = uSelectable
End Property
Public Property Let HotTracking(UseHotTracking As Boolean)
uHotTracking = UseHotTracking
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -