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
程序中备有较为详细的注释,相信读者不难理解,读者可以根据自己的喜好对该程序进行修改,使之更加完善!