使用VB实现简易画图工具-优快云博客

本文链接：https://blog.youkuaiyun.com/miaozk2006/article/details/82416866

这个VB程序允许用户在picture控件上自由绘画，并提供了清屏、选择颜色和画笔粗细的功能。用户还可以打开、保存图片，改变背景颜色，并通过鼠标操作实现简单图形的绘制和擦除。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

直接上代码：

'用户可以随意的用mouse画图，也可以引入图片，然后进行简单的处理，主要是添加两个picture控件和几个按钮 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

摘自： http://blog.youkuaiyun.com/keenweiwei/article/details/3353660