vb.net自定义白板

请移步：vb.net多功能白板（集成：绘图，编辑，批注，橡皮，图片处理，拍摄，裁剪，旋转等功能_大Mod_abfun的博客-CSDN博客

希沃白板在学校里基本上是一直使用的，但是在非希沃电脑里面是没有启动白板的

简答介绍思路和具体的功能

1、背景颜色和画笔颜色自由切换、画笔粗细1~20可以调节。

2、画笔样式：虚线、点线、短线

3、基本图形：矩形，正方形，椭圆，正圆、直线、文字

4、橡皮、加载、保存功能

注意点：

1、主要的画图模块在pic.mousemove事件里，重点

2、使用        Pic.Invalidate()
                    Pic.Update()

实现实时更新

3、drawstring在透明bitmap上绘制文字会有黑边

源代码公开一下：

Imports System.ComponentModel
Imports System.Drawing.Drawing2D
 
Public Class Form1
 
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
 
        SetStyle(ControlStyles.UserPaint, True)
        SetStyle(ControlStyles.AllPaintingInWmPaint, True)
        SetStyle(ControlStyles.DoubleBuffer, True)
 
        Filled = False
        Panel3.Visible = False
        Panel1.Visible = False
        Pic2.Visible = False
        Pic.Location = New Point(-1000, -1000)
        Pic.Width = 5000
        Pic.Height = 5000
        penImg = New Bitmap(Pic.Width, Pic.Height)
        g1 = Graphics.FromImage(penImg)
        g1.Clear(Color.Transparent)
        g1.SmoothingMode = SmoothingMode.HighQuality
        ' g1.TextRenderingHint = System.Drawing.Text.TextRenderingHint.ClearTypeGridFit
        Pic.Image = penImg
        pen.StartCap = LineCap.Round
        pen.EndCap = LineCap.Round
        If My.Application.CommandLineArgs().Count = 1 Then
            penImg = New Bitmap(My.Application.CommandLineArgs(0))
            Pic.Width = penImg.Width
            Pic.Height = penImg.Height
            g1 = Graphics.FromImage(penImg)
            'g1.Clear(Color.Transparent)
            g1.SmoothingMode = SmoothingMode.HighQuality
            Pic.Image = penImg
            pen.StartCap = LineCap.Round
            pen.EndCap = LineCap.Round
        End If
    End Sub
 
    Private Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
        ' VW.Stop()
    End Sub
 
 
    Dim MoveDown As Boolean = False
    Dim CurrX As Integer
    Dim CurrY As Integer
    Dim MousX As Integer
    Dim MousY As Integer
    Dim x1, x2, y1, y2 As Integer
    Private Sub Pic_MouseDown(sender As Object, e As MouseEventArgs) Handles Pic.MouseDown
        MousX = e.X
        MousY = e.Y
        MoveDown = True
        x1 = e.X
        y1 = e.Y
        x2 = e.X
        y2 = e.Y
    End Sub
    Dim g1 As Graphics
    Public penImg As Bitmap
    Dim listPoint As New List(Of Drawing.Point)
    Private Sub Pic_MouseMove(sender As Object, e As MouseEventArgs) Handles Pic.MouseMove
        If MoveDown = True Then
            Pic.Invalidate()
            Pic.Update()
            If func = 0 Then
                CurrX = Pic.Left - MousX + e.X
                CurrY = Pic.Top - MousY + e.Y
                Pic.Location = New Drawing.Point(CurrX, CurrY)
            ElseIf func = 1 Then
 
                listPoint.Add(New Drawing.Point(e.X, e.Y))
                If listPoint.Count > 3 Then
                    g1.DrawCurve(pen, listPoint.ToArray(), 0.1)
 
                End If
                'x1 = e.X
                '    y1 = e.Y
                '    g1.DrawLine(pen, New Point(x1, y1), New Point(x2, y2))
                '    x2 = e.X
                '    y2 = e.Y
            ElseIf func = 2 Then
                Pic2.Visible = True
                x1 = e.X
                y1 = e.Y
                g1.CompositingMode = CompositingMode.SourceCopy
                g1.FillRectangle(New SolidBrush(Color.Transparent), New Rectangle(x1 - 25, y1 - 25, 50, 50))
                Pic2.Location = New Drawing.Point(x1 + Pic.Location.X - 25, y1 + Pic.Location.Y - 25)
                Pic2.Width = 50
                Pic2.Height = 50
 
 
 
            ElseIf func = 3 Then
                If Filled = False Then
 
                    Pic.CreateGraphics.DrawEllipse(pen, New Rectangle(x1, y1, e.X - x1, e.Y - y1))
                    x2 = e.X
                    y2 = e.Y
                Else
 
                    Pic.CreateGraphics.FillEllipse(New SolidBrush(pen.Color), New Rectangle(x1, y1, e.X - x1, e.Y - y1))
                    x2 = e.X
                    y2 = e.Y
                End If
 
            ElseIf func = 4 Then
                If Filled = False Then
 
                    Pic.CreateGraphics.DrawRectangle(pen, PointList(New Point(x1, y1), New Point(e.X, e.Y)))
                    x2 = e.X
                    y2 = e.Y
                Else
 
                    Pic.CreateGraphics.FillRectangle(New SolidBrush(pen.Color), New Rectangle(x1, y1, e.X - x1, e.Y - y1))
                    x2 = e.X
                    y2 = e.Y
                End If
 
            ElseIf func = 5 Then
 
                Pic.CreateGraphics.DrawLine(pen, x1, y1, e.X, e.Y)
 
            ElseIf func = 6 Then
                If Filled = False Then
 
                    Pic.CreateGraphics.DrawRectangle(pen, PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
                    x2 = e.X
                    y2 = e.Y
                Else
 
                    Pic.CreateGraphics.FillRectangle(New SolidBrush(pen.Color), PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
                    x2 = e.X
                    y2 = e.Y
                End If
            ElseIf func = 7 Then
                If Filled = False Then
 
                    Pic.CreateGraphics.DrawEllipse(pen, PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
                    x2 = e.X
                    y2 = e.Y
                Else
 
                    Pic.CreateGraphics.FillEllipse(New SolidBrush(pen.Color), PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
                    x2 = e.X
                    y2 = e.Y
                End If
 
            ElseIf func = 8 Then
                Pic.CreateGraphics.DrawString(s, TxtFont, New SolidBrush(pen.Color), e.X, e.Y)
            End If
            'Pic.Image = penImg
 
        End If
    End Sub
 
    Private Sub Pic_MouseUp(sender As Object, e As MouseEventArgs) Handles Pic.MouseUp
        MoveDown = False
        g1.CompositingMode = CompositingMode.SourceCopy
        Pic2.Visible = False
        listPoint.Clear()
        If func = 3 Then
            If Filled = False Then
                Pic.Invalidate()
                g1.DrawEllipse(pen, New Rectangle(x1, y1, e.X - x1, e.Y - y1))
            Else
                Pic.Invalidate()
                g1.FillEllipse(New SolidBrush(pen.Color), New Rectangle(x1, y1, e.X - x1, e.Y - y1))
            End If
        End If
        If func = 4 Then
            If Filled = False Then
                Pic.Invalidate()
                g1.DrawRectangle(pen, PointList(New Point(x1, y1), New Point(e.X, e.Y)))
            Else
                Pic.Invalidate()
                g1.FillRectangle(New SolidBrush(pen.Color), New Rectangle(x1, y1, e.X - x1, e.Y - y1))
            End If
        End If
        If func = 5 Then
            Pic.Invalidate()
            g1.DrawLine(pen, x1, y1, e.X, e.Y)
        End If
        If func = 6 Then
            If Filled = False Then
                Pic.Invalidate()
                g1.DrawRectangle(pen, PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
            Else
                Pic.Invalidate()
                g1.FillRectangle(New SolidBrush(pen.Color), PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
            End If
        End If
        If func = 7 Then
            If Filled = False Then
                Pic.Invalidate()
                g1.DrawEllipse(pen, PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
            Else
                Pic.Invalidate()
                g1.FillEllipse(New SolidBrush(pen.Color), PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
            End If
 
        End If
        If func = 8 Then
            g1 = Graphics.FromImage(penImg)
            g1.SmoothingMode = SmoothingMode.HighQuality
            g1.TextRenderingHint = 5
 
            Dim stringSize As SizeF = g1.MeasureString(s, TxtFont)
            Dim bmp As New Bitmap(CInt(stringSize.Width), CInt(stringSize.Height))
            Dim gb As Graphics
            gb = Graphics.FromImage(bmp)
            If pen.Color <> Color.Black Then
                gb.Clear(Color.Black)
                gb.TextRenderingHint = 5
                gb.DrawString(s, TxtFont, New SolidBrush(pen.Color), 0, 0)
                bmp = New Bitmap(ColorReplace(bmp, Color.Black, Color.Transparent))
                g1.DrawImage(bmp, New Point(e.X, e.Y))
            ElseIf pen.Color = Color.Black Then
                gb.Clear(Color.White)
                gb.TextRenderingHint = 5
                gb.DrawString(s, TxtFont, New SolidBrush(pen.Color), 0, 0)
                bmp = New Bitmap(ColorReplace(bmp, Color.White, Color.Transparent))
                g1.DrawImage(bmp, New Point(e.X, e.Y))
            End If
 
            'g1.DrawString(s, TxtFont, New SolidBrush(pen.Color), New Point(e.X, e.Y))
        End If
        Pic.Image = penImg
    End Sub
 
 
    Public Function ColorReplace(bmp As Bitmap, OldColor As Color, NewColor As Color) As Bitmap
        Dim destImg As New Bitmap(bmp.Width, bmp.Height)
 
        Dim mycolormap(0) As Imaging.ColorMap
        mycolormap(0) = New Imaging.ColorMap()
 
        mycolormap(0).OldColor = OldColor
        mycolormap(0).NewColor = NewColor
 
        Dim imageAttributes As New Imaging.ImageAttributes()
        imageAttributes.SetRemapTable(mycolormap)
        Dim g As Graphics = Graphics.FromImage(destImg)
        g.DrawImage(bmp, New Rectangle(0, 0, bmp.Width, bmp.Height), 0, 0, bmp.Width, bmp.Height, GraphicsUnit.Pixel, imageAttributes)
 
        Return destImg
    End Function
    Dim func As Integer = 0
    Dim pen As New Pen(Color.Red, 2)
    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        If func = 0 Then
            Dim cdlg As New ColorDialog
            If cdlg.ShowDialog() = DialogResult.OK Then
                Pic.BackColor = cdlg.Color
            End If
        End If
        func = 0
    End Sub
 
    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        If func = 1 Then
            Panel1.Visible = True
            Panel1.Location = New Point(Button3.Location.X + Panel2.Location.X, Button3.Location.Y + Panel2.Location.Y - 100)
        End If
        func = 1
 
    End Sub
 
    Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
        func = 2
 
    End Sub
 
    Private Sub Form1_Resize(sender As Object, e As EventArgs) Handles Me.Resize
        Panel2.Location = New Point((Width - Panel2.Width) / 2, Height - 100)
        l.Location = New Point((Width - l.Width) / 2, (Height - l.Height) / 2)
    End Sub
 
 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Panel1.Visible = False
    End Sub
    Dim s As String
    Private Sub Pic_Click(sender As Object, e As EventArgs) Handles Pic.Click
        Panel1.Visible = False
    End Sub
 
    Private Sub RadioButton1_CheckedChanged(sender As Object, e As EventArgs) Handles R1.CheckedChanged
        If R1.Checked = True Then
            pen.Width = 2
            TrB.Value = 2
            L1.Text = 2
        End If
    End Sub
 
    Private Sub R2_CheckedChanged(sender As Object, e As EventArgs) Handles R2.CheckedChanged
        If R2.Checked = True Then
            pen.Width = 4
            TrB.Value = 4
            L1.Text = 4
        End If
    End Sub
 
    Private Sub R3_CheckedChanged(sender As Object, e As EventArgs) Handles R3.CheckedChanged
        If R3.Checked = True Then
            pen.Width = 8
            TrB.Value = 8
            L1.Text = 8
        End If
    End Sub
 
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Dim save As New SaveFileDialog
        save.Filter = "All .net Picture Files|*.jpg;*.png;*.bmp;*.ico;*.jpeg;*.*"
        save.InitialDirectory = Application.StartupPath
        Dim a = save.ShowDialog
        If a = DialogResult.OK Then
            penImg.Save(save.FileName)
        End If
    End Sub
 
    Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
        Dim cdlg As New ColorDialog
        If cdlg.ShowDialog() = DialogResult.OK Then
            pen.Color = cdlg.Color
            Button6.BackColor = cdlg.Color
        End If
    End Sub
 
    Private Sub PictureBox1_Click(sender As Object, e As EventArgs) Handles PictureBox1.Click
        pen.Color = Color.Red
        Button6.BackColor = Color.Red
    End Sub
 
    Private Sub PictureBox2_Click(sender As Object, e As EventArgs) Handles PictureBox2.Click
        pen.Color = Color.Black
        Button6.BackColor = Color.Black
    End Sub
 
    Private Sub PictureBox3_Click(sender As Object, e As EventArgs) Handles PictureBox3.Click
        pen.Color = Color.Lime
        Button6.BackColor = Color.Lime
    End Sub
 
    Private Sub PictureBox4_Click(sender As Object, e As EventArgs) Handles PictureBox4.Click
        pen.Color = Color.Cyan
        Button6.BackColor = Color.Cyan
    End Sub
 
    Private Sub PictureBox5_Click(sender As Object, e As EventArgs) Handles PictureBox5.Click
        pen.Color = Color.Blue
        Button6.BackColor = Color.Blue
    End Sub
 
    Private Sub PictureBox6_Click(sender As Object, e As EventArgs) Handles PictureBox6.Click
        pen.Color = Color.Magenta
        Button6.BackColor = Color.Magenta
    End Sub
 
    Private Sub PictureBox7_Click(sender As Object, e As EventArgs) Handles PictureBox7.Click
        pen.Color = Color.Yellow
        Button6.BackColor = Color.Yellow
    End Sub
 
    Private Sub PictureBox8_Click(sender As Object, e As EventArgs) Handles PictureBox8.Click
        pen.Color = Color.Orange
        Button6.BackColor = Color.Orange
    End Sub
 
    Private Sub TrackBar1_Scroll(sender As Object, e As EventArgs) Handles TrB.Scroll
        pen.Width = TrB.Value
        L1.Text = TrB.Value
    End Sub
 
    Private Sub PictureBox9_Click(sender As Object, e As EventArgs) Handles PictureBox9.Click
        pen.Color = Color.White
        Button6.BackColor = Color.White
    End Sub
 
    Private Sub bg1_CheckedChanged(sender As Object, e As EventArgs) Handles bg1.CheckedChanged
        If bg1.Checked = True Then
            Filled = False
        End If
    End Sub
 
    Private Sub bg2_CheckedChanged(sender As Object, e As EventArgs) Handles bg2.CheckedChanged
        If bg2.Checked = True Then
            Filled = True
        End If
    End Sub
 
    Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click
        If MsgBox("确认清屏！", vbInformation + vbYesNo, "自定义白板") = MsgBoxResult.Yes Then
            g1.Clear(Color.Transparent)
            Pic.Image = penImg
        End If
    End Sub
 
    Private Sub RadioButton1_CheckedChanged_1(sender As Object, e As EventArgs) Handles ls0.CheckedChanged
        If ls0.Checked = True Then
            pen.DashStyle = DashStyle.Solid
        End If
    End Sub
 
    Private Sub sc0_CheckedChanged(sender As Object, e As EventArgs) Handles sc0.CheckedChanged
        If sc0.Checked = True Then
            pen.StartCap = LineCap.Flat
        End If
    End Sub
 
    Private Sub sc1_CheckedChanged(sender As Object, e As EventArgs) Handles sc1.CheckedChanged
        If sc1.Checked = True Then
            pen.StartCap = LineCap.ArrowAnchor
        End If
    End Sub
 
    Private Sub sc2_CheckedChanged(sender As Object, e As EventArgs) Handles sc2.CheckedChanged
        If sc2.Checked = True Then
            pen.StartCap = LineCap.Round
        End If
    End Sub
 
    Private Sub ec0_CheckedChanged(sender As Object, e As EventArgs) Handles ec0.CheckedChanged
        If ec0.Checked = True Then
            pen.EndCap = LineCap.Flat
        End If
    End Sub
 
    Private Sub ec1_CheckedChanged(sender As Object, e As EventArgs) Handles ec1.CheckedChanged
        If ec1.Checked = True Then
            pen.EndCap = LineCap.ArrowAnchor
        End If
    End Sub
 
    Private Sub ec2_CheckedChanged(sender As Object, e As EventArgs) Handles ec2.CheckedChanged
        If ec2.Checked = True Then
            pen.EndCap = LineCap.Round
        End If
    End Sub
 
    Private Sub ls1_CheckedChanged(sender As Object, e As EventArgs) Handles ls1.CheckedChanged
        If ls1.Checked = True Then
            pen.DashStyle = DashStyle.Dot
        End If
    End Sub
 
    Private Sub ls2_CheckedChanged(sender As Object, e As EventArgs) Handles ls2.CheckedChanged
        If ls2.Checked = True Then
            pen.DashStyle = DashStyle.DashDot
        End If
    End Sub
 
    Private Sub ls3_CheckedChanged(sender As Object, e As EventArgs) Handles ls3.CheckedChanged
        If ls3.Checked = True Then
            pen.DashStyle = DashStyle.Dash
        End If
    End Sub
 
    Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click
        func = 3
    End Sub
 
    Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
        func = 4
    End Sub
 
    Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
        func = 5
    End Sub
 
    Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click
        func = 6
    End Sub
 
    Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click
        func = 7
    End Sub
 
    Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click
        func = 8
        s = InputBox("输入文字", "自定义白板")
    End Sub
 
    Private Sub Button5_MouseDown(sender As Object, e As MouseEventArgs) Handles Button5.MouseDown
        If e.Button = MouseButtons.Right Then
            If MsgBox("确认清屏！", vbInformation + vbYesNo, "自定义白板") = MsgBoxResult.Yes Then
                g1.Clear(Color.Transparent)
                Pic.Image = penImg
            End If
        End If
    End Sub
 
    Public Function PointList(p1 As Point, p2 As Point) As Rectangle
        Dim p3 As Point
        Dim p4 As Point
        Dim width As Integer
        Dim height As Integer
        Dim LeftTop As Point
 
        If p1.X < p2.X AndAlso p1.Y < p2.Y Then
            p3 = New Point(p2.X, p1.X)
            p4 = New Point(p1.X, p2.Y)
            width = p3.X - p1.X
            height = p4.Y - p1.Y
            LeftTop = p1
        ElseIf p1.X > p2.X AndAlso p1.Y < p2.Y Then
            p3 = New Point(p1.X, p2.Y)
            p4 = New Point(p2.X, p1.Y)
            width = p1.X - p4.X
            height = p2.Y - p4.Y
            LeftTop = p4
        ElseIf p1.X > p2.X AndAlso p1.Y > p2.Y Then
            p3 = New Point(p1.X, p2.X)
            p4 = New Point(p2.X, p1.Y)
            width = p3.X - p2.X
            height = p4.Y - p2.Y
            LeftTop = p2
        ElseIf p1.X < p2.X AndAlso p1.Y > p2.Y Then
            p3 = New Point(p2.X, p1.Y)
            p4 = New Point(p1.X, p2.Y)
            width = p2.X - p4.X
            height = p1.Y - p4.Y
            LeftTop = p4
        End If
        Return New Rectangle(LeftTop, New Size(width, height))
    End Function
    Dim TxtFont As New Font("微软雅黑", 30, FontStyle.Regular)
    Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click
        Dim fdlg As New FontDialog
        If fdlg.ShowDialog() = DialogResult.OK Then
            TxtFont = fdlg.Font
        End If
    End Sub
 
    Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click
        Panel3.Visible = False
    End Sub
 
    Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click
        Panel3.Visible = True
        Panel3.Location = New Point(Button8.Location.X + Panel2.Location.X, Button8.Location.Y + Panel2.Location.Y - 250)
    End Sub
 
    Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click
        Button6.PerformClick()
    End Sub
 
    Public Function PointListT(p1 As Point, p2 As Point) As Rectangle
        Dim p3 As Point
        Dim p4 As Point
        Dim width As Integer
        Dim height As Integer
        Dim LeftTop As Point
        If p1.X < p2.X AndAlso p1.Y < p2.Y Then
            p3 = New Point(p2.X, p1.X)
            p4 = New Point(p1.X, p2.Y)
            width = p3.X - p1.X
            height = width
            LeftTop = p1
        ElseIf p1.X > p2.X AndAlso p1.Y < p2.Y Then
            p3 = New Point(p1.X, p2.Y)
            p4 = New Point(p2.X, p1.Y)
            width = p1.X - p4.X
            height = width
            LeftTop = p4
        ElseIf p1.X > p2.X AndAlso p1.Y > p2.Y Then
            p3 = New Point(p1.X, p2.X)
            p4 = New Point(p2.X, p1.Y)
            width = p3.X - p2.X
            height = width
            LeftTop = New Point(p1.X - width, p1.Y - width)
        ElseIf p1.X < p2.X AndAlso p1.Y > p2.Y Then
            p3 = New Point(p2.X, p1.Y)
            p4 = New Point(p1.X, p2.Y)
            width = p2.X - p4.X
            height = width
            LeftTop = New Point(p1.X, p1.Y - width)
        End If
        Return New Rectangle(LeftTop, New Size(width, height))
    End Function
 
    Private Sub Form1_DoubleClick(sender As Object, e As EventArgs) Handles Me.DoubleClick
        Pic.Location = New Point(0, 0)
    End Sub
 
 
 
    Dim Filled As Boolean
    Dim LineStyle As Integer = 0
 
End Class

源代码文件在这：camera类其实没有用，你们自己使用可以删掉它

链接：https://pan.baidu.com/s/1Q_TAzBGJ5FtjE3UHJuvYqw?pwd=1234 
提取码：1234