在图片框上的图形中绘制一个矩形，然后保存为位图并另存为tif

问题描述

我在图片上绘制了一个矩形，并且想要保存图片，但效果并不理想。矩形看起来更小且位置错误。

代码如下：

Public Class Form10
    Dim G_RegistInfoPathSinglePage = "D:\0_0_1.TIF"
    Dim SelectRect As Rectangle = New Rectangle()
    Dim _pen As Pen = New Pen(Color.Purple,4)
    Dim _brush As SolidBrush = New SolidBrush(Color.Pink)
    Dim _Controlpressed As Boolean = False

    Private Sub Form1_KeyDown(sender As Object,e As KeyEventArgs) Handles MyBase.KeyDown
        _Controlpressed = (e.Modifiers And Keys.Control) = Keys.Control
    End Sub

    Private Sub Form1_KeyUp(sender As Object,e As KeyEventArgs) Handles Me.KeyUp
        _Controlpressed = (e.Modifiers And Keys.Control) = Keys.Control
    End Sub


    Private Sub PictureBox1_MouseDown(sender As Object,e As MouseEventArgs) Handles picOriginal.MouseDown
        SelectRect.Location = e.Location

        SelectRect.Size = New Size(0,0)
    End Sub

    Private Sub PictureBox1_MouseMove(sender As Object,e As MouseEventArgs) Handles picOriginal.MouseMove
        If (e.Button = MouseButtons.Left) Then
            ControlPaint.DrawreversibleFrame(picOriginal.RectangletoScreen(SelectRect),picOriginal.BackColor,FrameStyle.Dashed)
            SelectRect.Width = e.X - SelectRect.X
            SelectRect.Height = e.Y - SelectRect.Y
            ControlPaint.DrawreversibleFrame(picOriginal.RectangletoScreen(SelectRect),FrameStyle.Dashed)
        End If
    End Sub

    Private Sub PictureBox1_MouseUp(sender As Object,e As MouseEventArgs) Handles picOriginal.MouseUp

        If (e.Y < SelectRect.Y) Then
            SelectRect.Location = If(SelectRect.Location.X > e.X,New Point(e.X,e.Y),New Point(SelectRect.X,e.Y))
            SelectRect.Size = New Size(Math.Abs(SelectRect.Width),Math.Abs(SelectRect.Height))
        Else
            If SelectRect.Location.X > SelectRect.Right Then
                SelectRect.Location = New Point(e.X,SelectRect.Y)
                SelectRect.Size = New Size(Math.Abs(SelectRect.Width),Math.Abs(SelectRect.Height))
            End If
        End If

        If _Controlpressed Then
            Dim _InflatedRect As Rectangle = New Rectangle(SelectRect.Location,SelectRect.Size)
            _InflatedRect.Inflate(CInt(_pen.Width / 2),CInt(_pen.Width / 2))
            picOriginal.Invalidate(_InflatedRect)
        Else
            picOriginal.Invalidate()
        End If

    End Sub

'paint rectangle
    Private Sub PictureBox1_Paint(sender As Object,e As PaintEventArgs) Handles picOriginal.Paint


        e.Graphics.DrawRectangle(_pen,SelectRect)

        SelectRect.Inflate(CInt(-_pen.Width / 2),CInt(-_pen.Width / 2))
        e.Graphics.FillRectangle(_brush,SelectRect)


    End Sub

'if Pressing ctrl + S switches to a function that saves the image
    Private Sub main_KeyDown(ByVal sender As Object,ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
        If (e.KeyCode = Keys.S AndAlso e.Modifiers = Keys.Control) Then

            SaveDrawRectengle()

            MsgBox("Save successfully")
        End If
    End Sub

'save to image as tif
    Public Sub SaveDrawRectengle()

        Dim l_OriginalImage As New System.IO.FileStream(G_RegistInfoPathSinglePage,IO.FileMode.Open,IO.FileAccess.Read)
        Dim OriginalImage = System.Drawing.Image.FromStream(l_OriginalImage)

        Dim Bfr As Bitmap = New Bitmap(OriginalImage)
        picOriginal.BackgroundImage = Bfr
        Dim _image = picOriginal.BackgroundImage

        Dim overlay As New Bitmap(_image.Width,_image.Height,System.Drawing.Imaging.PixelFormat.Format32bppArgb)
        Dim g As Graphics = Graphics.FromImage(overlay)

        g.DrawRectangle(_pen,SelectRect)
        SelectRect.Inflate(CInt(-_pen.Width / 2),CInt(-_pen.Width / 2))
        g.FillRectangle(_brush,SelectRect)


        g.dispose()

        picOriginal.Image = overlay

        l_OriginalImage.Close()


        Dim Tmpimg As Image = New Bitmap(300,100)

        Tmpimg = CType(Bfr,Image)
        Dim Tmpg As Graphics = Graphics.FromImage(Tmpimg)

        Tmpg.DrawImage(CType(overlay,Image),New Point(10,10))
        Tmpimg.Save("D:\852.tif")

    End Sub
End Class

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）