Обрезать фото - 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