如何在图像上绘制矩形并将其保存在 VB.Net
How to draw a rectangle over an image and save it in VB.Net
我已经使用以下代码在图像上绘制了一个矩形,但我无法保存带有突出显示矩形的图像。仅保存原始图像,不保存带有矩形的图像。请帮我解决这个问题。
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
IsMouseDown = True
SelectedObjPoint = New Point(e.X, e.Y)
End If
End Sub
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
If IsMouseDown = True Then
If e.X < SelectionBoxObj.X Then
SelectionBoxObj.X = e.X
SelectionBoxObj.Width = SelectedObjPoint.X - e.X
Else
SelectionBoxObj.X = SelectedObjPoint.X
SelectionBoxObj.Width = e.X - SelectedObjPoint.X
End If
If e.Y < SelectedObjPoint.Y Then
SelectionBoxObj.Y = e.Y
SelectionBoxObj.Height = SelectedObjPoint.Y - e.Y
Else
SelectionBoxObj.Y = SelectedObjPoint.Y
SelectionBoxObj.Height = e.Y - SelectedObjPoint.Y
End If
Me.Refresh()
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
IsMouseDown = False
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
If SelectionBoxObj.Width > 0 And SelectionBoxObj.Height > 0 Then
Dim oGradientBrush As Brush = New Drawing.Drawing2D.LinearGradientBrush(SelectionBoxObj.RectangleF, SelectionBoxObj.FillColor, SelectionBoxObj.FillColor, Drawing.Drawing2D.LinearGradientMode.Vertical)
e.Graphics.FillRectangle(oGradientBrush, SelectionBoxObj.RectangleF)
Dim TempPen = New Pen(SelectionBoxObj.BorderLineColor, SelectionBoxObj.BorderLineWidth)
TempPen.DashStyle = SelectionBoxObj.BorderLineType
e.Graphics.DrawRectangle(TempPen, SelectionBoxObj.RectangleF.X, SelectionBoxObj.RectangleF.Y, SelectionBoxObj.RectangleF.Width, SelectionBoxObj.RectangleF.Height)
End If
End Sub
Private Sub Highlight_Ok_Click(sender As Object, e As EventArgs) Handles Highlight_Ok.Click
Dim datestring As String = Date.Now.ToString("yyyyMMddmmss")
Dim path As String = "D:\capture screenshot temp"
Dim currentsavepath As String = String.Format("{0}\capture_{1}.png", path, datestring)
PictureBox1.Image.Save(currentsavepath, Imaging.ImageFormat.Bmp)
End Sub
您在 PictureBox 中绘制的矩形是临时绘制的。它显示当前图像,并在其顶部绘制矩形。但是当你保存图像时,矩形不是图像的一部分。
您可以通过将绘图例程移动到一个过程中来补救您的情况,该过程将在您传递给它的图形对象中绘制结果:
Private Sub DrawHighlight(g As Graphics)
If SelectionBoxObj.Width > 0 And SelectionBoxObj.Height > 0 Then
Using br As New SolidBrush(SelectionBoxObj.FillColor)
g.FillRectangle(br, SelectionBoxObj.RectangleF)
End Using
Using p As New Pen(SelectionBoxObj.BorderLineColor, SelectionBoxObj.BorderLineWidth)
g.DrawRectangle(p, SelectionBoxObj.RectangleF)
End Using
End If
End Sub
现在您可以轻松更新屏幕了:
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
DrawHighlight(e.Graphics)
End Sub
您可以保存最终结果:
Using bmp As New Bitmap(PictureBox1.Image)
Using g As Graphics = Graphics.FromImage(bmp)
DrawHighlight(g)
End Using
bmp.Save(currentsavepath, Imaging.ImageFormat.Bmp)
End Using
我已经使用以下代码在图像上绘制了一个矩形,但我无法保存带有突出显示矩形的图像。仅保存原始图像,不保存带有矩形的图像。请帮我解决这个问题。
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
IsMouseDown = True
SelectedObjPoint = New Point(e.X, e.Y)
End If
End Sub
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
If IsMouseDown = True Then
If e.X < SelectionBoxObj.X Then
SelectionBoxObj.X = e.X
SelectionBoxObj.Width = SelectedObjPoint.X - e.X
Else
SelectionBoxObj.X = SelectedObjPoint.X
SelectionBoxObj.Width = e.X - SelectedObjPoint.X
End If
If e.Y < SelectedObjPoint.Y Then
SelectionBoxObj.Y = e.Y
SelectionBoxObj.Height = SelectedObjPoint.Y - e.Y
Else
SelectionBoxObj.Y = SelectedObjPoint.Y
SelectionBoxObj.Height = e.Y - SelectedObjPoint.Y
End If
Me.Refresh()
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
IsMouseDown = False
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
If SelectionBoxObj.Width > 0 And SelectionBoxObj.Height > 0 Then
Dim oGradientBrush As Brush = New Drawing.Drawing2D.LinearGradientBrush(SelectionBoxObj.RectangleF, SelectionBoxObj.FillColor, SelectionBoxObj.FillColor, Drawing.Drawing2D.LinearGradientMode.Vertical)
e.Graphics.FillRectangle(oGradientBrush, SelectionBoxObj.RectangleF)
Dim TempPen = New Pen(SelectionBoxObj.BorderLineColor, SelectionBoxObj.BorderLineWidth)
TempPen.DashStyle = SelectionBoxObj.BorderLineType
e.Graphics.DrawRectangle(TempPen, SelectionBoxObj.RectangleF.X, SelectionBoxObj.RectangleF.Y, SelectionBoxObj.RectangleF.Width, SelectionBoxObj.RectangleF.Height)
End If
End Sub
Private Sub Highlight_Ok_Click(sender As Object, e As EventArgs) Handles Highlight_Ok.Click
Dim datestring As String = Date.Now.ToString("yyyyMMddmmss")
Dim path As String = "D:\capture screenshot temp"
Dim currentsavepath As String = String.Format("{0}\capture_{1}.png", path, datestring)
PictureBox1.Image.Save(currentsavepath, Imaging.ImageFormat.Bmp)
End Sub
您在 PictureBox 中绘制的矩形是临时绘制的。它显示当前图像,并在其顶部绘制矩形。但是当你保存图像时,矩形不是图像的一部分。
您可以通过将绘图例程移动到一个过程中来补救您的情况,该过程将在您传递给它的图形对象中绘制结果:
Private Sub DrawHighlight(g As Graphics)
If SelectionBoxObj.Width > 0 And SelectionBoxObj.Height > 0 Then
Using br As New SolidBrush(SelectionBoxObj.FillColor)
g.FillRectangle(br, SelectionBoxObj.RectangleF)
End Using
Using p As New Pen(SelectionBoxObj.BorderLineColor, SelectionBoxObj.BorderLineWidth)
g.DrawRectangle(p, SelectionBoxObj.RectangleF)
End Using
End If
End Sub
现在您可以轻松更新屏幕了:
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
DrawHighlight(e.Graphics)
End Sub
您可以保存最终结果:
Using bmp As New Bitmap(PictureBox1.Image)
Using g As Graphics = Graphics.FromImage(bmp)
DrawHighlight(g)
End Using
bmp.Save(currentsavepath, Imaging.ImageFormat.Bmp)
End Using