Обрезать фото - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д