求一个支持多曲线的曲线控件

[c06940020]

求一 个比较好的。能同时显示多条曲线的控件，谢谢

[junki]

你最好用工具画好，然后再导入

[c06940020]

有什么工具能实现这种功能呢？
我现在想要的是录入一组数据，然后用曲线的方式显示出来

[迈克揉索芙特]

(声明：魏滔序原创，转贴请注明出处。)
早就想亲自DIY一个类似Windwos任务管理器中的CPU和内存的曲线图，因时间关系直到现在才如愿以偿。虽然做的粗糙点，但勉强说的过去。
功能：可以设置是否显示值刻度、网格、曲线、时间刻度等，可以定义背景颜色、网格颜色、刻度颜色、曲线颜色等，可以设置网格大小、刻度间隔、曲线进展长度，最重要的是可以支持多曲线运行。

名称：Graph
VERSION 5.00
Begin VB.UserControl Graph
AutoRedraw = -1 'True
BackColor = &H00000000&
ClientHeight = 1605
ClientLeft = 0
ClientTop = 0
ClientWidth = 2880
ForeColor = &H8000000B&
HitBehavior = 0 '无
ScaleHeight = 1605
ScaleWidth = 2880
End
Attribute VB_Name = "Graph"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_Coll() As Collection
Private m_Color() As OLE_COLOR
Private m_Time As Collection

Private m_MaxValue As Single
Private m_ScaleColor As OLE_COLOR
Private m_GridColor As OLE_COLOR
Private m_CellWidth As Single
Private m_CellHeight As Single
Private m_Spaced As Single
Private m_ValueScale As Single
Private m_TimeScale As Long

Private m_ShowGraph As Boolean
Private m_ShowGrid As Boolean
Private m_ShowValueScale As Boolean
Private m_ShowTimeScale As Boolean


'背景颜色
Public Property Get BackColor() As OLE_COLOR
BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal Value As OLE_COLOR)
UserControl.BackColor = Value
Call AddValue
PropertyChanged "BackColor"
End Property

'数字颜色
Public Property Get ScaleColor() As OLE_COLOR
ScaleColor = m_ScaleColor
End Property
Public Property Let ScaleColor(ByVal Value As OLE_COLOR)
m_ScaleColor = Value
Call AddValue
PropertyChanged "ScaleColor"
End Property

'网格颜色
Public Property Get GridColor() As OLE_COLOR
GridColor = m_GridColor
End Property
Public Property Let GridColor(ByVal Value As OLE_COLOR)
m_GridColor = Value
Call AddValue
PropertyChanged "GridColor"
End Property

'曲线是否可见
Public Property Get ShowGraph() As Boolean
ShowGraph = m_ShowGraph
End Property
Public Property Let ShowGraph(ByVal Value As Boolean)
m_ShowGraph = Value
Call AddValue
PropertyChanged "ShowGraph"
End Property

'网格是否可见
Public Property Get ShowGrid() As Boolean
ShowGrid = m_ShowGrid
End Property
Public Property Let ShowGrid(ByVal Value As Boolean)
m_ShowGrid = Value
Call AddValue
PropertyChanged "ShowGrid"
End Property

'值刻度是否可见
Public Property Get ShowValueScale() As Boolean
ShowValueScale = m_ShowValueScale
End Property
Public Property Let ShowValueScale(ByVal Value As Boolean)
m_ShowValueScale = Value
Call AddValue
PropertyChanged "ShowValueScale"
End Property

'时间刻度是否可见
Public Property Get ShowTimeScale() As Boolean
ShowTimeScale = m_ShowTimeScale
End Property
Public Property Let ShowTimeScale(ByVal Value As Boolean)
m_ShowTimeScale = Value
Call AddValue
PropertyChanged "ShowTimeScale"
End Property

'单格宽度
Public Property Get CellWidth() As Single
CellWidth = m_CellWidth
End Property
Public Property Let CellWidth(ByVal Value As Single)
m_CellWidth = Value
Call AddValue
PropertyChanged "CellWidth"
End Property

'单格宽度
Public Property Get CellHeight() As Single
CellHeight = m_CellHeight
End Property
Public Property Let CellHeight(ByVal Value As Single)
m_CellHeight = Value
Call AddValue
PropertyChanged "CellHeight"
End Property

'值间隔
Public Property Get Spaced() As Long
Spaced = m_Spaced
End Property
Public Property Let Spaced(ByVal Value As Long)
m_Spaced = Value
Call AddValue
PropertyChanged "Spaced"
End Property

'值刻度
Public Property Get ValueScale() As Long
ValueScale = m_ValueScale
End Property
Public Property Let ValueScale(ByVal Value As Long)
m_ValueScale = Value
Call AddValue
PropertyChanged "ValueScale"
End Property

'时间刻度
Public Property Get TimeScale() As Long
TimeScale = m_TimeScale
End Property
Public Property Let TimeScale(ByVal Value As Long)
m_TimeScale = Value
PropertyChanged "TimeScale"
End Property

'最大比例
Public Property Get MaxValue() As Single
MaxValue = m_MaxValue
End Property
Public Property Let MaxValue(ByVal Value As Single)
m_MaxValue = Value
Call AddValue
PropertyChanged "MaxValue"
End Property

'曲线个数
Public Property Get GraphCount() As Long
On Error Resume Next
GraphCount = UBound(m_Coll) + 1
End Property

Private Sub UserControl_Resize()
Call AddValue
End Sub

[迈克揉索芙特]

Private Sub UserControl_Show()
Call AddValue
End Sub

Private Sub UserControl_Initialize()
UserControl.ScaleMode = 3
Set m_Time = New Collection
End Sub

Private Sub UserControl_Terminate()
Dim i As Long
For i = 0 To GraphCount - 1
Set m_Coll(i) = Nothing
Next
Set m_Time = Nothing
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_ShowGraph = PropBag.ReadProperty("ShowGraph", True)
m_ShowGrid = PropBag.ReadProperty("ShowGrid", True)
m_ShowValueScale = PropBag.ReadProperty("ShowValueScale", True)
m_ShowTimeScale = PropBag.ReadProperty("ShowTimeScale", True)

UserControl.BackColor = PropBag.ReadProperty("BackColor", &H0&)
m_ScaleColor = PropBag.ReadProperty("ScaleColor", &HC0C0C0)
m_GridColor = PropBag.ReadProperty("GridColor", vbGreen)
m_CellWidth = PropBag.ReadProperty("CellWidth", 12)
m_CellHeight = PropBag.ReadProperty("CellHeight", 12)
m_Spaced = PropBag.ReadProperty("Spaced", 5)
m_ValueScale = PropBag.ReadProperty("ValueScale", 25)
m_TimeScale = PropBag.ReadProperty("TimeScale", 2)
m_MaxValue = PropBag.ReadProperty("MaxValue", 100)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("ShowGraph", m_ShowGraph, True)
Call PropBag.WriteProperty("ShowGrid", m_ShowGrid, True)
Call PropBag.WriteProperty("ShowValueScale", m_ShowValueScale, True)
Call PropBag.WriteProperty("ShowTimeScale", m_ShowTimeScale, True)

Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H0&)
Call PropBag.WriteProperty("ScaleColor", m_ScaleColor, &HFFFFFF)
Call PropBag.WriteProperty("GridColor", m_GridColor, vbGreen)
Call PropBag.WriteProperty("CellWidth", m_CellWidth, 12)
Call PropBag.WriteProperty("CellHeight", m_CellHeight, 12)
Call PropBag.WriteProperty("Spaced", m_Spaced, 5)
Call PropBag.WriteProperty("ValueScale", m_ValueScale, 25)
Call PropBag.WriteProperty("TimeScale", m_TimeScale, 2)
Call PropBag.WriteProperty("MaxValue", m_MaxValue, 100)
End Sub


Public Sub Clear()
Dim i As Long, x As Long, c As Long
c = GraphCount
For i = 0 To c - 1
For x = m_Coll(i).Count To 1 Step -1
m_Coll(i).Remove x
Next
Next

For i = m_Time.Count To 1 Step -1
m_Time.Remove i
Next
End Sub

'添加曲线
Public Sub AddGraph(ByVal Color As OLE_COLOR)
Dim i As Long
i = GraphCount - 1
i = i + 1
ReDim Preserve m_Coll(i)
ReDim Preserve m_Color(i)

Set m_Coll(i) = New Collection
m_Color(i) = Color
End Sub

'添加值
Public Sub AddValue(ParamArray Value())
Dim i As Long, YScale As Single, Index As Long
Dim t As Date, Count As Long
Dim x() As Single, y() As Single, NullPraram As Boolean

' On Local Error Resume Next
Count = GraphCount
NullPraram = UBound(Value) = -1

With UserControl
.Cls ' 清除

'网格
If m_ShowGrid Then
For i = 1 To .ScaleWidth / m_CellWidth
UserControl.Line (0, 0)-(m_CellWidth * i, .ScaleHeight), m_GridColor, B
Next
For i = 1 To .ScaleHeight / m_CellHeight
UserControl.Line (0, 0)-(.ScaleWidth, m_CellHeight * i), m_GridColor, B
Next
End If


If Count = 0 Then GoTo s:
ReDim x(Count - 1, 1)
ReDim y(Count - 1, 1)
YScale = .ScaleHeight / MaxValue

For Index = 0 To Count - 1
If Index < UBound(Value) Or NullPraram Then
If Not NullPraram Then
'保存记录
m_Coll(Index).Add Value(Index)
'删除记录
Do While m_Coll(Index).Count > .ScaleWidth / m_Spaced
m_Coll(Index).Remove 1
Loop
End If

'画线
If m_ShowGraph Then
For i = 1 To m_Coll(Index).Count
' 新点
x(Index, 1) = x(Index, 0) + m_Spaced: y(Index, 1) = m_Coll(Index)(i) * YScale
' 画线
UserControl.Line (.ScaleWidth - x(Index, 0), .ScaleHeight - y(Index, 0))-(.ScaleWidth - x(Index, 1), .ScaleHeight - y(Index, 1)), m_Color(Index)
' 旧点
x(Index, 0) = x(Index, 1): y(Index, 0) = y(Index, 1)
Next
End If
End If
Next

'横坐标
If Not NullPraram Then
t = Now
i = Format(t, "ss")
If i Mod m_TimeScale = 0 Then
m_Time.Add t
Else
m_Time.Add 0
End If
Do While m_Time.Count > .ScaleWidth / m_Spaced
m_Time.Remove 1
Loop
End If

If m_ShowTimeScale Then
For i = .ScaleWidth / m_Spaced To .ScaleWidth / m_Spaced - m_Time.Count + 1 Step -1
Index = .ScaleWidth / m_Spaced - i + 1
If Index > 0 And Index <= m_Time.Count Then
If m_Time(Index) <> 0 And m_Time(Index) <> t Then
.CurrentX = i * m_Spaced
.CurrentY = .ScaleHeight - 15
t = m_Time(Index)
UserControl.Print Format(t, "hh:nn:ss")
End If
End If
Next
End If
s:
'纵坐标
If m_ShowValueScale Then
If m_ValueScale = 0 Then Exit Sub
For i = 0 To MaxValue / m_ValueScale
.CurrentY = Int(.ScaleHeight / (MaxValue / m_ValueScale)) * i
.CurrentX = 0
UserControl.Print MaxValue - Int(MaxValue * i / (MaxValue / m_ValueScale))
Next
End If
End With
DoEvents
End Sub



使用方法：
设置好各项属性后：
Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Sub Command1()
Graph.AddGraph ColorConstants.vbRed
Graph.AddGraph ColorConstants.vbBlue
Graph.AddGraph ColorConstants.vbGreen

Dim v1, v2, v3
Do
Randomize
v1 = Int(Rnd * 100)

Randomize
v2 = Int(Rnd * 100)

Randomize
v3 = Int(Rnd * 100)

Call Graph.AddValue(v1, v2, v3, 5)

Sleep 50: DoEvents
Loop

End Sub

http://blog.csdn.net/modest/archive/2007/07/27/1711749.aspx

[c06940020]

请问，这是一个应用程序还是一 个控件呢？
请问怎么用呢？

[迈克揉索芙特]

控件

[嗷嗷叫的老马]

楼上负责解决问题

我负责接分~~~~嘿嘿

[c06940020]

这几天忙清明
不好意思了
但是你所给的那控件源码我不知道用啊。

[MatrixKnight]

我想知道的是这个控件能不能用作手工画线 ???

[Wilson-Hong]

hehe,,接分了....

[fei9999]

用teechart吧

[apisoftware]

用 Apisoft Data Analysis ActiveX
VB 曲线控件，我用的非常好。
www.apisoft.cn/vbline.htm

[apisoftware]

我们一直都用 Apisoft Data Analysis ActiveX

[dbcontrols]

还是用微软的MsChart控件吧

[flfq]

TChart不错

[meiZiNick]

这个简单啊,网上搜一下就得到答案了.

[c06940020]

解决了。谢谢

[c06940020]

解决了。谢谢

[ixuyay3]

我也想要一个

[逐渐变晕]

MsChart