请移步: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