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
| Imports System.Drawing.Drawing2D
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)
' Fit image to the picturebox:
PictureBox1.Image = img.Fit2PictureBox(PictureBox1)
_selecting = False
Else
_selecting = False
End If
End Sub
' 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>
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
'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>
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
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 |
Problème d'appel de fonction
Répondre avec citation
Partager