根据上一次的自定义白板，我已经更新了很多内容了
这一次打算再细一点
初始化程序：所有的整体变量（作者提醒，请不要直接照抄代码，可以和作者发的文件进行学习和参考
Public ListOfPen As New List(Of Bitmap)
Public ListOfBack As New List(Of Bitmap)
'Function SetImage(i As Integer, picL As PicList)
' PicLists.Item(i) = picL
'End Function
'Public Function AddImage(PenImg As Bitmap, BackBmp As Bitmap)
' PicLists.Add(PicListIndex, New PicList(PenImg, BackBmp))
' PicListIndex += 1
'End Function
Public backbmp As Bitmap
Public isback As Boolean
Dim BodColor As Color
Dim Shadow As Color
''' <summary>
''' MouseMove
''' </summary>
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
''' <summary>
''' DrawList
''' </summary>
Public g1 As Graphics
Public penImg As Bitmap
Dim listPoint As New List(Of Point)
Dim ispaint As Boolean = True
Dim g As Graphics
''' <summary>
''' Functions and Pen
''' </summary>
Dim func As Integer = 0
Dim pen As New Pen(Color.Red, 2)
''' <summary>
''' string
''' </summary>
Dim s As String
Dim TxtFont As New Font("微软雅黑", 30, FontStyle.Regular)
Dim fdlg As New FontDialog
''' <summary>
''' temp
''' </summary>
Public tmp As Bitmap
''' <summary>
''' Brush and Index
''' </summary>
Dim Filled As Boolean
Public index As Integer = 0
''' <summary>
''' 竖版文字还是横版
''' </summary>
Dim StrFormat As Boolean = TruePrivate Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'SetStyle(ControlStyles.UserPaint, True)
'SetStyle(ControlStyles.AllPaintingInWmPaint, True)
'SetStyle(ControlStyles.DoubleBuffer, True)
BodColor = Color.Red
Shadow = Color.LightGray
Filled = False
Panel3.Visible = False
Panel1.Visible = False
Pic2.Visible = False
Pic.Location = New Point(0, 0)
Pic.Width = Screen.PrimaryScreen.Bounds.Width
Pic.Height = Screen.PrimaryScreen.Bounds.Height
penImg = New Bitmap(Pic.Width, Pic.Height)
backbmp = New Bitmap(penImg)
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
isback = False
g = Pic.CreateGraphics
g.SmoothingMode = SmoothingMode.HighQuality
ListOfBack.Add(New Bitmap(penImg))
ListOfPen.Add(New Bitmap(penImg))
If My.Application.CommandLineArgs().Count > 0 Then
Try
For i = 0 To My.Application.CommandLineArgs().Count - 1
Dim bmp As New Bitmap(My.Application.CommandLineArgs(i))
ListOfBack.Add(New Bitmap(bmp))
ListOfPen.Add(New Bitmap(bmp))
Form5.penimg = ListOfPen.ToArray
Form5.backbmp = ListOfBack.ToArray
Form5.Show()
Form5.TopMost = True
Next
Catch ex As Exception
MsgBox(ex.Message & vbCrLf & "————————————————————" & vbCrLf & "不支持的文件")
End Try
'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
'backbmp = New Bitmap(penImg)
'isback = True
'pen.StartCap = LineCap.Round
'pen.EndCap = LineCap.Round
End If
End Sub
BodColor = Color.Red
Shadow = Color.LightGray
还没做到实例中，暂不考虑
Pic.Width = Screen.PrimaryScreen.Bounds.Width
Pic.Height = Screen.PrimaryScreen.Bounds.Height
penImg = New Bitmap(Pic.Width, Pic.Height)
backbmp = New Bitmap(penImg)
将白板初始化为屏幕分辨率
g1 = Graphics.FromImage(penImg)
g1.Clear(Color.Transparent)
g1.SmoothingMode = SmoothingMode.HighQuality
定义Graphics类
pen.StartCap = LineCap.Round
pen.EndCap = LineCap.Round
isback = False
g = Pic.CreateGraphics
g.SmoothingMode = SmoothingMode.HighQuality
ListOfBack.Add(New Bitmap(penImg))
ListOfPen.Add(New Bitmap(penImg))
定义画笔，g1是针对PenImg的，而g针对pic控件（pictureBox）
If My.Application.CommandLineArgs().Count > 0 Then
注意，这是用来接受用户吧文件拖到应用程序图标上，而它接受的命令数组是文件的路径，好，我们直接导入库
Try
For i = 0 To My.Application.CommandLineArgs().Count - 1
Dim bmp As New Bitmap(My.Application.CommandLineArgs(i))
ListOfBack.Add(New Bitmap(bmp))
ListOfPen.Add(New Bitmap(bmp))
Form5.penimg = ListOfPen.ToArray
Form5.backbmp = ListOfBack.ToArray
Form5.Show()
Form5.TopMost = True
Next
Catch ex As Exception
MsgBox(ex.Message & vbCrLf & "————————————————————" & vbCrLf & "不支持的文件")
End Try
也可以使用For Each逐个导入。。。
我在测试的时候呢，发现一个问题，是我在导入多个图片的时候他会自己打开库（Form5），原因也很简单，我们看上面的代码段，我直接把Form5.Show写在了For循环里面了😂
我们把Form5的4行搬到For循环外面就可以了。。。
别头晕，还有好多呢。。。
先介绍Pic（PictureBox控件，用来呈现用户批注编辑的，用户可以随意的移动控件，在控件上面画画，擦除，那可想而知，最多的代码肯定在Pic.MouseMove和Pic.MouseUp这两个事件里面。
定义画笔（刷子）
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 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
0是移动，1是批注，2是橡皮，3是椭圆，4是矩形，5是直线，6是正方形。7是圆，8是文字，9是插入一张图。
MouseMove主要是在Pic上面实时更新用户绘画的数据，直到MouseUp的时候被绘制到penImg上面，PenImg是实际图片，而backbmp是初始图片，一般我们不去动初始图片
使用
Pic.Invalidate()
Pic.Update()
让控件貌似处于实时更新的状态。
Filled As Boolean 是判断用户是否需要实心图案
ok直接贴出MouseMove和MouseUp事件的代码，千万不要被吓。
MouseMove
Private Sub Pic_MouseMove(sender As Object, e As MouseEventArgs) Handles Pic.MouseMove
g = Pic.CreateGraphics
Dim w As Double = Math.Abs(x1 - e.X)
Dim h As Double = Math.Abs(y1 - e.Y)
Dim l As Double = Math.Sqrt(w * w + h * h)
If MoveDown = True Then
If ispaint = True Then
Pic.Invalidate()
Pic.Update()
End If
If func = 0 Then
CurrX = Pic.Left - MousX + e.X
CurrY = Pic.Top - MousY + e.Y
Pic.Location = New Point(CurrX, CurrY)
ElseIf func = 1 Then
If Filled = False Then
listPoint.Add(New Point(e.X, e.Y))
If listPoint.Count < 3 AndAlso listPoint.Count > 1 Then
g.DrawLine(pen, listPoint(0), listPoint(1))
End If
If listPoint.Count > 2 Then
g.DrawCurve(pen, listPoint.ToArray(), 0.1)
End If
Else
listPoint.Add(New Point(e.X, e.Y))
If listPoint.Count > 2 Then
g.DrawCurve(pen, listPoint.ToArray(), 0.1)
End If
End If
ElseIf func = 2 Then
If isback = True Then
x1 = e.X
y1 = e.Y
g1.CompositingMode = CompositingMode.SourceCopy
Try
g1.DrawImage(backbmp.Clone(New Rectangle(x1 - 25, y1 - 25, 50, 50), Imaging.PixelFormat.Format32bppArgb), e.X - 25, e.Y - 25)
Catch ex As Exception
End Try
Pic2.Location = New Point(x1 + Pic.Location.X - 25, y1 + Pic.Location.Y - 25)
Pic2.Width = 50
Pic2.Height = 50
Else
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 Point(x1 + Pic.Location.X - 25, y1 + Pic.Location.Y - 25)
Pic2.Width = 50
Pic2.Height = 50
End If
'Dim l As Double = Math.Sqrt(Math.Abs(x1 - e.X) * Math.Abs(x1 - e.X) + Math.Abs(y1 - e.Y) * Math.Abs(y1 - e.Y))
'g.DrawEllipse(pen, New Rectangle(x1 - l, y1 - l, 2 * l, 2 * l))
ElseIf func = 3 Then
If Filled = False Then
g.DrawEllipse(pen, New Rectangle(x1 - w, y1 - h, 2 * w, 2 * h))
g.DrawLine(New Pen(Color.Red, 1), New Point(x1, y1), New Point(e.X, e.Y))
g.DrawRectangle(New Pen(Color.Red, 1), New Rectangle(x1 - w, y1 - h, 2 * w, 2 * h))
Else
g.FillEllipse(New SolidBrush(pen.Color), New Rectangle(x1 - w, y1 - h, 2 * w, 2 * h))
g.DrawLine(New Pen(Color.Red, 1), New Point(x1, y1), New Point(e.X, e.Y))
g.DrawRectangle(New Pen(Color.Red, 1), New Rectangle(x1 - w, y1 - h, 2 * w, 2 * h))
End If
ElseIf func = 4 Then
If Filled = False Then
g.DrawRectangle(pen, PointList(New Point(x1, y1), New Point(e.X, e.Y)))
'g.DrawLine(New Pen(Color.Red, 1), New Point(x1, y1), New Point(e.X, e.Y))
Else
g.FillRectangle(New SolidBrush(pen.Color), PointList(New Point(x1, y1), New Point(e.X, e.Y)))
End If
ElseIf func = 5 Then
g.DrawLine(pen, x1, y1, e.X, e.Y)
ElseIf func = 6 Then
If Filled = False Then '
g.DrawRectangle(pen, PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
'g.DrawLine(New Pen(Color.Red, 1), New Point(x1, y1), New Point(e.X, e.Y))
Else
g.FillRectangle(New SolidBrush(pen.Color), PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
End If
ElseIf func = 7 Then
If Filled = False Then
g.DrawEllipse(pen, New Rectangle(x1 - l, y1 - l, 2 * l, 2 * l))
g.DrawLine(New Pen(Color.Red, 1), New Point(x1, y1), New Point(e.X, e.Y))
g.DrawRectangle(New Pen(Color.Red, 1), New Rectangle(x1 - l, y1 - l, 2 * l, 2 * l))
Else
g.FillEllipse(New SolidBrush(pen.Color), New Rectangle(x1 - l, y1 - l, 2 * l, 2 * l))
g.DrawLine(New Pen(Color.Red, 1), New Point(x1, y1), New Point(e.X, e.Y))
g.DrawRectangle(New Pen(Color.Red, 1), New Rectangle(x1 - l, y1 - l, 2 * l, 2 * l))
End If
ElseIf func = 8 Then
If StrFormat = True Then
Dim size As Size = GetStringSize(s, TxtFont, New StringFormat(1))
'If Check1.Checked = False Then
g.DrawString(s, TxtFont, New SolidBrush(pen.Color), e.X, e.Y)
'Else
' g.DrawString(s, TxtFont, New SolidBrush(Color.FromArgb(NumAlpha.Value, Shadow)), e.X + Num1.Value, e.Y + Num2.Value)
' g.DrawString(s, TxtFont, New SolidBrush(pen.Color), e.X, e.Y)
' Dim path As New GraphicsPath()
' path.AddString(s, TxtFont.FontFamily, TxtFont.Style, g.DpiY * TxtFont.Size / 72, New Rectangle(e.X, e.Y, size.Width, size.Height), New StringFormat(1))
' g.DrawPath(New Pen(BodColor, NumWidth.Value), path)
' End If
g.DrawLine(New Pen(pen.Color, 1), New Point(0, e.Y), New Point(Pic.Width, e.Y))
g.DrawLine(New Pen(pen.Color, 1), New Point(e.X, 0), New Point(e.X, Pic.Height))
g.DrawLine(New Pen(pen.Color, 1), New Point(0, e.Y + size.Height), New Point(Pic.Width, e.Y + size.Height))
g.DrawLine(New Pen(pen.Color, 1), New Point(e.X + size.Width, 0), New Point(e.X + size.Width, Pic.Height))
Else
Dim size As Size = GetStringSize(s, TxtFont, New StringFormat(2))
g.DrawString(s, TxtFont, New SolidBrush(pen.Color), e.X, e.Y, New StringFormat(2))
g.DrawLine(New Pen(pen.Color, 1), New Point(0, e.Y), New Point(Pic.Width, e.Y))
g.DrawLine(New Pen(pen.Color, 1), New Point(e.X, 0), New Point(e.X, Pic.Height))
g.DrawLine(New Pen(pen.Color, 1), New Point(0, e.Y + size.Height), New Point(Pic.Width, e.Y + size.Height))
g.DrawLine(New Pen(pen.Color, 1), New Point(e.X + size.Width, 0), New Point(e.X + size.Width, Pic.Height))
End If
ElseIf func = 9 Then
g.DrawImage(tmp, e.X, e.Y)
End If
'Pic.Image = penImg
End If
End SubMouseUp
Private Sub Pic_MouseUp(sender As Object, e As MouseEventArgs) Handles Pic.MouseUp
g1.CompositingMode = CompositingMode.SourceCopy
g1 = Graphics.FromImage(penImg)
g1.SmoothingMode = SmoothingMode.HighQuality
MoveDown = False
Pic2.Visible = False
Dim w As Double = Math.Abs(x1 - e.X)
Dim h As Double = Math.Abs(y1 - e.Y)
Dim l As Double = Math.Sqrt(w * w + h * h)
If func = 1 Then
g1 = Graphics.FromImage(penImg)
g1.SmoothingMode = SmoothingMode.HighQuality
If Filled = False Then
listPoint.Add(New Point(e.X, e.Y))
If listPoint.Count < 3 AndAlso listPoint.Count > 1 Then
g1.DrawLine(pen, listPoint(0), listPoint(1))
End If
If listPoint.Count > 2 Then
g1.DrawCurve(pen, listPoint.ToArray(), 0.1)
End If
Else
If listPoint.Count > 2 Then
g1.FillClosedCurve(New SolidBrush(pen.Color), listPoint.ToArray(), 0.1)
End If
End If
ispaint = True
Pic.Invalidate()
Pic.Update()
End If
If func = 3 Then
If Filled = False Then
g1.DrawEllipse(pen, New Rectangle(x1 - w, y1 - h, 2 * w, 2 * h))
Else
g1.FillEllipse(New SolidBrush(pen.Color), New Rectangle(x1 - w, y1 - h, 2 * w, 2 * h))
End If
End If
If func = 4 Then
If Filled = False Then
g1.DrawRectangle(pen, PointList(New Point(x1, y1), New Point(e.X, e.Y)))
Else
g1.FillRectangle(New SolidBrush(pen.Color), PointList(New Point(x1, y1), New Point(e.X, e.Y)))
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
g1.DrawRectangle(pen, PointListT(New Point(x1, y1), New Point(e.X, e.Y)))
Else
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
g1.DrawEllipse(pen, New Rectangle(x1 - l, y1 - l, 2 * l, 2 * l))
Else
g1.FillEllipse(New SolidBrush(pen.Color), New Rectangle(x1 - l, y1 - l, 2 * l, 2 * l))
End If
End If
If func = 8 Then
If StrFormat = True Then
g1 = Graphics.FromImage(penImg)
g1.SmoothingMode = SmoothingMode.HighQuality
g1.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g1.DrawString(s, TxtFont, New SolidBrush(pen.Color), New PointF(e.X, e.Y))
Else
g1 = Graphics.FromImage(penImg)
g1.SmoothingMode = SmoothingMode.HighQuality
g1.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g1.DrawString(s, TxtFont, New SolidBrush(pen.Color), New PointF(e.X, e.Y), New StringFormat(2))
End If
End If
If func = 9 Then
g1.DrawImage(tmp, e.X, e.Y)
End If
'MsgBox(index)
ListOfPen(index) = penImg
ListOfBack(index) = backbmp
listPoint.Clear()
Pic.Image = penImg
End Sub
文字部分GetSize是通过一个函数来解决的
Public Function GetStringSize(s As String, font As Font, sf As StringFormat) As Size
Dim size As New Size(CInt(g.MeasureString(s, font, 9999, sf).Width), CInt(g.MeasureString(s, font, 9999, sf).Height))
Return size
End Function
如何实现文件拖入窗体然后在库里面打开的效果呢？
Private Sub Form1_DragDrop(sender As Object, e As DragEventArgs) Handles MyBase.DragDrop
Dim filepath As String() = e.Data.GetData(DataFormats.FileDrop)
For i = 0 To filepath.Count - 1
Dim fs As New FileStream(filepath(i), FileMode.Open, FileAccess.Read)
Dim bmp As New Bitmap(fs)
ListOfBack.Add(New Bitmap(bmp))
ListOfPen.Add(New Bitmap(bmp))
fs.Close()
Next
End Sub
Private Sub Form1_DragEnter(sender As Object, e As DragEventArgs) Handles Me.DragEnter
If e.Data.GetDataPresent(DataFormats.FileDrop) = True Then
e.Effect = DragDropEffects.Copy
Else
e.Effect = DragDropEffects.None
End If
End Sub
我在画长方形的时候只能从左上滑倒右下，其实作者编了一个函数专门来格式化2个点，然后转换为Rectangle类
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
正方形则同理
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
这两段具体的解释请看：vb.net给窗体截图 （VB.net，仿照Windows原版截图，类库——9）_大Mod_abfun的博客-CSDN博客_vb.net 屏幕截图里面有详细的解释。
一个好消息就是在透明的bitmap上面话文字的时候就不会有黑边了：Drawing.Text.TextRenderingHint.AntiAliasGridFit
If func = 8 Then
If StrFormat = True Then
g1 = Graphics.FromImage(penImg)
g1.SmoothingMode = SmoothingMode.HighQuality
g1.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g1.DrawString(s, TxtFont, New SolidBrush(pen.Color), New PointF(e.X, e.Y))
Else
g1 = Graphics.FromImage(penImg)
g1.SmoothingMode = SmoothingMode.HighQuality
g1.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g1.DrawString(s, TxtFont, New SolidBrush(pen.Color), New PointF(e.X, e.Y), New StringFormat(2))
End If
End If
还有更多想要了解的，请亲自下载源代码研究和使用，目前还有一点功能没有实现
好，我们来看Form2，摄像机类（窗体），如果你的摄像机有问题的话请不要责怪代码写的不好，我在其他电脑上面试过，没有问题
此代码需要第三方类库支持：Aforge（具体请看源代码
Imports System.ComponentModel
Imports AForge.Video.DirectShow
Public Class Form2
Dim videodevice As FilterInfoCollection
Dim videoSource As VideoCaptureDevice
Dim indexof As Integer
Dim Capabilities As VideoCapabilities
Public Sub Start(index As Integer)
videodevice = New FilterInfoCollection(FilterCategory.VideoInputDevice)
Listvids.Items.Clear()
If videodevice.Count = 0 Then
MsgBox("没有摄像头")
Else
For Each d As FilterInfo In videodevice
Listvids.Items.Add(d.Name)
Next
VideoPlayer.SignalToStop()
VideoPlayer.WaitForStop()
videoSource = New VideoCaptureDevice(videodevice(index).MonikerString)
VideoPlayer.VideoSource = videoSource
'videoSource.
VideoPlayer.Start()
Try
Capabilities = videoSource.SnapshotCapabilities(index)
VideoPlayer.Width = Capabilities.FrameSize.Width
VideoPlayer.Height = Capabilities.FrameSize.Height
Catch ex As Exception
End Try
End If
End Sub
Private Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Start(0)
End Sub
Private Sub Listvids_SelectedIndexChanged(sender As Object, e As EventArgs) Handles Listvids.SelectedIndexChanged
Try
'MsgBox(indexof)
VideoPlayer.Stop()
indexof = Listvids.SelectedIndex
Start(indexof)
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Private Sub Form2_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
VideoPlayer.Stop()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Pic.Image = VideoPlayer.GetCurrentVideoFrame
End Sub
Dim MoveDown As Boolean = False
Dim CurrX As Integer
Dim CurrY As Integer
Dim MousX As Integer
Dim MousY As Integer
Private Sub VideoPlayer_MouseDown(sender As Object, e As MouseEventArgs) Handles VideoPlayer.MouseDown
MousX = e.X
MousY = e.Y
MoveDown = True
End Sub
Private Sub VideoPlayer_MouseMove(sender As Object, e As MouseEventArgs) Handles VideoPlayer.MouseMove
If MoveDown = True Then
CurrX = VideoPlayer.Left - MousX + e.X
CurrY = VideoPlayer.Top - MousY + e.Y
VideoPlayer.Location = New Drawing.Point(CurrX, CurrY)
End If
End Sub
Private Sub VideoPlayer_MouseUp(sender As Object, e As MouseEventArgs) Handles VideoPlayer.MouseUp
MoveDown = False
End Sub
Private Sub Form2_DoubleClick(sender As Object, e As EventArgs) Handles Me.DoubleClick
VideoPlayer.Location = New Point(0, 0)
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Try
With Form1
.penImg = New Bitmap(Pic.Image)
.Pic.Width = Pic.Image.Width
.Pic.Height = Pic.Image.Height
.g1 = Graphics.FromImage(Form1.penImg)
.g1.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
.Pic.Image = Pic.Image
.backbmp = New Bitmap(Pic.Image)
.isback = True
.Pic.Location = New Point(0, 0)
.ListOfBack.Add(New Bitmap(Pic.Image))
.ListOfPen.Add(New Bitmap(Pic.Image))
.index = .ListOfPen.Count - 1
End With
Close()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Private Sub Form2_Resize(sender As Object, e As EventArgs) Handles Me.Resize
Panel1.Location = New Point((Width - Panel1.Width) / 2, Height - 120)
Pic.Location = New Point(Width - Pic.Width - 50, Height - 280)
Listvids.Location = New Point(Width - Listvids.Width - 50, Height - 480)
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim p = VideoPlayer.GetCurrentVideoFrame
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
p.Save(save.FileName)
End If
End Sub
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
Pic.Image = Clipboard.GetImage
Form1.ListOfBack.Add(New Bitmap(Clipboard.GetImage))
Form1.ListOfPen.Add(New Bitmap(Clipboard.GetImage))
End Sub
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
Try
Clipboard.SetImage(Pic.Image)
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Form1.WindowState = FormWindowState.Minimized
Close()
Dim img As New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
Dim g As Graphics
g = Graphics.FromImage(img)
g.CopyFromScreen(New Point(0, 0), New Point(0, 0), New Size(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height))
Form3.pic = img
Form1.WindowState = FormWindowState.Maximized
Form3.ShowDialog()
'Form1.AddImage(img, img)
End Sub
End Class源代码文件下载：1、查看我CSDN上传的资源
2、百度网盘：链接：https://pan.baidu.com/s/1mlwiJxAMemmXAw4Qk9YSZQ?pwd=2333
提取码：2333
如要转载，请与作者联系，未经许可，不准转载，最近还是发现有大量转载的情况！！
