标题:VB绘制粗虚线的代码
取消只看楼主
一江秋水
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2018-8-12
 问题点数:0 回复次数:0 
VB绘制粗虚线的代码
  我们知道,VB在画虚线时,线宽只能为1(DrawWidth=1),但有时候我们必须要画粗虚线,那该怎么办呢?解决这个问题的思路是:要画多宽的虚线,只要在最初那条虚线的两旁画相应数量的虚线就行了。比方说,画5个像素宽的虚线,那么就在第一根虚线的两旁再各画2根同样长的虚线即可。笔者据此编写了一段代码,与各位共享。
  新建一个窗体,上面只放置一个Line控件。代码如下:

Option Explicit

Dim BjDash As Boolean '是否画虚线:0-画实线,1-画虚线
Dim drawW As Integer  '画虚线时原先的线宽暂存
Dim editX As Integer  '鼠标初始X坐标
Dim editY As Integer  '鼠标初始Y坐标

Private Sub Form_Load()
AutoRedraw = True
ScaleMode = 3
DrawWidth = 5
Line1.BorderWidth = DrawWidth
Line1.Visible = False
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 2 Then '按【Ctrl】键单次画虚线,双次复原
  BjDash = Not BjDash
  If BjDash Then
    drawW = DrawWidth
    DrawWidth = 1
    DrawStyle = 1
  Else
    DrawWidth = drawW
    Line1.BorderWidth = DrawWidth
    DrawStyle = 0
  End If
End If
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)
Dim p As Integer, i As Integer, j As Integer
Line1.Visible = False
If BjDash Then '如果画虚线
  p = Atn((editY - Y) / (0.00001 + editX - X)) * 180 / 3.14159 '求虚线与水平线的夹角
  If p < 0 Then p = 180 + p
  For i = 0 To drawW - 1
    If p < 45 Or p > 135 Then
      Line (editX, editY + j)-(X, Y + j), 0
    Else
      Line (editX + j, editY)-(X + j, Y), 0
    End If
    If i Mod 2 = 0 Then j = Abs(j) + 1 Else j = -j
  Next
Else
  Line (editX, editY)-(X, Y), 0
End If
End Sub


  简要说明:
  操作时先设置好虚线宽(DrawWidth属性值),再按一下【Ctrl】键,表示要画虚线了,然后按下鼠标左键不放,在窗体上拖动,这时画的是实线,但只要鼠标一松,就变成了虚线。如果再次按下【Ctrl】键,就复原了原设置,后续操作只画实线不画虚线。
  Form_MouseUp过程中有一行求虚线与水平线夹角的代码,当夹角在45°—135°之间时,当作竖线,那么增加的虚线画在初始线的左右两旁,否则当作横线,增加的虚线画在初始线的上下两边。
  本代码如果与笔者发表的《VB绘制带箭头直线的代码》结合起来,就能绘制带箭头的虚线。
搜索更多相关主题的帖子: Integer 代码 End If Sub 
2023-01-27 16:30



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-511172-1-1.html




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

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