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绘制粗虚线的代码》结合起来，就能绘制带箭头的粗虚线。