Как увеличить, изменить размер растрового изображения на графическом пути и сохранить с помощью VB.net - PullRequest
0 голосов
/ 23 июня 2011

Я работаю над изображением с водяным знаком.

В приведенном ниже коде я загружаю изображение в графическую дорожку, используя изображение ресурса и добавляя на него текст.Когда я добавляю изображение в диалоге открытия файла, оно рисует на форме с исходным размером, но мне нужно изменить его размер, добавить его в PictureBox, добавить к нему текст и задать для него параметры масштабирования и панорамирования, а затем мне нужно сохранить соригинальный размер.

Когда я изменяю размер и сохраняю изображение, я получаю маленькое изображение.

Вот мой код:

Imports System.Collections.ObjectModel
Imports System.Drawing.Drawing2D


Public Class Form1
    Dim rAngle As Integer
    Dim sAngle As Integer
    Dim pic_font As Font
    Dim bm As Bitmap = New Bitmap(100, 100)
    Dim tbm As Bitmap
    Dim strText As String = "Diver Dude"
    Dim szText As New SizeF
    Dim ptText As New Point(125, 125)
    Dim ptsAngle() As PointF
    Dim ptOrigin As PointF
    Dim ptsText() As PointF
    Dim ptsRotateText() As PointF
    Dim ptsTextPen As Pen = New Pen(Color.LightSteelBlue, 1)
    Dim MovingOffset As PointF
    Dim MouseMoving As Boolean
    Dim MouseRotating As Boolean
    Dim MouseOver As Boolean
    Private curImage As Image
    Private imgHeight As Single
    Private imgWidth As Single


    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()
        'Add any initialization after the InitializeComponent() call
        Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
        Me.SetStyle(ControlStyles.DoubleBuffer, True)

    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        ptsTextPen.DashStyle = DashStyle.Dot
        'bm = My.Resources.DivePic
        bm = Image.FromFile(Application.StartupPath & "\DivePic.bmp")
        PictureBox1.Image = bm
        Dim FSize() As Single = {4, 6, 8, 10, 12, 13, 14, 15, 16, 18, 20, 22, 24, 26, 28, 30, 32, 34, 36, 38, 40, 46, 50, 56, 60, 72, 80}
        Dim FS As Single
        For Each FS In FSize
            cboFontSize.Items.Add(FS)
        Next
        cboFontSize.SelectedIndex = cboFontSize.FindString("40")

        pic_font = New Font("Arial Black", CSng(cboFontSize.Text), FontStyle.Regular, GraphicsUnit.Pixel)
        'szText = Me.CreateGraphics.MeasureString(strText, pic_font)
        'SetptsText()
    End Sub
    Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
        'Check if the pointer is over the Text
        If IsMouseOverRotate(e.X - 10, e.Y - 10) Then
            MouseRotating = True
            ptOrigin = New PointF(ptText.X + (szText.Width / 2), ptText.Y + (szText.Height / 2))
            sAngle = getAngle(ptOrigin, e.Location) - rAngle

        ElseIf IsMouseOverText(e.X - 10, e.Y - 10) Then
            MouseMoving = True
            'Determine the upper left corner point from where the mouse was clicked
            MovingOffset.X = e.X - ptText.X
            MovingOffset.Y = e.Y - ptText.Y
        Else
            MouseMoving = False
            MouseRotating = False
        End If

    End Sub

    Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove

        If e.Button = Windows.Forms.MouseButtons.Left Then
            If MouseMoving Then
                ptText.X = CInt(e.X - MovingOffset.X)
                ptText.Y = CInt(e.Y - MovingOffset.Y)
                Me.Invalidate()
            ElseIf MouseRotating Then
                rAngle = getAngle(ptOrigin, e.Location) - sAngle
                Me.Invalidate()
                'lblRotate.Text = getAngle(ptOrigin, ptsAngle(0))
                'lblRotate.Refresh()

            End If
        Else
            If IsMouseOverRotate(e.X - 10, e.Y - 10) Then
                'Check if the pointer is over the Text
                Me.Cursor = Cursors.Hand
                If Not MouseOver Then
                    MouseOver = True
                    Me.Invalidate()
                End If
            ElseIf IsMouseOverText(e.X - 10, e.Y - 10) Then
                Me.Cursor = Cursors.SizeAll
                If Not MouseOver Then
                    MouseOver = True
                    Me.Invalidate()
                End If
            Else
                Me.Cursor = Cursors.Default
                If MouseOver Then
                    MouseOver = False
                    Me.Invalidate()
                End If
            End If
        End If
    End Sub

    Private Function getAngle(ByVal Origin As PointF, ByVal XYPoint As PointF) As Integer

        Dim xLength As Single = XYPoint.X - Origin.X
        Dim yLength As Single = XYPoint.Y - Origin.Y
        Dim TheAngle As Single

        'On the Origin
        If xLength = 0 And yLength = 0 Then Return 0
        'On one of the Axis
        If xLength = 0 And yLength < 0 Then Return 0
        If yLength = 0 And xLength > 0 Then Return 90
        If xLength = 0 And yLength > 0 Then Return 180
        If yLength = 0 And xLength < 0 Then Return 270

        TheAngle = Math.Atan(xLength / yLength)
        TheAngle = TheAngle * (180 / Math.PI)

        'Adjust for the Quadrant
        If yLength > 0 Then
            'Quadrant 1 or 2
            TheAngle = 180 - TheAngle
        ElseIf xLength > 0 Then
            'Quadrant 0
            TheAngle = Math.Abs(TheAngle)
        ElseIf xLength < 0 Then
            'Quadrant 3
            TheAngle = 360 - TheAngle
        End If
        Return CInt(TheAngle)
    End Function

    Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
        MouseMoving = False
        MouseRotating = False
        Me.Invalidate()
    End Sub

    Public Function IsMouseOverText(ByVal X As Integer, ByVal Y As Integer) As Boolean
        'Make a Graphics Path from the rotated ptsText.
        Using gp As New GraphicsPath()
            gp.AddPolygon(ptsText)

            Return gp.IsVisible(X, Y)

        End Using
    End Function

    Public Function IsMouseOverRotate(ByVal X As Integer, ByVal Y As Integer) As Boolean
        'Make a Graphics Path from the rotated ptsText.
        Using gp As New GraphicsPath()
            gp.AddPolygon(ptsRotateText)

            Return gp.IsVisible(X, Y)

        End Using
    End Function
    Private Sub Form1_Paint(ByVal sender As Object, _
        ByVal e As System.Windows.Forms.PaintEventArgs) _
        Handles MyBase.Paint
        tbm = CType(bm.Clone, Bitmap)

        If bm Is Nothing Then Exit Sub

        Dim g As Graphics = Graphics.FromImage(tbm)
        Dim mx As Matrix = New Matrix
        Dim gpathText As New GraphicsPath
        Dim br As SolidBrush = New SolidBrush(Color.FromArgb(tbarTrans.Value, _
                                             KryptonColorButton1.SelectedColor))

        'Set the Points for the Rectangle around the Text        
        SetptsText()

        'Smooth the Text
        g.SmoothingMode = SmoothingMode.AntiAlias

        'Make the GraphicsPath for the Text
        Dim emsize As Single = Me.CreateGraphics.DpiY * pic_font.SizeInPoints / 72
        gpathText.AddString(strText, pic_font.FontFamily, CInt(pic_font.Style), _
            emsize, New RectangleF(ptText.X, ptText.Y, szText.Width, szText.Height), _
            StringFormat.GenericDefault)

        'Draw a copy of the image to the Graphics Object canvas
        g.DrawImage(CType(bm.Clone, Bitmap), 0, 0)


        'Rotate the Matrix at the center point
        mx.RotateAt(rAngle, _
            New Point(ptText.X + (szText.Width / 2), ptText.Y + (szText.Height / 2)))

        'Rotate the points for the text bounds
        mx.TransformPoints(ptsText)
        mx.TransformPoints(ptsRotateText)
        mx.TransformPoints(ptsAngle)

        'Transform the Graphics Object with the Matrix
        g.Transform = mx

        'Draw the Rotated Text
        'g.FillPath(br, gpathText)



        If chkAddOutline.Checked Then
            Using pn As Pen = New Pen(Color.FromArgb(tbarTrans.Value, KryptonColorButton2.SelectedColor), 1)
                g.DrawPath(pn, gpathText)
            End Using
        Else
            g.FillPath(br, gpathText)
        End If

        If CheckBox2.Checked = True Then
            Dim p As New Pen(Color.FromArgb(tbarTrans.Value, KryptonColorButton2.SelectedColor), 1)
            'draw te hollow outlined text
            g.DrawPath(p, gpathText)
            'clear the path
            gpathText.Reset()
        Else
            g.FillPath(br, gpathText)
        End If




        'Draw the box if the mouse is over the Text
        If MouseOver Then
            g.ResetTransform()
            g.DrawPolygon(ptsTextPen, ptsText)
            g.FillPolygon(New SolidBrush(Color.FromArgb(100, Color.White)), ptsRotateText)
        End If
        'Draw the whole thing to the form
        e.Graphics.DrawImage(tbm, 10, 10)

        PictureBox2.Image = tbm
        PictureBox1.Hide()
        PictureBox2.Show()


        'tbm.Dispose()
        g.Dispose()
        mx.Dispose()
        br.Dispose()
        gpathText.Dispose()


    End Sub

    Private Sub TrackBar_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) _
      Handles tbarTrans.Scroll
        lblOpacity.Text = tbarTrans.Value
        Me.Invalidate()
    End Sub

    Sub SetptsText()
        'Create a point array of the Text Rectangle
        ptsText = New PointF() { _
            ptText, _
            New Point(CInt(ptText.X + szText.Width), ptText.Y), _
            New Point(CInt(ptText.X + szText.Width), CInt(ptText.Y + szText.Height)), _
            New Point(ptText.X, CInt(ptText.Y + szText.Height)) _
            }

        ptsRotateText = New PointF() { _
            New Point(CInt(ptText.X + szText.Width - 10), ptText.Y), _
            New Point(CInt(ptText.X + szText.Width), ptText.Y), _
            New Point(CInt(ptText.X + szText.Width), CInt(ptText.Y + 10)), _
            New Point(CInt(ptText.X + szText.Width - 10), CInt(ptText.Y + 10)) _
            }
        ptsAngle = New PointF() {New PointF(CInt(ptText.X + szText.Width), CInt(ptText.Y + (szText.Height / 2)))}
    End Sub

    Private Sub chkAddOutline_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkAddOutline.CheckedChanged
        Me.Invalidate()
    End Sub

    Private Sub cboFontSize_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cboFontSize.SelectedIndexChanged
        pic_font = New Font("Arial Black", CSng(cboFontSize.Text), FontStyle.Regular, GraphicsUnit.Pixel)
        szText = Me.CreateGraphics.MeasureString(strText, pic_font)
        SetptsText()
        Me.Invalidate()
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            PictureBox2.Image.Save(SaveFileDialog1.FileName)
        End If
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If FontDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            pic_font = FontDialog1.Font
            szText = Me.CreateGraphics.MeasureString(strText, pic_font)
            SetptsText()
            Me.Invalidate()
        End If
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            Dim img As Drawing.Image = Drawing.Image.FromFile(OpenFileDialog1.FileName)
            PictureBox1.Image = img
            bm = img
        End If
    End Sub
End Class

1 Ответ

0 голосов
/ 22 сентября 2011

Вы перерисовываете изображение, когда движется мышь.Изображение лучше рисовать только при нажатии кнопки.Запустите код в form1_paint при загрузке изображения или при использовании элемента управления.

Могут быть и другие проблемы, но это поможет вам начать работу.

...