土家胡子哥 發表於 2014-7-31 11:41:39

VB实现鼠标绘图实例代码

<p>本文所述为VB实现鼠标绘图的实例,该实例实现线条颜色和线宽可自设,当按下鼠标按键时绘图开始并记录最初的起点,如果不是处在绘图状态则退出该过程,如果处在绘图状态则从起点到目前鼠标所在点绘制直线,然后将当前鼠标所在点作为新的起点,当释放鼠标按键时绘图结束。</p>
<p>具体的功能代码如下:</p>
<div class="jb51code">
<pre class="brush:vb;">
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Form1
Caption   ="鼠标绘图"
ClientHeight=6420
ClientLeft   =60
ClientTop    =345
ClientWidth   =7710
LinkTopic    ="Form1"
ScaleHeight   =6420
ScaleWidth   =7710
StartUpPosition =3 '窗口缺省
Begin VB.CommandButton Command2
   Caption   ="清除"
   Height   =495
   Left      =5640
   TabIndex    =7
   Top       =1440
   Width      =1335
End
Begin VB.Frame Frame1
   Caption   ="线宽"
   Height   =2655
   Left      =5520
   TabIndex    =2
   Top       =2880
   Width      =1935
   Begin VB.OptionButton Option4
   Caption   ="8"
   Height   =495
   Left      =240
   TabIndex    =6
   Top       =1800
   Width      =1215
   End
   Begin VB.OptionButton Option3
   Caption   ="4"
   Height   =375
   Left      =240
   TabIndex    =5
   Top       =1320
   Width      =1335
   End
   Begin VB.OptionButton Option2
   Caption   ="2"
   Height   =375
   Left      =240
   TabIndex    =4
   Top       =840
   Width      =1095
   End
   Begin VB.OptionButton Option1
   Caption   ="1"
   Height   =255
   Left      =240
   TabIndex    =3
   Top       =480
   Value      =-1 'True
   Width      =1335
   End
End
Begin VB.CommandButton Command1
   Caption   ="设置颜色"
   Height   =495
   Left      =5640
   TabIndex    =1
   Top       =600
   Width      =1215
End
Begin MSComDlg.CommonDialog CommonDialog1
   Left      =4200
   Top       =3840
   _ExtentX    =847
   _ExtentY    =847
   _Version    =393216
End
Begin VB.PictureBox Picture1
   Height   =5535
   Left      =480
   ScaleHeight   =5475
   ScaleWidth   =4515
   TabIndex    =0
   Top       =480
   Width      =4575
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim x1 As Integer'起点X坐标
Dim y1 As Integer'起点Y坐标
Dim x2 As Integer'终点点X坐标
Dim y2 As Integer'终点Y坐标
Dim flag As Boolean '绘图标志
'设置线的颜色
Private Sub Command1_Click()
On Error Resume Next
CommonDialog1.CancelError = True
CommonDialog1.DialogTitle = "颜色"
CommonDialog1.ShowColor
If Err &lt;&gt; 32755 Then
    Picture1.ForeColor = CommonDialog1.Color
End If
End Sub
'清除Picture1中的图形
Private Sub Command2_Click()
Picture1.Cls
End Sub
'设置线宽
Private Sub Option1_Click()
Picture1.DrawWidth = 1
End Sub
Private Sub Option2_Click()
Picture1.DrawWidth = 2
End Sub
Private Sub Option3_Click()
Picture1.DrawWidth = 4
End Sub
Private Sub Option4_Click()
Picture1.DrawWidth = 8
End Sub
Private Sub Form_Load()
Picture1.Scale (0, 0)-(400, 400)
flag = False
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, _X As Single, Y As Single)
'当按下鼠标按键时绘图开始并记录最初的起点
flag = True
x1 = X
y1 = Y
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, _X As Single, Y As Single)
'如果不是处在绘图状态则退出该过程
'如果处在绘图状态则从起点到目前鼠标所在点绘制直线
'然后将当前鼠标所在点作为新的起点
If flag = False Then
    Exit Sub
End If
If flag = True Then
    x2 = X
    y2 = Y
    Picture1.Line (x1, y1)-(x2, y2)
    x1 = x2
    y1 = y2
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, _X As Single, Y As Single)
'当释放鼠标按键时绘图结束
flag = False
End Sub

</pre>
</div>
<p>程序中备有较为详细的注释,相信读者不难理解,读者可以根据自己的喜好对该程序进行修改,使之更加完善!</p>
                           
                            <div class="art_xg">
                              <b>您可能感兴趣的文章:</b><ul><li>VB6反编译软件VB RezQV2.4a 正式版注册码</li><li>用VBS控制鼠标的实现代码(获取鼠标坐标、鼠标移动、鼠标单击、鼠标双击、鼠标右击)</li><li>VB6.0 支持鼠标滚轮教程</li></ul>
                            </div>

                        </div>
                        <!--endmain-->
頁: [1]
查看完整版本: VB实现鼠标绘图实例代码