VB实现鼠标绘图实例代码

    本文所述为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 <> 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
    
    

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