1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
| Imports System.Drawing.Drawing2D
Imports System.Runtime.CompilerServices
' on declare la fonction fit
Module ImageExtensions
'FITTING
''' <summary>
''' Fits an image to the size of a picturebox
''' </summary>
''' <param name="image">
''' image to be fit
''' </param>
''' <param name="picBox">
''' picturebox in that the image should fit
''' </param>
''' <returns>
''' fitted image
''' </returns>
''' <remarks>
''' Although the picturebox has the SizeMode-property that offers
''' the same functionality an OutOfMemory-Exception is thrown
''' when assigning images to a picturebox several times.
'''
''' AFAIK the SizeMode is designed for assigning an image to
''' picturebox only once.
''' </remarks>
<Extension()>
Public Function Fit2PictureBox(ByVal image As Image, ByVal picBox As PictureBox) As Image
Dim bmp As Bitmap = Nothing
Dim g As Graphics
' Scale:
Dim scaleY As Double = CDbl(image.Width) / picBox.Width
Dim scaleX As Double = CDbl(image.Height) / picBox.Height
Dim scale As Double = If(scaleY < scaleX, scaleX, scaleY)
' Create new bitmap:
bmp = New Bitmap(CInt(Fix(CDbl(image.Width) / scale)), CInt(Fix(CDbl(image.Height) / scale)))
' Set resolution of the new image:
bmp.SetResolution(image.HorizontalResolution, image.VerticalResolution)
' Create graphics:
g = Graphics.FromImage(bmp)
' Set interpolation mode:
g.InterpolationMode = InterpolationMode.HighQualityBicubic
' Draw the new image:
g.DrawImage(image, New Rectangle(0, 0, bmp.Width, bmp.Height), New Rectangle(0, 0, image.Width, image.Height), GraphicsUnit.Pixel) ' Source - Destination
' Release the resources of the graphics:
g.Dispose()
' Release the resources of the origin image:
image.Dispose()
Return bmp
End Function
End Module
' fin de la declaration de fontion
' declaration fonction crop
Module cropextensions
' CROPPING
' <summary>
'Crops an image according to a selection rectangel
' </summary>
' <param name="image">
' the image to be cropped
' </param>
' <param name="selection">
' the selection
' </param>
' <returns>
' cropped image
' </returns>
<Extension()>
Public Function Crop(ByVal image As Image, ByVal selection As Rectangle) As Image
Dim bmp As Bitmap = TryCast(image, Bitmap)
' Check if it is a bitmap:
If bmp Is Nothing Then
Throw New ArgumentException("No valid bitmap")
End If
' Crop the image:
Dim cropBmp As Bitmap = bmp.Clone(selection, bmp.PixelFormat)
' Release the resources:
image.Dispose()
Return cropBmp
End Function
End Module
'fin declaration fonction crop
Public Class Form1
Private _selecting As Boolean
Private _selection As Rectangle
Private _originalImage As Image
'Cropping
Private Sub PictureBox1_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
If e.Button = MouseButtons.Left AndAlso _selecting AndAlso _selection.Size <> New Size() Then
' Create cropped image:
Dim img As Image = PictureBox1.Image.Crop(_selection) 'methode d'appel de fonction si fonction declarée en module
' --> appel de la fonction méthode classique Dim img = Crop(PictureBox1.Image, _selection)
' Fit image to the picturebox:
PictureBox1.Image = img.Fit2PictureBox(PictureBox1) 'methode d'appel de fonction si fonction declarée en module
_selecting = False
Else
_selecting = False
End If
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
' Save just a copy of the image on no reference!
_originalImage = TryCast(PictureBox1.Image.Clone(), Image)
End Sub
'selecting the region
Private Sub PictureBox1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
' Starting point of the selection:
If e.Button = MouseButtons.Left Then
_selecting = True
_selection = New Rectangle(New Point(e.X, e.Y), New Size())
End If
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
' Update the actual size of the selection:
If _selecting Then
_selection.Width = e.X - _selection.X
_selection.Height = e.Y - _selection.Y
' Redraw the picturebox:
PictureBox1.Refresh()
End If
End Sub
Private Sub PictureBox1_Paint_1(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
If _selecting Then
' Draw a rectangle displaying the current selection
Dim pen As Pen = Pens.GreenYellow
e.Graphics.DrawRectangle(pen, _selection)
End If
End Sub
'Restore original image
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
PictureBox1.Image = TryCast(_originalImage.Clone(), Image)
End Sub
End Class |
Partager