开发学院软件开发VB 如何在VB中实现绘图区的大十字光标 阅读

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

 2006-02-27 21:11:42 来源:WEB开发网   
核心提示:有时,我们需要用VB快速开发一个试验数据绘图处理程序,如何在VB中实现绘图区的大十字光标,将绘图控件内的鼠标光标改变成与AutoCAD软件中使用的大十字光标的形式,将可以比普通的箭头光标达到更好的效果,OptionExplicitPRivateOld_XAsSinglePrivateOld_YAsSinglePriva
有时,我们需要用VB快速开发一个试验数据绘图处理程序,将绘图控件内的鼠标光标改变成与AutoCAD软件中使用的大十字光标的形式,将可以比普通的箭头光标达到更好的效果。那么我们如何实现这样的大十字光标呢?

----首先,我们明确一下要达到的效果,假若我们在一个Picture控件中绘图,那么,鼠标移动到这个控件上时,鼠标光标立即改变为大十字形状,光标中的横线从控件的左边界到右边界,竖线从控件的上边界到下边界,即大十字光标将绘图控件分割为四个象限。当鼠标移动到控件外时,光标则又恢复成原来的形式。

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

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

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

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

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

OptionExplicit
PRivateOld_XAsSingle
PrivateOld_YAsSingle
PrivateisMouseDownAsBoolean
PrivateBox_X0AsSingle
PrivateBox_Y0AsSingle
PrivateBox_X1AsSingle
PrivateBox_Y1AsSingle
PrivatePenColorAsLong
PrivateCrossColorAsLong

PrivateSubForm_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
EndSub

PrivateSubpicDraw_MouseDown
(ButtonAsInteger,
ShiftAsInteger,XAsSingle,YAsSingle)
IfisMouseDown=TrueThen
'先前已经用鼠标定义了一个点
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
EndIf
EndSub

PrivateSubpicDraw_MouseMove(ButtonAsInteger,
ShiftAsInteger,XAsSingle,YAsSingle)
IfisMouseDown=TrueThen
'拖动鼠标来定义矩形的另外一个顶点,
此时擦除前一个矩形,绘制新的矩形
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
EndIf
Old_X=X
Old_Y=Y
EndSub->

Tags:如何 VB 实现

编辑录入:爽爽 [复制链接] [打 印]
[]
  • 好
  • 好的评价 如果觉得好,就请您
      0%(0)
  • 差
  • 差的评价 如果觉得差,就请您
      0%(0)
赞助商链接