VB绘制带箭头直线的代码
我们在绘图时常常需要画带箭头的直线,以前我在自编的程序上画箭头时,都是先画一条直线,然后在线端点的两边各画一条短斜线,这样不但麻烦,而且画出来的箭头不标准,不好看。于是我就决定在程序中增加画箭头的代码。谁知看起来简简单单的箭头,编起程来竟然还有点复杂,还要用到几何和三角函数的有关知识!关键就是那两条短斜线尽头的坐标问题。但功夫不负有心人,经过一天的冥思苦想和反复实验,终于获得成功!现将代码与各位共享。新建一个窗体,上面只放置一个Line控件。代码如下:
Option Explicit
Const PI = 3.14159
Dim editX As Single '画线时鼠标的初始X坐标
Dim editY As Single '画线时鼠标的初始Y坐标
Dim BjArrow As Integer '箭头方向:0-无箭头,1-向上,2-向下
Private Sub Form_Load()
Line1.Visible = False
DrawWidth = 3
Line1.BorderWidth = DrawWidth
ScaleMode = 3
AutoRedraw = True
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 38: BjArrow = IIf(BjArrow <> 1, 1, 0) '向上箭头↑
Case 40: BjArrow = IIf(BjArrow <> 2, 2, 0) '向下箭头↓
End Select
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
editX = X: editY = Y
Line1.X1 = X: Line1.Y1 = Y: Line1.Visible = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.X2 = X: Line1.Y2 = Y
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.Visible = False
Line (editX, editY)-(X, Y), 0
If BjArrow = 0 Then Exit Sub '如果只画直线不带箭头退出
Dim ax!, ay!, bx!, by!, p!, p1!
p = Atn((editY - Y) / (0.00001 + editX - X)) '已知直线两点求与X轴的夹角
p1 = p * 180 / PI: If p1 < 0 Then p1 = 180 + p1
If editY = Y Then '如果是水平线
ay = Y: by = Y
ax = IIf(editX < X, editX, X): bx = IIf(editX < X, X, editX)
ElseIf editX = X Then '如果是垂直线
ax = X: bx = X
ay = IIf(editY < Y, editY, Y): by = IIf(editY < Y, Y, editY)
ElseIf p1 > 0 And p1 < 90 Then
ax = IIf(editX < X, editX, X): bx = IIf(editX < X, X, editX)
ay = IIf(editY < Y, editY, Y): by = IIf(editY < Y, Y, editY)
ElseIf p1 > 90 Then
ax = IIf(editX < X, X, editX): bx = IIf(editX < X, editX, X)
ay = IIf(editY < Y, editY, Y): by = IIf(editY < Y, Y, editY)
End If
DrawArrow ax, ay, bx, by, p1
End Sub
Private Sub DrawArrow(X1!, Y1!, X2!, Y2!, p1!)
Dim ao!, bo!, bc!, be!, ce!, p2!, p3%, L%
L = 15 '箭头的中间线长
p3 = 25 '箭头斜边线与中间线的夹角
p2 = p1 * PI / 180
bc = L * Tan(p3 * PI / 180)
Select Case BjArrow
Case 1 '向上箭头↑
bo = L * Sin(p2)
ao = L * Cos(p2)
be = bc * Cos(p2)
ce = bc * Sin(p2)
Line (X1, Y1)-(X1 + ao - ce, Y1 + bo + be), 0 '画箭头左边线
Line (X1, Y1)-(X1 + ao + ce, Y1 + bo - be), 0 '画箭头右边线
Case 2 '向下箭头↓
L = Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2) - L '由勾股定理求ab长
bo = L * Sin(p2)
ao = Abs(L * Cos(p2))
ce = bo * bc / L
be = Sqr(Abs(bc ^ 2 - ce ^ 2))
If p1 <= 90 Then
Line (X2, Y2)-(X1 + ao - ce, Y1 + bo + be), 0 '画箭头左边线
Line (X2, Y2)-(X1 + ao + ce, Y1 + bo - be), 0 '画箭头右边线
Else
Line (X2, Y2)-(X1 - ao - ce, Y1 + bo - be), 0 '画箭头左边线
Line (X2, Y2)-(X1 - ao + ce, Y1 + bo + be), 0 '画箭头右边线
End If
End Select
End Sub
简要说明:
使用时按下鼠标左键不放,在窗体上拖动,即可画出直线。如果先按【↑】键或【↓】键,则画出向上或向下的带箭头直线。如果再次按下此两键,则后续操作只画直线不画箭头。
Form_MouseUp过程中的后半部分代码,是为了保证不论用户是画向上的箭头还是向下的箭头,也不论往哪个方向画直线,近X轴的端点为a,其坐标为ax和ay,远X轴的端点为d,其坐标为dx和dy。如果是水平线,那么左端点为a,右端点为d。
DrawArrow过程中的变量L是箭头的中间线长,p3是箭头斜边线与中间线的夹角,这两个变量可根据需要更改,但建议p3的角度在15°-45°之间,否则箭头不美观。向上的箭头画在a端点,向下的箭头画在d端点。
DrawArrow过程中使用的变量的含义请自行作图,方能一目了然。
作图:在窗体上画一根长斜线,它的上端与水平线的交点为a,下端点为d,与水平线的倾角为p2。再画一根垂直线,它水平线的交点为o,与长斜线ad的交点为b。如果是向上箭头,ab=L,并以a点为角尖,在ad线左边向下画夹角为p3的短斜线,短斜线的终点为c;如果是向下箭头,bd=L,并以d点为角尖,在ad线左边向上画夹角为p3的短斜线,短斜线的终点为c。连接c点和b点,且cb⊥ad,再从c点画一根短水平线与垂直线交于e。图中,△aob~△bec。
编写代码的关键就是求c点的坐标,以及长斜线右边与c点对称的f点的坐标。
本代码如果与笔者发表的《VB绘制粗虚线的代码》结合起来,就能绘制带箭头的粗虚线。