整个模块都放上来了,绘图前,需要填充结构体,然后传递结构体进去。
有些也是写的配置文件,但你可以使用 常量来代替。
程序代码:
Option Explicit
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 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 堆柱图(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
obj.DrawWidth = 1
For i = 0 To 样本数 - 1
k = 0
k1 = 上边距 + 标题高 + 有效高
k2 = 左边距 + 宽间隔 * i + 宽间隔 * 0.75 + 边距
k3 = k2 + 宽间隔 * 0.5
k = k1
For j = 0 To 数据个数
k4 = DD.数据(i, j) / Max * 有效高
k = k - k4
obj.Line (k2, k)-(k3, k1), COL(j), BF
k1 = k
Next j
Next i
End Sub
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
Dim k5 As Long, k6 As Long
obj.DrawWidth = 1
k5 = (宽间隔 * 0.8) / (数据个数 + 1)
For i = 0 To 样本数 - 1
k1 = 上边距 + 标题高 + 有效高
'k2 = 左边距 + 宽间隔 * i + 宽间隔 * 0.75 + 边距
k2 = 左边距 + 边距 + 宽间隔 * i + 宽间隔 * 0.6
For j = 0 To 数据个数
k4 = DD.数据(i, j) / Max * 有效高
k3 = k2 + k5 * j
k6 = k2 + k5 * j + k5
obj.Line (k3, k1 - k4)-(k6, k1), COL(j), BF
Next j
Next i
End Sub
Public Function 找和MAX(DD As 数据画图类型) As Double
Dim Max As Double ' 0起点
Dim i As Long, j As Long
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())
Dim 样本数 As Long
样本数 = UBound(DD.单位)
Dim m As Double
For i = 0 To 样本数
m = 0
For j = 0 To 数据个数
m = m + DD.数据(i, j)
Next j
If Max < m Then
Max = m
End If
Next i
找和MAX = Max
End Function
Public Sub 颜色(cs() As Long)
On Error Resume Next
Dim i As Long, j As Long
Dim k As Long
Dim fj() As String
If InStr(1, 颜色表, ",") > 0 Then
fj = Split(颜色表, ",")
Else
fj = Split(颜色表, " ")
End If
For i = 0 To UBound(cs)
k = Val(fj(i))
If k < 14 Then
cs(i) = QBColor(k)
Else
cs(i) = k
End If
If i >= UBound(fj) Then
Exit For
End If
Next i
End Sub
Public Sub 画坐标系(obj As Object, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long, Max As Double, DD As 数据画图类型, COL() As Long)
On Error Resume Next
Dim i As Long
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long, k5 As Long
Dim strtmp As String
Dim s1() As String
Dim linecolor As Long
'-----------数据个数----------------
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())
Dim 样本数 As Long
样本数 = UBound(DD.单位) + 1
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)
For i = 0 To 10
Y坐标间隔(i) = i * 高间隔
Next i
For i = 0 To 样本数
X坐标间隔(i) = i * 宽间隔
Next i
'显示标题
obj.ForeColor = 0
obj.FontSize = 20
obj.FontBold = True
obj.CurrentX = (有效宽 - obj.TextWidth(DD.标题)) / 2 + 左边距
obj.CurrentY = 上边距 + (标题高 - obj.TextHeight(DD.标题)) / 2
obj.Print DD.标题
obj.FontBold = False
linecolor = RGB(128, 128, 128)
'画坐标系
obj.FontSize = 9
obj.DrawWidth = 1
k5 = 上边距 + 标题高
k3 = (左边距 + 宽间隔 * 样本数 + 宽间隔) + 边距
For i = 0 To 10 '横线
'obj.ForeColor = RGB(128, 128, 128)
k2 = (Y坐标间隔(i) + k5)
obj.Line (左边距 + 边距, k2)-(k3, k2), linecolor
'obj.ForeColor = 0 '显示坐标系Y
strtmp = Format(Max - Max / 10 * i, "0.0")
obj.CurrentX = 左边距 + 边距 - obj.TextWidth(strtmp) - 50
obj.CurrentY = Y坐标间隔(i) + k5 - obj.TextHeight(strtmp) / 2
obj.Print strtmp
Next i
k2 = 有效高 + k5
For i = 0 To 样本数 + 1 '竖线
'obj.ForeColor = RGB(128, 128, 128)
k1 = 左边距 + i * 宽间隔 + 边距
obj.Line (k1, k5)-(k1, k2), linecolor
If i > 0 And i < 样本数 + 1 Then '显示坐标系X
'obj.ForeColor = 0
strtmp = DD.单位(i - 1)
s1 = Split(strtmp, " ")
k1 = 宽间隔 * i + 左边距 + 边距
k4 = k2 + obj.TextHeight(strtmp) / 2
obj.CurrentY = obj.CurrentY + 30
For k3 = 0 To UBound(s1)
obj.CurrentX = k1 - obj.TextWidth(s1(k3)) / 2
obj.CurrentY = obj.CurrentY + obj.TextHeight(strtmp) * 0.2
obj.Print s1(k3)
Next k3
End If
Next i
End Sub
Public Sub 画图例(obj As Object, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long, Max As Double, DD As 数据画图类型, COL() As Long)
On Error Resume Next
Dim i As Long, j As Long
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long, k5 As Long
Dim strtmp As String
Dim s1() As String
'-----------数据个数----------------
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())
Dim 样本数 As Long
样本数 = UBound(DD.单位) + 1
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)
For i = 0 To 10
Y坐标间隔(i) = i * 高间隔
Next i
For i = 0 To 样本数
X坐标间隔(i) = i * 宽间隔
Next i
k5 = 上边距 + 标题高
'图例
'图例,双线框
obj.ForeColor = 0
k3 = 左边距 + 有效宽 + 边距 '右角
k2 = k3 - 图例宽 '左角
obj.Line (k2, k5)-(k3, k5 + 有效高), , B
obj.Line (k2 + 30, k5 + 30)-(k3 - 30, k5 + 有效高 - 30), , B
strtmp = "图 例"
obj.FontSize = 12
obj.CurrentX = k3 - (图例宽 + obj.TextWidth(strtmp)) / 2 'K3 是右角
obj.CurrentY = k5 + 高间隔
obj.Print strtmp
obj.FontSize = 9
obj.DrawWidth = 2
For i = 0 To 数据个数
If 数据个数 = 0 Then
j = k5 + 高间隔 * 4.5 + obj.TextHeight(" ") / 2
Else
j = k5 + 高间隔 * 3 + i * (高间隔 * 5 / 数据个数) + obj.TextHeight(" ") / 2
End If
obj.Line ((k3 - 图例宽 / 2 + 150), j - 50)-(k3 - 150, j + 50), COL(i), BF 'k3 为右角
If 数据个数 = 0 Then
j = k5 + 高间隔 * 4.5
Else
j = k5 + 高间隔 * 3 + i * (高间隔 * 5 / 数据个数)
End If
obj.ForeColor = 0
obj.CurrentX = k2 + 150 'k2 为左角
obj.CurrentY = j
obj.Print DD.指标(i)
Next i
End Sub
Public Sub 画图例折(obj As Object, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long, Max As Double, DD As 数据画图类型, COL() As Long)
On Error Resume Next
Dim i As Long, j As Long
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long, k5 As Long
Dim strtmp As String
Dim s1() As String
'-----------数据个数----------------
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())
Dim 样本数 As Long
样本数 = UBound(DD.单位) + 1
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)
For i = 0 To 10
Y坐标间隔(i) = i * 高间隔
Next i
For i = 0 To 样本数
X坐标间隔(i) = i * 宽间隔
Next i
k5 = 上边距 + 标题高
'图例
'图例,双线框
obj.ForeColor = 0
k3 = 左边距 + 有效宽 + 边距 '右角
k2 = k3 - 图例宽 '左角
obj.Line (k2, k5)-(k3, k5 + 有效高), , B
obj.Line (k2 + 30, k5 + 30)-(k3 - 30, k5 + 有效高 - 30), , B
strtmp = "图 例"
obj.FontSize = 12
obj.CurrentX = k3 - (图例宽 + obj.TextWidth(strtmp)) / 2 'K3 是右角
obj.CurrentY = k5 + 高间隔
obj.Print strtmp
obj.FontSize = 9
obj.DrawWidth = 2
For i = 0 To 数据个数
If 数据个数 = 0 Then
j = k5 + 高间隔 * 4.5 + obj.TextHeight(" ") / 2
Else
j = k5 + 高间隔 * 3 + i * (高间隔 * 5 / 数据个数) + obj.TextHeight(" ") / 2
End If
obj.Line ((k3 - 图例宽 / 2 + 150), j)-(k3 - 150, j), COL(i), BF 'k3 为右角
obj.ForeColor = COL(i)
obj.CurrentX = (k3 - 图例宽 / 2 + k3) / 2 - obj.TextWidth(" ") / 2
obj.CurrentY = j - obj.TextHeight(" ") / 2
obj.Print 折线图标(i)
If 数据个数 = 0 Then
j = k5 + 高间隔 * 4.5
Else
j = k5 + 高间隔 * 3 + i * (高间隔 * 5 / 数据个数)
End If
obj.ForeColor = 0
obj.CurrentX = k2 + 150 'k2 为左角
obj.CurrentY = j
obj.Print DD.指标(i)
Next i
End Sub