vb.net多功能白板（集成：绘图，编辑，批注，橡皮，图片处理，拍摄，裁剪，旋转等功能

根据上一次的自定义白板，我已经更新了很多内容了

这一次打算再细一点

初始化程序：所有的整体变量（作者提醒，请不要直接照抄代码，可以和作者发的文件进行学习和参考

    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 FunctionPublic backbmp As BitmapPublic isback As BooleanDim BodColor As ColorDim Shadow As Color''' 
''' MouseMove''' 
Dim MoveDown As Boolean = FalseDim CurrX As IntegerDim CurrY As IntegerDim MousX As IntegerDim MousY As IntegerDim x1, x2, y1, y2 As Integer''' 
''' DrawList''' 
Public g1 As GraphicsPublic penImg As BitmapDim listPoint As New List(Of Point)Dim ispaint As Boolean = TrueDim g As Graphics''' 
''' Functions and Pen''' 
Dim func As Integer = 0Dim pen As New Pen(Color.Red, 2)''' 
''' string''' 
Dim s As StringDim TxtFont As New Font("微软雅黑", 30, FontStyle.Regular)Dim fdlg As New FontDialog''' 
''' temp''' 
Public tmp As Bitmap''' 
''' Brush and Index''' 
Dim Filled As BooleanPublic index As Integer = 0''' 
''' 竖版文字还是横版''' 
Dim StrFormat As Boolean = True

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)BodColor = Color.RedShadow = Color.LightGrayFilled = FalsePanel3.Visible = FalsePanel1.Visible = FalsePic2.Visible = FalsePic.Location = New Point(0, 0)Pic.Width = Screen.PrimaryScreen.Bounds.WidthPic.Height = Screen.PrimaryScreen.Bounds.HeightpenImg = 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.ClearTypeGridFitPic.Image = penImgpen.StartCap = LineCap.Roundpen.EndCap = LineCap.Roundisback = Falseg = Pic.CreateGraphicsg.SmoothingMode = SmoothingMode.HighQualityListOfBack.Add(New Bitmap(penImg))ListOfPen.Add(New Bitmap(penImg))If My.Application.CommandLineArgs().Count > 0 ThenTryFor i = 0 To My.Application.CommandLineArgs().Count - 1Dim bmp As New Bitmap(My.Application.CommandLineArgs(i))ListOfBack.Add(New Bitmap(bmp))ListOfPen.Add(New Bitmap(bmp))Form5.penimg = ListOfPen.ToArrayForm5.backbmp = ListOfBack.ToArrayForm5.Show()Form5.TopMost = TrueNextCatch ex As ExceptionMsgBox(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.RoundEnd IfEnd 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

注意，这是用来接受用户吧文件拖到应用程序图标上，而它接受的命令数组是文件的路径，好，我们直接导入库

TryFor i = 0 To My.Application.CommandLineArgs().Count - 1Dim bmp As New Bitmap(My.Application.CommandLineArgs(i))ListOfBack.Add(New Bitmap(bmp))ListOfPen.Add(New Bitmap(bmp))Form5.penimg = ListOfPen.ToArrayForm5.backbmp = ListOfBack.ToArrayForm5.Show()Form5.TopMost = TrueNext
Catch ex As ExceptionMsgBox(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.ClickIf func = 0 ThenDim cdlg As New ColorDialogIf cdlg.ShowDialog() = DialogResult.OK ThenPic.BackColor = cdlg.ColorEnd IfEnd Iffunc = 0
End SubPrivate Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.ClickIf func = 1 ThenPanel1.Visible = TruePanel1.Location = New Point(Button3.Location.X + Panel2.Location.X, Button3.Location.Y + Panel2.Location.Y - 100)End Iffunc = 1End SubPrivate Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Clickfunc = 2
End SubPrivate Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Clickfunc = 3
End SubPrivate Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Clickfunc = 4
End SubPrivate Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Clickfunc = 5
End SubPrivate Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Clickfunc = 6
End SubPrivate Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Clickfunc = 7
End SubPrivate Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Clickfunc = 8s = 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.MouseMoveg = Pic.CreateGraphicsDim 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 ThenIf ispaint = True ThenPic.Invalidate()Pic.Update()End IfIf func = 0 ThenCurrX = Pic.Left - MousX + e.XCurrY = Pic.Top - MousY + e.YPic.Location = New Point(CurrX, CurrY)ElseIf func = 1 ThenIf Filled = False ThenlistPoint.Add(New Point(e.X, e.Y))If listPoint.Count < 3 AndAlso listPoint.Count > 1 Theng.DrawLine(pen, listPoint(0), listPoint(1))End IfIf listPoint.Count > 2 Theng.DrawCurve(pen, listPoint.ToArray(), 0.1)End IfElselistPoint.Add(New Point(e.X, e.Y))If listPoint.Count > 2 Theng.DrawCurve(pen, listPoint.ToArray(), 0.1)End IfEnd IfElseIf func = 2 ThenIf isback = True Thenx1 = e.Xy1 = e.Yg1.CompositingMode = CompositingMode.SourceCopyTryg1.DrawImage(backbmp.Clone(New Rectangle(x1 - 25, y1 - 25, 50, 50), Imaging.PixelFormat.Format32bppArgb), e.X - 25, e.Y - 25)Catch ex As ExceptionEnd TryPic2.Location = New Point(x1 + Pic.Location.X - 25, y1 + Pic.Location.Y - 25)Pic2.Width = 50Pic2.Height = 50Elsex1 = e.Xy1 = e.Yg1.CompositingMode = CompositingMode.SourceCopyg1.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 = 50Pic2.Height = 50End 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 ThenIf Filled = False Theng.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))Elseg.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 IfElseIf func = 4 ThenIf Filled = False Theng.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))Elseg.FillRectangle(New SolidBrush(pen.Color), PointList(New Point(x1, y1), New Point(e.X, e.Y)))End IfElseIf func = 5 Theng.DrawLine(pen, x1, y1, e.X, e.Y)ElseIf func = 6 ThenIf 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))Elseg.FillRectangle(New SolidBrush(pen.Color), PointListT(New Point(x1, y1), New Point(e.X, e.Y)))End IfElseIf func = 7 ThenIf Filled = False Theng.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))Elseg.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 IfElseIf func = 8 ThenIf StrFormat = True ThenDim size As Size = GetStringSize(s, TxtFont, New StringFormat(1))'If Check1.Checked = False Theng.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 Ifg.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))ElseDim 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 IfElseIf func = 9 Theng.DrawImage(tmp, e.X, e.Y)End If'Pic.Image = penImgEnd IfEnd Sub

MouseUp

Private Sub Pic_MouseUp(sender As Object, e As MouseEventArgs) Handles Pic.MouseUpg1.CompositingMode = CompositingMode.SourceCopyg1 = Graphics.FromImage(penImg)g1.SmoothingMode = SmoothingMode.HighQualityMoveDown = FalsePic2.Visible = FalseDim 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 Theng1 = Graphics.FromImage(penImg)g1.SmoothingMode = SmoothingMode.HighQualityIf Filled = False ThenlistPoint.Add(New Point(e.X, e.Y))If listPoint.Count < 3 AndAlso listPoint.Count > 1 Theng1.DrawLine(pen, listPoint(0), listPoint(1))End IfIf listPoint.Count > 2 Theng1.DrawCurve(pen, listPoint.ToArray(), 0.1)End IfElseIf listPoint.Count > 2 Theng1.FillClosedCurve(New SolidBrush(pen.Color), listPoint.ToArray(), 0.1)End IfEnd Ifispaint = TruePic.Invalidate()Pic.Update()End IfIf func = 3 ThenIf Filled = False Theng1.DrawEllipse(pen, New Rectangle(x1 - w, y1 - h, 2 * w, 2 * h))Elseg1.FillEllipse(New SolidBrush(pen.Color), New Rectangle(x1 - w, y1 - h, 2 * w, 2 * h))End IfEnd IfIf func = 4 ThenIf Filled = False Theng1.DrawRectangle(pen, PointList(New Point(x1, y1), New Point(e.X, e.Y)))Elseg1.FillRectangle(New SolidBrush(pen.Color), PointList(New Point(x1, y1), New Point(e.X, e.Y)))End IfEnd IfIf func = 5 Then'Pic.Invalidate()g1.DrawLine(pen, x1, y1, e.X, e.Y)End IfIf func = 6 ThenIf Filled = False Theng1.DrawRectangle(pen, PointListT(New Point(x1, y1), New Point(e.X, e.Y)))Elseg1.FillRectangle(New SolidBrush(pen.Color), PointListT(New Point(x1, y1), New Point(e.X, e.Y)))End IfEnd IfIf func = 7 ThenIf Filled = False Theng1.DrawEllipse(pen, New Rectangle(x1 - l, y1 - l, 2 * l, 2 * l))Elseg1.FillEllipse(New SolidBrush(pen.Color), New Rectangle(x1 - l, y1 - l, 2 * l, 2 * l))End IfEnd IfIf func = 8 ThenIf StrFormat = True Theng1 = Graphics.FromImage(penImg)g1.SmoothingMode = SmoothingMode.HighQualityg1.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFitg1.DrawString(s, TxtFont, New SolidBrush(pen.Color), New PointF(e.X, e.Y))Elseg1 = Graphics.FromImage(penImg)g1.SmoothingMode = SmoothingMode.HighQualityg1.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFitg1.DrawString(s, TxtFont, New SolidBrush(pen.Color), New PointF(e.X, e.Y), New StringFormat(2))End IfEnd IfIf func = 9 Theng1.DrawImage(tmp, e.X, e.Y)End If'MsgBox(index)ListOfPen(index) = penImgListOfBack(index) = backbmplistPoint.Clear()Pic.Image = penImg
End Sub

文字部分GetSize是通过一个函数来解决的

Public Function GetStringSize(s As String, font As Font, sf As StringFormat) As SizeDim 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.DragDropDim filepath As String() = e.Data.GetData(DataFormats.FileDrop)For i = 0 To filepath.Count - 1Dim 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.DragEnterIf e.Data.GetDataPresent(DataFormats.FileDrop) = True Thene.Effect = DragDropEffects.CopyElsee.Effect = DragDropEffects.NoneEnd If
End Sub

我在画长方形的时候只能从左上滑倒右下，其实作者编了一个函数专门来格式化2个点，然后转换为Rectangle类

Public Function PointList(p1 As Point, p2 As Point) As RectangleDim p3 As PointDim p4 As PointDim width As IntegerDim height As IntegerDim LeftTop As PointIf p1.X < p2.X AndAlso p1.Y < p2.Y Thenp3 = New Point(p2.X, p1.X)p4 = New Point(p1.X, p2.Y)width = p3.X - p1.Xheight = p4.Y - p1.YLeftTop = p1ElseIf p1.X > p2.X AndAlso p1.Y < p2.Y Thenp3 = New Point(p1.X, p2.Y)p4 = New Point(p2.X, p1.Y)width = p1.X - p4.Xheight = p2.Y - p4.YLeftTop = p4ElseIf p1.X > p2.X AndAlso p1.Y > p2.Y Thenp3 = New Point(p1.X, p2.X)p4 = New Point(p2.X, p1.Y)width = p3.X - p2.Xheight = p4.Y - p2.YLeftTop = p2ElseIf p1.X < p2.X AndAlso p1.Y > p2.Y Thenp3 = New Point(p2.X, p1.Y)p4 = New Point(p1.X, p2.Y)width = p2.X - p4.Xheight = p1.Y - p4.YLeftTop = p4End IfReturn New Rectangle(LeftTop, New Size(width, height))
End Function

正方形则同理

Public Function PointListT(p1 As Point, p2 As Point) As RectangleDim p3 As PointDim p4 As PointDim width As IntegerDim height As IntegerDim LeftTop As PointIf p1.X < p2.X AndAlso p1.Y < p2.Y Thenp3 = New Point(p2.X, p1.X)p4 = New Point(p1.X, p2.Y)width = p3.X - p1.Xheight = widthLeftTop = p1ElseIf p1.X > p2.X AndAlso p1.Y < p2.Y Thenp3 = New Point(p1.X, p2.Y)p4 = New Point(p2.X, p1.Y)width = p1.X - p4.Xheight = widthLeftTop = p4ElseIf p1.X > p2.X AndAlso p1.Y > p2.Y Thenp3 = New Point(p1.X, p2.X)p4 = New Point(p2.X, p1.Y)width = p3.X - p2.Xheight = widthLeftTop = New Point(p1.X - width, p1.Y - width)ElseIf p1.X < p2.X AndAlso p1.Y > p2.Y Thenp3 = New Point(p2.X, p1.Y)p4 = New Point(p1.X, p2.Y)width = p2.X - p4.Xheight = widthLeftTop = New Point(p1.X, p1.Y - width)End IfReturn 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 ThenIf StrFormat = True Theng1 = Graphics.FromImage(penImg)g1.SmoothingMode = SmoothingMode.HighQualityg1.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFitg1.DrawString(s, TxtFont, New SolidBrush(pen.Color), New PointF(e.X, e.Y))Elseg1 = Graphics.FromImage(penImg)g1.SmoothingMode = SmoothingMode.HighQualityg1.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFitg1.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.DirectShowPublic Class Form2Dim videodevice As FilterInfoCollectionDim videoSource As VideoCaptureDeviceDim indexof As IntegerDim Capabilities As VideoCapabilitiesPublic Sub Start(index As Integer)videodevice = New FilterInfoCollection(FilterCategory.VideoInputDevice)Listvids.Items.Clear()If videodevice.Count = 0 ThenMsgBox("没有摄像头")ElseFor Each d As FilterInfo In videodeviceListvids.Items.Add(d.Name)NextVideoPlayer.SignalToStop()VideoPlayer.WaitForStop()videoSource = New VideoCaptureDevice(videodevice(index).MonikerString)VideoPlayer.VideoSource = videoSource'videoSource.VideoPlayer.Start()TryCapabilities = videoSource.SnapshotCapabilities(index)VideoPlayer.Width = Capabilities.FrameSize.WidthVideoPlayer.Height = Capabilities.FrameSize.HeightCatch ex As ExceptionEnd TryEnd IfEnd SubPrivate Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.LoadStart(0)End SubPrivate Sub Listvids_SelectedIndexChanged(sender As Object, e As EventArgs) Handles Listvids.SelectedIndexChangedTry'MsgBox(indexof)VideoPlayer.Stop()indexof = Listvids.SelectedIndexStart(indexof)Catch ex As ExceptionMsgBox(ex.ToString)End TryEnd SubPrivate Sub Form2_Closing(sender As Object, e As CancelEventArgs) Handles Me.ClosingVideoPlayer.Stop()End SubPrivate Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.ClickPic.Image = VideoPlayer.GetCurrentVideoFrameEnd SubDim MoveDown As Boolean = FalseDim CurrX As IntegerDim CurrY As IntegerDim MousX As IntegerDim MousY As IntegerPrivate Sub VideoPlayer_MouseDown(sender As Object, e As MouseEventArgs) Handles VideoPlayer.MouseDownMousX = e.XMousY = e.YMoveDown = TrueEnd SubPrivate Sub VideoPlayer_MouseMove(sender As Object, e As MouseEventArgs) Handles VideoPlayer.MouseMoveIf MoveDown = True ThenCurrX = VideoPlayer.Left - MousX + e.XCurrY = VideoPlayer.Top - MousY + e.YVideoPlayer.Location = New Drawing.Point(CurrX, CurrY)End IfEnd SubPrivate Sub VideoPlayer_MouseUp(sender As Object, e As MouseEventArgs) Handles VideoPlayer.MouseUpMoveDown = FalseEnd SubPrivate Sub Form2_DoubleClick(sender As Object, e As EventArgs) Handles Me.DoubleClickVideoPlayer.Location = New Point(0, 0)End SubPrivate Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.ClickTryWith 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 - 1End WithClose()Catch ex As ExceptionMsgBox(ex.ToString)End TryEnd SubPrivate Sub Form2_Resize(sender As Object, e As EventArgs) Handles Me.ResizePanel1.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 SubPrivate Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.ClickDim p = VideoPlayer.GetCurrentVideoFrameDim save As New SaveFileDialogsave.Filter = "All .net Picture Files|*.jpg;*.png;*.bmp;*.ico;*.jpeg;*.*"save.InitialDirectory = Application.StartupPathDim a = save.ShowDialogIf a = DialogResult.OK Thenp.Save(save.FileName)End IfEnd SubPrivate Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.ClickPic.Image = Clipboard.GetImageForm1.ListOfBack.Add(New Bitmap(Clipboard.GetImage))Form1.ListOfPen.Add(New Bitmap(Clipboard.GetImage))End SubPrivate Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.ClickTryClipboard.SetImage(Pic.Image)Catch ex As ExceptionMsgBox(ex.ToString)End TryEnd SubPrivate Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.ClickForm1.WindowState = FormWindowState.MinimizedClose()Dim img As New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)Dim g As Graphicsg = 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 = imgForm1.WindowState = FormWindowState.MaximizedForm3.ShowDialog()'Form1.AddImage(img, img)End Sub
End Class

源代码文件下载：

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

如要转载，请与作者联系，未经许可，不准转载！

本文来自互联网用户投稿，文章观点仅代表作者本人，不代表本站立场，不承担相关法律责任。如若转载，请注明出处。 如若内容造成侵权/违法违规/事实不符，请点击【内容举报】进行投诉反馈！