| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 643 人关注过本帖
标题:VB绘制带箭头直线的代码
只看楼主 加入收藏
一江秋水
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2018-8-12
收藏
 问题点数:0 回复次数:0 
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绘制粗虚线的代码》结合起来,就能绘制带箭头的粗虚线。
图片附件: 游客没有浏览图片的权限,请 登录注册

搜索更多相关主题的帖子: 直线 箭头 Sub 代码 End 
2023-01-27 16:26
快速回复:VB绘制带箭头直线的代码
数据加载中...
 
   



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

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