# picturebox的ToolTipText难题

rkdrc 2010-03-21 10:15:45
Public Sub Columnchart(obj As PictureBox, up As Single, down As Single, arry() As Single)
Dim u As Integer
Dim d As Integer
Dim m As Integer
Dim vone As Single
Dim hone As Single
Dim i As Integer
obj.Cls '清空绘图区域
obj.AutoRedraw = True
If Maxp(Max(arry()), up) <= 0 Then '上极限
u = 0
Else
u = Fix(Maxp(Max(arry()), up)) + 1
End If

If Minp(Min(arry()), down) >= 0 Then '下极限
d = 0
Else
d = Fix(Minp(Min(arry()), down)) - 1
End If

m = UBound(arry) + 1 '数据数量
vone = (u + Abs(d)) / 20 '固定垂直方向间隙
hone = m / 20 '固定水平方向间隙

obj.Scale (-2 * hone, u + vone)-(m + hone, d - vone) '设置坐标系
obj.DrawWidth = 1 '设置线宽
obj.Line (0, 0)-(m, 0) '绘制横轴
obj.Line (0, d)-(0, u) '绘制纵轴
obj.CurrentX = -2 * hone: obj.CurrentY = 0 '输出原点
obj.Print 0

For i = 0 To m - 1 '绘制横轴刻度
obj.Line (i + 1, 0)-(i + 1, vone / 4)
Next i

If u > 0 Then '绘制纵轴正部分刻度及数值
For i = 0 To 2 * u - 1
obj.Line (0, (i + 1) * 0.5)-(hone / 3, (i + 1) * 0.5)
obj.CurrentX = -2 * hone: obj.CurrentY = 0.5 * (i + 1)
obj.Print 0.5 * (i + 1)
Next i
End If

If d < 0 Then '绘制纵轴负部分刻度及数值
For i = 0 To 2 * Abs(d) - 1
obj.Line (0, -(i + 1) * 0.5)-(hone / 3, -(i + 1) * 0.5)
obj.CurrentX = -2 * hone: obj.CurrentY = -0.5 * (i + 1)
obj.Print -0.5 * (i + 1)
Next i
End If

obj.DrawStyle = 0
obj.Line (0, up)-(m, up), vbRed '绘制上公差线
obj.Line (0, down)-(m, down), vbRed '绘制下公差线
obj.DrawStyle = 2 '设置为虚线
obj.Line (0, up * 0.75)-(m, up * 0.75) '绘制上公差3/4线
obj.Line (0, down * 0.75)-(m, down * 0.75) '绘制下公差3/4线
obj.DrawStyle = 0
For i = 0 To m - 1 '根据是否超过上下公差绘制直方图
If arry(i) > up Then
obj.Line (i + 0.25, 0)-(i + 0.75, arry(i)), vbRed, BF
ElseIf arry(i) < down Then
obj.Line (i + 0.25, 0)-(i + 0.75, arry(i)), vbYellow, BF
Else
obj.Line (i + 0.25, 0)-(i + 0.75, arry(i)), vbGreen, BF
End If
Next i
End Sub

If (X >= (i + 0.25) And X <= (i + 0.75)) And ((Y >= 0 And Y <= arry(i)) Or (Y <= 0 And Y >= arry(i))) Then
obj.ToolTipText = arry(i)
Else
obj.ToolTipText = ""
End If

...全文
94 3 打赏 收藏 转发到动态 举报

3 条回复

rkdrc 2010-03-22
• 打赏
• 举报

[Quote=引用楼主 rkdrc 的回复:]
Public Sub Columnchart(obj As PictureBox, up As Single, down As Single, arry() As Single)
Dim u As Integer
Dim d As Integer
Dim m As Integer
Dim vone As Single
Dim hone As Single
Dim i As Intege……
[/Quote]
mschart很难达到我的要求，所以自己做了个
clear_zero 2010-03-22
• 打赏
• 举报

threenewbee 2010-03-22
• 打赏
• 举报

lz精神可嘉，问题是为什么不使用MSChart来生成统计图呢。

1,451

• 近7日
• 近30日
• 至今