图形编程
我先是把采集5个通道的数据显示在text中，后来我想将这五组动态变化的数据以图形显示出来 （五条曲线用不同的颜色表示 ）怎么弄啊
BAS
程序代码：Public Type 数据画图类型
标题 As String
编号() As String 'X轴
指标() As String '几根线的名称
数据() As Double '对应每根线的数据,是一个二维数组
End Type
Public Const 边距 = 500 '用来标注数字的高度和宽度
Public Const 图例宽 = 1800
Public Const 标题高 = 1000
'Public Const 图标样 = "△ ○ □ ☆ ⊿ ◇ ▽"
'Public Const 图标样 = "▲ ● ■ ★ ◢ ◆ ▼"
'Public Const 颜色表 = "4 1 6 3 9 2 13 10 14 11 12 5"
'Public 图标样 As String
Public 颜色表 As String
Public 折线图标() As String
'--------显示用的边距---------
Public Const 左边距1 = 30
Public Const 右边距1 = 30
Public Const 上边距1 = 30
Public Const 下边距1 = 30
'--------打印用的边距--------
Public 左边距2 As Long
Public 右边距2 As Long
Public 上边距2 As Long
Public 下边距2 As Long
Public Enum 分析图类型分类
折线分析图 = 1
柱形分析图 = 2
堆柱分析图 = 3
End Enum
'Public Sub 折线图(obj As PictureBox, DD As 数据画图类型, 有效高 As Long, 有效宽 As Long, 上边距 As Long, 左边距 As Long)
'Public Sub 折线图(obj As Object, DD As 数据画图类型, 有效高 As Long, 有效宽 As Long, 上边距 As Long, 左边距 As Long)
'Public Sub 折线图(obj As Object, DD() As 数据分析类型)
'DD,传进来需要绘图的数据
Public Sub 折线图(obj As Object, DD As 数据画图类型, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long)
On Error Resume Next
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())
Dim COL() As Long
ReDim COL(数据个数)
Dim 样本数 As Long
样本数 = UBound(DD.编号) + 1
Dim Max As Double ' 0起点
Max = 找MAX(DD)
Max = Int(Max) + 1 'max= 向上取一整
Dim Y坐标间隔(10) As Long
Dim X坐标间隔() As Long
ReDim X坐标间隔(样本数)
Dim 有效高 As Long
Dim 高间隔 As Long
有效高 = obj.ScaleHeight - 上边距 - 下边距 - 标题高 - 边距
高间隔 = (有效高) / 10
Dim 有效宽 As Long
Dim 宽间隔 As Long
有效宽 = obj.ScaleWidth - 左边距 - 右边距 - 边距 '边距是用来标Y坐标的
宽间隔 = (有效宽 - 图例宽 - 150) / (样本数 + 1)
Dim i As Long, j As Long
Dim strtmp As String, k As Long
For i = 0 To 10
Y坐标间隔(i) = i * 高间隔
Next i
For i = 0 To 样本数
X坐标间隔(i) = i * 宽间隔
Next i
'读颜色
Call 颜色(COL())
'画坐标网络
Call 画坐标系(obj, 上边距, 下边距, 左边距, 右边距, Max, DD, COL())
'画图例
Call 画图例折(obj, 上边距, 下边距, 左边距, 右边距, Max, DD, COL())
'绘图
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long, k5 As Long, k6 As Long
'k1 = 左边距 + 宽间隔 + 边距
'k2 = 上边距 + 标题高 + 有效高
obj.FontSize = 8
obj.FontTransparent = False
k5 = obj.TextHeight(" ") / 2
k6 = obj.TextWidth(" ") / 2
obj.DrawWidth = 2
obj.FontSize = 8
For i = 0 To 数据个数
obj.ForeColor = COL(i)
k1 = 左边距 + 宽间隔 + 边距
k2 = 上边距 + 标题高 + 有效高 - DD.数据(0, i) / Max * 有效高
obj.CurrentX = k1 - k5
obj.CurrentY = k2 - k6
obj.Print 折线图标(i)
'obj.Circle (k1, k3), 30, COL(i) '画圆,需取消
For j = 1 To 样本数 - 1
k3 = 左边距 + 宽间隔 * (j + 1) + 边距
k4 = 上边距 + 标题高 + 有效高 - DD.数据(j, i) / Max * 有效高
obj.CurrentX = k3 - k5
obj.CurrentY = k4 - k6
obj.Print 折线图标(i)
obj.Line (k1, k2)-(k3, k4), COL(i)
k1 = k3
k2 = k4
'k = 上边距 + 标题高 + 有效高 - DD.数据(j, i) / Max * 有效高
'obj.Line -((左边距 + 宽间隔 * (j + 1)) + 边距, k), COL(i)
'obj.Circle ((左边距 + 宽间隔 * (j + 1)) + 边距, k), 30, COL(i)
Next j
Next i
obj.FontTransparent = True
'Stop
End Sub
Public Function 找MAX(DD As 数据画图类型) As Double
On Error Resume Next
Dim Max As Double ' 0起点
Dim i As Long, j As Long
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())
Dim 样本数 As Long
样本数 = UBound(DD.编号)
For i = 0 To 样本数
For j = 0 To 数据个数
If Max < DD.数据(i, j) Then
Max = DD.数据(i, j)
End If
Next j
Next i
找MAX = Max
End Function
菜单入口调用
程序代码：
Public Sub 分析3(Index As Integer)
'窗体为 list 列表形式
On Error Resume Next
Dim fr As 成分分析图
Dim fr2 As Form
Dim i As Long
For i = 0 To UBound(动态菜单)
If 动态菜单(i).名称 = MenuAnalysisXZ(Index).Caption Then
Exit For
End If
Next i
Set fr2 = ActiveForm
If fr2.List1.List(fr2.List1.ListIndex) <> "" Then '点了村
Set fr = New 成分分析图 '新建窗体
fr.Show '显示,然后把内容传进去
Call fr.分析入口(动态菜单(i).内容, fr2.List1.List(fr2.List1.ListIndex) & 动态菜单(i).名称 & "图", fr2, fr2.名称前几列)
End If
End Sub调用BAS的画图窗体代码
程序代码：Public 窗体类型 As Long
Const 标题 = "成分分析图"
Dim aa As 数据画图类型
Public 图类型 As 分析图类型分类 '画图的类型
Public 数据个数 As Long
Public 编号个数 As Long
Public Sub 分析入口(cs As String, cs2 As String, fr As Form, X名称 As Long)
'传入的参数为 对应的各个字段 ,X名称 是指前几个为X
If Len(cs) = 0 Then
MsgBox "系统错误，未取得所需的信息内容", vbCritical, 程序标题
Unload Me
Exit Sub
End If
Dim i As Long, j As Long, k As Long
Dim indexkey() As Long '保存每个指标在listview中的索引号
Dim fj() As String
fj = Split(cs, ",")
aa.标题 = cs2 '标题
Me.Caption = cs2
数据个数 = UBound(fj) '取总指标个数
ReDim aa.指标(数据个数) '重定义指标数
For i = 0 To 数据个数 '设置每个指标
aa.指标(i) = fj(i)
Next i
ReDim indexkey(数据个数) '重定义索引号位置
With fr.ListView1
'恢复序号排序
.SortKey = 0
.SortOrder = lvwAscending
.Sorted = True
For j = 0 To 数据个数
For i = 1 To .ColumnHeaders.Count
If .ColumnHeaders(i).Text = fj(j) Then '如果列标题等于text
indexkey(j) = i - 1 '第一列是 text ,相当于下标 0
Exit For
End If
Next i
Next j
j = 0
For i = 1 To .ListItems.Count
If Val(.ListItems(i).SubItems(indexkey(0))) > 0 Then '如果该行第一列有数据
j = j + 1
End If
Next i
编号个数 = j - 1
If 编号个数 < 1 Then
MsgBox "操作错误，没有发现可供绘图的数据。", vbCritical, 程序标题
Unload Me
Exit Sub
End If
ReDim aa.编号(编号个数)
ReDim aa.数据(编号个数, 数据个数)
j = 0
For i = 1 To .ListItems.Count
If Val(.ListItems(i).SubItems(indexkey(0))) > 0 Then '如果该行第一列有数据
'-------读X名称-----
For k = 1 To X名称
aa.编号(j) = aa.编号(j) & " " & .ListItems(i).SubItems(k)
Next k
aa.编号(j) = Trim(aa.编号(j))
'-------读数据----------
For k = 0 To 数据个数
aa.数据(j, k) = .ListItems(i).SubItems(indexkey(k))
Next k
j = j + 1
End If
Next i
End With
Call 画图
End Sub
Private Sub Form_Load()
图类型 = 折线分析图
窗体类型 = 分析窗体
Dim i As Long, j As String
If Len(颜色表) = 0 Then '需要读设置
颜色表 = Rini("Analysis", "颜色表", Path & configini)
j = Rini("Analysis", "折线图标", Path & configini)
ReDim 折线图标(Len(j) - 1)
For i = 0 To Len(j) - 1
折线图标(i) = Mid(j, i + 1, 1)
Next i
End If
End Sub
Public Sub 画图()
Picture1.Cls
Select Case 图类型
Case 折线分析图
Call 折线图(Picture1, aa, 上边距1, 下边距1, 左边距1, 右边距1)
Case 柱形分析图
Call 柱形图(Picture1, aa, 上边距1, 下边距1, 左边距1, 右边距1)
Case 堆柱分析图
Call 堆柱图(Picture1, aa, 上边距1, 下边距1, 左边距1, 右边距1)
End Select
End Sub
Public Sub 打印预览(fr As 打印预览)
'Dim fr As 打印预览 '打印预览窗体
' Set fr = New 打印预览
With fr
'Printer.Orientation = vbPRORLandscape '横向
打印机纸方向 = vbPRORLandscape
Call .setpage '设置纸大小
.Picture3.Cls
Select Case 图类型
Case 折线分析图
Call 折线图(.Picture3, aa, 上边距2 * 缇转厘米, 下边距2 * 缇转厘米, 左边距2 * 缇转厘米, 右边距2 * 缇转厘米)
Case 柱形分析图
Call 柱形图(.Picture3, aa, 上边距2 * 缇转厘米, 下边距2 * 缇转厘米, 左边距2 * 缇转厘米, 右边距2 * 缇转厘米)
Case 堆柱分析图
Call 堆柱图(.Picture3, aa, 上边距2 * 缇转厘米, 下边距2 * 缇转厘米, 左边距2 * 缇转厘米, 右边距2 * 缇转厘米)
End Select
Call fr.SETDATAFR(Me)
fr.Show
End With
End Sub
Public Sub 打印()
If 打印机存在 Then
Printer.Orientation = vbPRORLandscape '横向
Select Case 图类型
Case 折线分析图
Call 折线图(Printer, aa, 上边距2 * 缇转厘米, 下边距2 * 缇转厘米, 左边距2 * 缇转厘米, 右边距2 * 缇转厘米)
Case 柱形分析图
Call 柱形图(Printer, aa, 上边距2 * 缇转厘米, 下边距2 * 缇转厘米, 左边距2 * 缇转厘米, 右边距2 * 缇转厘米)
Case 堆柱分析图
Call 堆柱图(Printer, aa, 上边距2 * 缇转厘米, 下边距2 * 缇转厘米, 左边距2 * 缇转厘米, 右边距2 * 缇转厘米)
End Select
Printer.EndDoc
Else
MsgBox "错误：未发现打印机，无法打印！", vbCritical, 程序标题
End If
End Sub
[ 本帖最后由 风吹过b 于 2013-4-29 09:54 编辑 ]
顶版主
