图形编程
我先是把采集5个通道的数据显示在text中,后来我想将这五组动态变化的数据以图形显示出来 (五条曲线用不同的颜色表示 )怎么弄啊
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
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