| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1119 人关注过本帖
标题:红条在R1的中间怎么设置?
只看楼主 加入收藏
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
结帖率:89.13%
收藏
 问题点数:0 回复次数:6 
红条在R1的中间怎么设置?
图片附件: 游客没有浏览图片的权限,请 登录注册


红条在R1的中间怎么设置?
将R1-R25间距设置再小一点,怎么设置?

当前代码:

Private Sub Form_Load()
    Randomize Timer
    Dim i As Integer, jls As Integer
    Dim Values(1 To 25, 1 To 3)
    For i = 1 To 15
        Values(i, 1) = "T" & Format(i, "00")
    Next i
   
    For i = 1 To 25
        Values(i, 1) = Rnd * 1000 '以下两个赋相同的值就行了。
    Next i

    MSChart1.chartType = VtChChartType2dCombination
    MSChart1.Plot.SeriesCollection.Item(1).SeriesType = VtChSeriesType2dBar
    MSChart1.ChartData = Values
End Sub
搜索更多相关主题的帖子: Integer Next Dim For Values 
2023-01-30 14:11
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
你这代码 打算 转个方向 写吗?

https://bbs.bccn.net/thread-511100-1-1.html  7楼的有代码  
把不要的东西删掉,然后 精减一下结构体就是了。柱形图太宽,自己改小一点。
想加啥就加啥,


授人于鱼,不如授人于渔
早已停用QQ了
2023-01-30 18:42
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
收藏
得分:0 
回复 2楼 风吹过b
复制来的代码,随便改了一下。

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2023-01-30 19:48
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
打算重写一个 专画柱形图的,不要那么多的结构体元素。主要那个结构体对应的是那个贴子1楼的数据。我不会计算。
不急,最近时间都比较少。

授人于鱼,不如授人于渔
早已停用QQ了
2023-01-30 20:23
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
收藏
得分:0 
回复 4楼 风吹过b
1、导入数据,直接显示柱形图

2、导入数据,直接显示折线图,可显示一条或多条不同颜色的折线

能做出来上面两种可以做数据分析,很有意义。

目前还没有这种好用的控件。也在找。

直接用画图的方法实现,很多东西不可以调整。逻辑会非常复杂。

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2023-01-31 11:37
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
1+2 ,再加上堆柱图,我以前实现过。直接在一个界面里切换的。并且支持打印。
   但那个代码找不到了。
现在没法截图给你,程序我发回家看看还能运行吗 。

授人于鱼,不如授人于渔
早已停用QQ了
2023-01-31 15:09
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
找到的以前的代码,BAS文件贴在最后
调用函数示例。
有二个值写在配置文件里,
[Analysis]
折线图标=▲●■★◢◆▼
颜色表=128,8388608,32896,8421376,16711680,32768,16711935

图就不截了,难打码。代码不解释了,代码写于 2015年,自己也忘了
只知道数据是从 指定窗体的 listview 中读取的,生成一个二维数组,然后去绘图。

程序代码:
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

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




-------BAS文件---------
程序代码:
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


授人于鱼,不如授人于渔
早已停用QQ了
2023-01-31 20:37
快速回复:红条在R1的中间怎么设置?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.056798 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved