Обрезать фото - Visual Basic .NET

Узнай цену своей работы

Формулировка задачи:

Уважаемые коллеги, добрый день! Подскажите, как программно обрезать изображение из picturebox'a? В голову сразу пришло снимать скриншотом, работает, но разрешение изображения сильно падает (до размеров скриншота, соответственно)... Требуется взять фото из PictureBox'a, отрезать от него часть (соответственно, не теряя пиксели, как в случае скриншота), и сохранить эту часть в файл... Надеюсь на вашу скорейшую помощь, т.к. у меня идей нет, а интернет выдаёт варианты лишь с использованием graphics, который не знаю, как перевести в image/сохранить в файл..

Решение задачи: «Обрезать фото»

textual
Листинг программы
Imports System.Drawing.Drawing2D
 
Public Class PictureBoxEx
    Inherits PictureBox
 
    Public Event SelectionChanged As EventHandler
 
    Protected Overridable Sub OnSelectionChanged()
        RaiseEvent SelectionChanged(Me, New EventArgs())
    End Sub
 
    'Первая точка выделения
    Private _origin As Point
    'Последняя точка выделения 
    Private _lastPoint As Point
    'Режим выделения
    Private _selectionMode As Boolean
    'Границы изображения после ресайза пикчербоксом
    Private _zoomedImageRect As Rectangle
    'Прямоугольник выделения
    Private _selectionRect As Rectangle
    'Масштабный коэффициент
    Private _scale As Double
    'Выбранная часть изображения
    Private _selectedImagePart As Image
 
    ''' <summary>
    '''     Выбранная часть изображения
    ''' </summary>
    Public ReadOnly Property SelectedImagePart As Image
        Get
            Return _selectedImagePart
        End Get
    End Property
 
    Public Sub New()
        MyBase.New()
        ResizeRedraw = True
    End Sub
 
#Region "Переопределение методов PictureBox"
 
 
    Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
        MyBase.OnMouseClick(e)
        If Not _zoomedImageRect.Contains(e.Location) Then Return
        _origin = e.Location
        _selectionMode = Not _selectionMode
        If Not _selectionMode Then
            _selectedImagePart = GetSelectedImagePart()
            OnSelectionChanged()
        End If
    End Sub
 
    Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
        MyBase.OnMouseMove(e)
        _lastPoint = e.Location
        Invalidate()
    End Sub
 
    Protected Overrides Sub OnResize(e As EventArgs)
        MyBase.OnResize(e)
    End Sub
 
    Protected Overrides Sub OnSizeChanged(e As EventArgs)
        MyBase.OnSizeChanged(e)
        GetZoomedImageRect()
    End Sub
 
    Protected Overrides Sub OnPaint(e As PaintEventArgs)
        MyBase.OnPaint(e)
        e.Graphics.DrawRectangle(Pens.Red, _zoomedImageRect)
        If Not _selectionMode Then Return
        _selectionRect = GetSelectionRect()
        Using rectPen = New Pen(Color.White, 2) With {.DashStyle = DashStyle.Dash}
            e.Graphics.DrawRectangle(rectPen, _selectionRect)
        End Using
    End Sub
 
#End Region
 
    Public Sub SetImage(img As Image)
        Image = img
        GetZoomedImageRect()
    End Sub
 
    ''' <summary>
    ''' Получение выделенной части исходного изображения
    ''' </summary>
    Private Function GetSelectedImagePart() As Image
        'Получаем прямоугольник выделения в координатной системе пикчербокса
        Dim realRect = _selectionRect
        'Смещаем его в координатную систему изображения после ресайза
        realRect.Offset(New Point(-_zoomedImageRect.Location.X, -_zoomedImageRect.Location.Y))
        'Переводим в координатную систему исходного изображения с учётом коэффициента
        realRect.X /= _scale
        realRect.Y /= _scale
        realRect.Width /= _scale
        realRect.Height /= _scale
        'Рисуем выделенную часть изображения
        Dim img As Image = New Bitmap(realRect.Width, realRect.Height)
        Using g As Graphics = Graphics.FromImage(img)
            'На всё изображение (второй аргумента) рисуется выделенная часть (третий аргумент) исходного изображения
            g.DrawImage(Image, New Rectangle(New Point(), img.Size), realRect, GraphicsUnit.Pixel)
        End Using
        Return img
    End Function
 
    ''' <summary>
    '''     Получение прямоугольника изображения внутри PictureBox
    ''' </summary>
    Private Sub GetZoomedImageRect()
        If Image Is Nothing Then Return
        Dim zoomedImageSize As Size
 
        Dim pbRatio = Width / Height
 
        Dim x, y As Integer
        'Ширина меньше высоты
        If pbRatio <= 1 Then
            _scale = Width / Image.Size.Width
            zoomedImageSize = New Size(Width, Image.Size.Height * _scale)
            x = 0
            y = (Height - zoomedImageSize.Height) / 2
        Else
            _scale = Height / Image.Size.Height
            zoomedImageSize = New Size(Image.Size.Width * _scale, Height)
            x = (Width - zoomedImageSize.Width) / 2
            y = 0
        End If
        _zoomedImageRect = New Rectangle(New Point(x, y), zoomedImageSize)
    End Sub
 
    ''' <summary>
    '''     Получение прямоугольника выделения
    ''' </summary>
    Private Function GetSelectionRect() As Rectangle
        Dim topLeft As Point
        Dim pt = New Point(_lastPoint.X - _origin.X, _lastPoint.Y - _origin.Y)
        If pt.X > 0 And pt.Y > 0 Then
            topLeft = _origin
        ElseIf pt.X < 0 And pt.Y > 0 Then
            topLeft = New Point(_lastPoint.X, _origin.Y)
        ElseIf pt.X < 0 And pt.Y < 0 Then
            topLeft = _lastPoint
        ElseIf pt.X > 0 And pt.Y < 0 Then
            topLeft = New Point(_origin.X, _lastPoint.Y)
        End If
        Return New Rectangle(topLeft, New Size(Math.Abs(pt.X), Math.Abs(pt.Y)))
    End Function
End Class

Оцени полезность:

15   голосов , оценка 4.067 из 5