VB实现鼠标绘图实例代码
本文所述为VB实现鼠标绘图的实例，该实例实现线条颜色和线宽可自设，当按下鼠标按键时绘图开始并记录最初的起点，如果不是处在绘图状态则退出该过程，如果处在绘图状态则从起点到目前鼠标所在点绘制直线，然后将当前鼠标所在点作为新的起点，当释放鼠标按键时绘图结束。
具体的功能代码如下：
VERSION5.00
Object="{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0";"comdlg32.ocx"
BeginVB.FormForm1
Caption="鼠标绘图"
ClientHeight=6420
ClientLeft=60
ClientTop=345
ClientWidth=7710
LinkTopic="Form1"
ScaleHeight=6420
ScaleWidth=7710
StartUpPosition=3'窗口缺省
BeginVB.CommandButtonCommand2
Caption="清除"
Height=495
Left=5640
TabIndex=7
Top=1440
Width=1335
End
BeginVB.FrameFrame1
Caption="线宽"
Height=2655
Left=5520
TabIndex=2
Top=2880
Width=1935
BeginVB.OptionButtonOption4
Caption="8"
Height=495
Left=240
TabIndex=6
Top=1800
Width=1215
End
BeginVB.OptionButtonOption3
Caption="4"
Height=375
Left=240
TabIndex=5
Top=1320
Width=1335
End
BeginVB.OptionButtonOption2
Caption="2"
Height=375
Left=240
TabIndex=4
Top=840
Width=1095
End
BeginVB.OptionButtonOption1
Caption="1"
Height=255
Left=240
TabIndex=3
Top=480
Value=-1'True
Width=1335
End
End
BeginVB.CommandButtonCommand1
Caption="设置颜色"
Height=495
Left=5640
TabIndex=1
Top=600
Width=1215
End
BeginMSComDlg.CommonDialogCommonDialog1
Left=4200
Top=3840
_ExtentX=847
_ExtentY=847
_Version=393216
End
BeginVB.PictureBoxPicture1
Height=5535
Left=480
ScaleHeight=5475
ScaleWidth=4515
TabIndex=0
Top=480
Width=4575
End
End
AttributeVB_Name="Form1"
AttributeVB_GlobalNameSpace=False
AttributeVB_Creatable=False
AttributeVB_PredeclaredId=True
AttributeVB_Exposed=False
Dimx1AsInteger'起点X坐标
Dimy1AsInteger'起点Y坐标
Dimx2AsInteger'终点点X坐标
Dimy2AsInteger'终点Y坐标
DimflagAsBoolean'绘图标志
'设置线的颜色
PrivateSubCommand1_Click()
OnErrorResumeNext
CommonDialog1.CancelError=True
CommonDialog1.DialogTitle="颜色"
CommonDialog1.ShowColor
IfErr<>32755Then
Picture1.ForeColor=CommonDialog1.Color
EndIf
EndSub
'清除Picture1中的图形
PrivateSubCommand2_Click()
Picture1.Cls
EndSub
'设置线宽
PrivateSubOption1_Click()
Picture1.DrawWidth=1
EndSub
PrivateSubOption2_Click()
Picture1.DrawWidth=2
EndSub
PrivateSubOption3_Click()
Picture1.DrawWidth=4
EndSub
PrivateSubOption4_Click()
Picture1.DrawWidth=8
EndSub
PrivateSubForm_Load()
Picture1.Scale(0,0)-(400,400)
flag=False
EndSub
PrivateSubPicture1_MouseDown(ButtonAsInteger,ShiftAsInteger,_XAsSingle,YAsSingle)
'当按下鼠标按键时绘图开始并记录最初的起点
flag=True
x1=X
y1=Y
EndSub
PrivateSubPicture1_MouseMove(ButtonAsInteger,ShiftAsInteger,_XAsSingle,YAsSingle)
'如果不是处在绘图状态则退出该过程
'如果处在绘图状态则从起点到目前鼠标所在点绘制直线
'然后将当前鼠标所在点作为新的起点
Ifflag=FalseThen
ExitSub
EndIf
Ifflag=TrueThen
x2=X
y2=Y
Picture1.Line(x1,y1)-(x2,y2)
x1=x2
y1=y2
EndIf
EndSub
PrivateSubPicture1_MouseUp(ButtonAsInteger,ShiftAsInteger,_XAsSingle,YAsSingle)
'当释放鼠标按键时绘图结束
flag=False
EndSub
程序中备有较为详细的注释，相信读者不难理解，读者可以根据自己的喜好对该程序进行修改，使之更加完善！