画图工具的VB实现

 ‘用户可以随意的用mouse画图，也可以引入图片，然后进行简单的处理，主要是添加两个picture控件 和几个按钮 (程序运行界面已上传到相册VB6中)

Dim x1!, v1!, x2!, v2!, a1!
Private Sub Command1_Click()                 ' 清屏的按钮
Picture2.Cls               '清屏
End Sub

Private Sub Command2_Click()                 '画笔颜色的按钮
CommonDialog1.ShowColor     ' 通过通用对话框，调用调色板选择画笔颜色
End Sub

Private Sub Command3_Click()                   '画笔粗细的按钮
a1 = Val(InputBox("请输入画笔画线的宽度（1< x < 20）:", "设置画笔画线宽度", 2))
If a1 < 1 Or a1 > 20 Then
 MsgBox "画笔画线的宽度超出范围，请重新设置！"
 Command3.Value = True                          '相当于mouse又点击了command3按钮
End If
Picture2.DrawWidth = a1
End Sub

Private Sub Command4_Click()                '打开图片的按钮
 CommonDialog1.Filter = "*.jpg|*.jpg|*.bmp|*.bmp|*.jpeg|*.jpeg|*.ico|*.ico|*.icon|*.icon"
 CommonDialog1.ShowOpen      ' 调用打开文件对话框
 If CommonDialog1.FileName <> "" Then          '将选定的图形文件加载到图片框中
   Picture2.Picture = LoadPicture(CommonDialog1.FileName)
 End If
End Sub

Private Sub Command5_Click()                '保存图片的按钮
 CommonDialog1.Filter = "*.jpg|*.jpg|*.bmp|*.bmp|*.jpeg|*.jpeg|*.ico|*.ico|*.icon|*.icon"
 CommonDialog1.ShowSave      ' 调用保存对话框
 If CommonDialog1.FileName <> "" Then
  SavePicture Picture2.Image, CommonDialog1.FileName       '保存图片
  MsgBox "照片保存成功！"
 End If
End Sub

Private Sub Command6_Click()
End
End Sub

Private Sub Command7_Click()              '背景颜色的按钮
CommonDialog1.ShowColor
Picture2.BackColor = CommonDialog1.Color
End Sub

Private Sub Command8_Click()
Text1 = Picture2.Point(X, Y)
End Sub

Private Sub Form_Load()
a1 = 2           ' 画笔粗细的初始值为2
 
 Picture2.Left = 0
 Picture2.Top = 0
 Picture2.AutoSize = True
 VScroll1.Max = Abs(Picture1.Height - Picture2.Height)
 HScroll1.Max = Abs(Picture1.Width - Picture2.Width)
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 x1 = X - 120: Y1 = Y - 120 ' 保存mouse按键时的坐标值
 x2 = X - 120: Y2 = Y - 120
 If Button = 1 Then      '如果是点击左键
    Picture2.DrawWidth = a1   ' 设置线条宽度为指定值
 ElseIf Button = 2 Then
    Picture2.DrawWidth = 1             ' 设定线条宽度为1，以画实线
    Picture2.DrawMode = 7             '设定图片框绘制模式为异或
 End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Me.MousePointer = 0             ' 设置mouse指针形状为默认的箭头
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Button = 2 Then         '按右键
    Picture2.Line (x1, Y1)-(x2, Y2), , B            '清楚以前所画矩形痕迹
    On Error Resume Next
    Picture2.DragMode = 13                          ' 设置绘制模式为复制笔
    Picture2.Line (x1, Y1)-(X - 120, Y - 120), Picture2.BackColor, BF
 End If
 
End Sub

Private Sub HScroll1_Scroll()
 Picture2.Left = HScroll1.Value
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture2.MousePointer = 99   '设置用户自定义mouse指针图标
Picture2.MouseIcon = LoadPicture(App.Path + "/pencil2.ico")  ' app.path为VB当前的工作路径
If Button = 1 Then                                           '如果按了左键
 Picture2.PSet (X - 120, Y - 120), CommonDialog1.Color       '画线
End If
If Button = 2 Then                                           ' 判断是否按了右键
   Picture2.Line (x1, Y1)-(x2, Y2), , B                      ' 清除矩形所画的痕迹
  x2 = X - 120: Y2 = Y - 120                                 '取当前坐标
  Picture2.Line (x1, Y1)-(x2, Y2), , B                    '用当前坐标重画矩形
End If
End Sub

Private Sub VScroll1_Scroll()
Picture2.Top = VScroll1.Value
End Sub