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

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

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

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

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

textual
Листинг программы
  1. Imports System.Drawing.Drawing2D
  2.  
  3. Public Class PictureBoxEx
  4.     Inherits PictureBox
  5.  
  6.     Public Event SelectionChanged As EventHandler
  7.  
  8.     Protected Overridable Sub OnSelectionChanged()
  9.         RaiseEvent SelectionChanged(Me, New EventArgs())
  10.     End Sub
  11.  
  12.     'Первая точка выделения
  13.     Private _origin As Point
  14.     'Последняя точка выделения
  15.     Private _lastPoint As Point
  16.     'Режим выделения
  17.     Private _selectionMode As Boolean
  18.     'Границы изображения после ресайза пикчербоксом
  19.     Private _zoomedImageRect As Rectangle
  20.     'Прямоугольник выделения
  21.     Private _selectionRect As Rectangle
  22.     'Масштабный коэффициент
  23.     Private _scale As Double
  24.     'Выбранная часть изображения
  25.     Private _selectedImagePart As Image
  26.  
  27.     ''' <summary>
  28.     '''     Выбранная часть изображения
  29.     ''' </summary>
  30.     Public ReadOnly Property SelectedImagePart As Image
  31.         Get
  32.             Return _selectedImagePart
  33.         End Get
  34.     End Property
  35.  
  36.     Public Sub New()
  37.         MyBase.New()
  38.         ResizeRedraw = True
  39.     End Sub
  40.  
  41. #Region "Переопределение методов PictureBox"
  42.  
  43.  
  44.     Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
  45.         MyBase.OnMouseClick(e)
  46.         If Not _zoomedImageRect.Contains(e.Location) Then Return
  47.         _origin = e.Location
  48.         _selectionMode = Not _selectionMode
  49.         If Not _selectionMode Then
  50.             _selectedImagePart = GetSelectedImagePart()
  51.             OnSelectionChanged()
  52.         End If
  53.     End Sub
  54.  
  55.     Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
  56.         MyBase.OnMouseMove(e)
  57.         _lastPoint = e.Location
  58.         Invalidate()
  59.     End Sub
  60.  
  61.     Protected Overrides Sub OnResize(e As EventArgs)
  62.         MyBase.OnResize(e)
  63.     End Sub
  64.  
  65.     Protected Overrides Sub OnSizeChanged(e As EventArgs)
  66.         MyBase.OnSizeChanged(e)
  67.         GetZoomedImageRect()
  68.     End Sub
  69.  
  70.     Protected Overrides Sub OnPaint(e As PaintEventArgs)
  71.         MyBase.OnPaint(e)
  72.         e.Graphics.DrawRectangle(Pens.Red, _zoomedImageRect)
  73.         If Not _selectionMode Then Return
  74.         _selectionRect = GetSelectionRect()
  75.         Using rectPen = New Pen(Color.White, 2) With {.DashStyle = DashStyle.Dash}
  76.             e.Graphics.DrawRectangle(rectPen, _selectionRect)
  77.         End Using
  78.     End Sub
  79.  
  80. #End Region
  81.  
  82.     Public Sub SetImage(img As Image)
  83.         Image = img
  84.         GetZoomedImageRect()
  85.     End Sub
  86.  
  87.     ''' <summary>
  88.     ''' Получение выделенной части исходного изображения
  89.     ''' </summary>
  90.     Private Function GetSelectedImagePart() As Image
  91.         'Получаем прямоугольник выделения в координатной системе пикчербокса
  92.         Dim realRect = _selectionRect
  93.         'Смещаем его в координатную систему изображения после ресайза
  94.         realRect.Offset(New Point(-_zoomedImageRect.Location.X, -_zoomedImageRect.Location.Y))
  95.         'Переводим в координатную систему исходного изображения с учётом коэффициента
  96.         realRect.X /= _scale
  97.         realRect.Y /= _scale
  98.         realRect.Width /= _scale
  99.         realRect.Height /= _scale
  100.         'Рисуем выделенную часть изображения
  101.         Dim img As Image = New Bitmap(realRect.Width, realRect.Height)
  102.         Using g As Graphics = Graphics.FromImage(img)
  103.             'На всё изображение (второй аргумента) рисуется выделенная часть (третий аргумент) исходного изображения
  104.             g.DrawImage(Image, New Rectangle(New Point(), img.Size), realRect, GraphicsUnit.Pixel)
  105.         End Using
  106.         Return img
  107.     End Function
  108.  
  109.     ''' <summary>
  110.     '''     Получение прямоугольника изображения внутри PictureBox
  111.     ''' </summary>
  112.     Private Sub GetZoomedImageRect()
  113.         If Image Is Nothing Then Return
  114.         Dim zoomedImageSize As Size
  115.  
  116.         Dim pbRatio = Width / Height
  117.  
  118.         Dim x, y As Integer
  119.         'Ширина меньше высоты
  120.         If pbRatio <= 1 Then
  121.             _scale = Width / Image.Size.Width
  122.             zoomedImageSize = New Size(Width, Image.Size.Height * _scale)
  123.             x = 0
  124.             y = (Height - zoomedImageSize.Height) / 2
  125.         Else
  126.             _scale = Height / Image.Size.Height
  127.             zoomedImageSize = New Size(Image.Size.Width * _scale, Height)
  128.             x = (Width - zoomedImageSize.Width) / 2
  129.             y = 0
  130.         End If
  131.         _zoomedImageRect = New Rectangle(New Point(x, y), zoomedImageSize)
  132.     End Sub
  133.  
  134.     ''' <summary>
  135.     '''     Получение прямоугольника выделения
  136.     ''' </summary>
  137.     Private Function GetSelectionRect() As Rectangle
  138.         Dim topLeft As Point
  139.         Dim pt = New Point(_lastPoint.X - _origin.X, _lastPoint.Y - _origin.Y)
  140.         If pt.X > 0 And pt.Y > 0 Then
  141.             topLeft = _origin
  142.         ElseIf pt.X < 0 And pt.Y > 0 Then
  143.             topLeft = New Point(_lastPoint.X, _origin.Y)
  144.         ElseIf pt.X < 0 And pt.Y < 0 Then
  145.             topLeft = _lastPoint
  146.         ElseIf pt.X > 0 And pt.Y < 0 Then
  147.             topLeft = New Point(_origin.X, _lastPoint.Y)
  148.         End If
  149.         Return New Rectangle(topLeft, New Size(Math.Abs(pt.X), Math.Abs(pt.Y)))
  150.     End Function
  151. End Class

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

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

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

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут