vb教程之如何在VB中实现绘图区的大十字光标

当前位置:

首页 > 编程开发 > vb >

vb教程之如何在VB中实现绘图区的大十字光标

有时，我们需要用VB快速开发一个试验数据绘图处理程序，将绘图控件内的鼠标光标改变成与AutoCAD软件中使用的大十字光标的形式，将可以比普通的箭头光标达到更好的效果。那么我们如何实现这样的大十字光标呢？
---- 首先，我们明确一下要达到的效果，假若我们在一个Picture控件中绘图，那么，鼠标移动到这个控件上时，鼠标光标立即改变为大十字形状，光标中的横线从控件的左边界到右边界，竖线从控件的上边界到下边界，即大十字光标将绘图控件分割为四个象限。当鼠标移动到控件外时，光标则又恢复成原来的形式。

---- 要实现这样的光标，得我们自己通过画线的方式实现。如鼠标在绘图控件内，先在鼠标的当前位置画上光标的横线和竖线；当鼠标位置移动，先擦除原先的光标横线和竖线，然后再在新的位置画光标的横线和竖线，那么我们就要响应绘图控件的MouseMove事件。当然，绘图控件内无论有什么内容，我们擦除光标线和重画光标线时都不能破坏原先的内容，因此我们要将绘图控件的DrawMode设置为vbXorPen（异或方式），绘制光标的横线和竖线时，用异或的方式将横线和竖线的象素点颜色设为光标的颜色和原先的象素点色彩的异或值，再用异或的方式在同样的位置绘制一遍竖线和横线，横线和竖线上的象素点再一次和光标颜色进行异或操作，就擦除了光标的横线和竖线，且又恢复了绘图控件内原先的内容。

---- 我们还得保证鼠标移动到绘图控件内时，普通的鼠标光标消失，只有绘制的大十字光标出现，因此还应该设置绘图控件的MousePointer属性为vbCuntom，即用户自定义。绘图控件的MousePointer属性设置为vbCustom后，其MouseIcon属性中应装入相应的用户自定义图形，因为我们希望绘图控件内只有我们绘制的光标，而没有其它的光标，故应该装入一个空的（透明的）光标图形。可以任找一个光标文件，通过任意一个资源编辑器对其进行编辑，用透明的方式填充整个光标图形，保存成我们所需的NoIcon.cur即可。

---- 通过以上的关键设置和操作，我们就可以实现大十字光标了。利用异或方式进行绘图，我们还可以实现一般绘图软件中常有的“橡皮筋”效果，即用鼠标定义一个点后，动态拖动鼠标来定义另外一个点，动态拖动鼠标过程中，所要绘的图形也动态相应变化。

---- 以下我们通过一个示例来完整实现绘图控件中的大十字光标，还演示如何实现用“橡皮筋”效果来画矩形：

---- 在VB中新建一个标准EXE工程，在Form1中加入一个Picture控件，其Name设为PicDraw，可以装入一个图象文件，PicDraw的大小和其中的图象大小基本上覆盖大部分的Form1即可。实现代码如下所示。此程序在VB5.0中运行通过。

Option Explicit
Private Old_X As Single
Private Old_Y As Single
Private isMouseDown As Boolean
Private Box_X0 As Single
Private Box_Y0 As Single
Private Box_X1 As Single
Private Box_Y1 As Single
Private PenColor As Long
Private CrossColor As Long

Private Sub Form_Load()
    CrossColor = QBColor(8)
    PenColor = QBColor(15)
    picDraw.DrawMode = vbXorPen
picDraw.MouseIcon = LoadPicture
(App.Path & "\no.cur")
    picDraw.MousePointer = vbCustom
    isMouseDown = False
    Box_X0 = Box_X1 = Box_Y0 = Box_Y1 = 0
End Sub

Private Sub picDraw_MouseDown
(Button As Integer,
Shift As Integer, X As Single, Y As Single)
If isMouseDown = True Then
注释：先前已经用鼠标定义了一个点
       Box_X1 = X
       Box_Y1 = Y
       isMouseDown = False
       picDraw.DrawMode = vbCopyPen
       picDraw.Line (Box_X0, Box_Y0)-
(Box_X1, Box_Y1),
PenColor, B
       picDraw.DrawMode = vbXorPen
       注释：画一个光标
   picDraw.Line (0, Y)-(picDraw.ScaleWidth, Y),
CrossColor
  picDraw.Line (X, 0)-(X, picDraw.ScaleHeight),
CrossColor
       Old_X = X
       Old_Y = Y
    Else
       注释：定义了一个矩形的第一个顶点，则擦除光标
       picDraw.Line (0, Y)-(picDraw.ScaleWidth, Y),
CrossColor
       picDraw.Line (X, 0)-(X, picDraw.ScaleHeight),
CrossColor
       Box_X0 = X
       Box_Y0 = Y
       isMouseDown = True
    End If
End Sub

Private Sub picDraw_MouseMove(Button As Integer,
Shift As Integer, X As Single, Y As Single)
    If isMouseDown = True Then
       注释：拖动鼠标来定义矩形的另外一个顶点，
此时擦除前一个矩形，绘制新的矩形
       picDraw.Line (Box_X0, Box_Y0)-(Old_X, Old_Y),
PenColor, B
       picDraw.Line (Box_X0, Box_Y0)-(X, Y), PenColor, B
    Else
       注释：消除旧光标线
       picDraw.Line (0, Old_Y)-(picDraw.ScaleWidth, Old_Y),
CrossColor
       picDraw.Line (Old_X, 0)-(Old_X, picDraw.ScaleHeight),
CrossColor
       注释：画新的光标线
       picDraw.Line (0, Y)-(picDraw.ScaleWidth, Y),
CrossColor
       picDraw.Line (X, 0)-(X, picDraw.ScaleHeight),
CrossColor
    End If
    Old_X = X
    Old_Y = Y
End Sub

栏目列表