回 帖 发 新 帖 刷新版面

主题: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绘制粗虚线的代码》结合起来,就能绘制带箭头的粗虚线,这就当作留给各位的家庭作业吧。


注:本代码的工程和窗体文件请到163信箱下载,帐号:vb62013.163.com,密码:vb620132013

回复列表 (共1个回复)

沙发

汽車資訊是關於汽車的相關資訊和數據,包括汽車的品牌、型號、車系、售價、燃料效率、車體尺寸、車輛性能、安全性能等等。汽車資訊通常可以在汽車廠商的官方網站、汽車網站、汽車評測網站和汽車雜誌等媒體上獲得。這些資訊對於汽車消費者來說非常重要,因為它們可以幫助消費者做出更明智的選擇,比如選擇一款適合自己需求的車型、選擇性價比較高的車款等等。同時,汽車資訊也對汽車廠商、經銷商和其他汽車相關產業的從業人員來說,是了解市場趨勢和客戶需求的重要參考依據。

我来回复

您尚未登录,请登录后再回复。点此登录或注册