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