|
|
|
| Title | Crop a picture and save the result in Visual Basic 2005 |
|---|
| Description | This example shows how to crop a picture and save the result in Visual Basic 2005. |
|---|
| Keywords | crop picture, crop, trim, Visual Basic 2005, VB .NET |
|---|
| Categories | Graphics, Controls, VB.NET |
|---|
|
|
|
When you use the menu's Open command, the program lets you pick an image file. It creates a new Bitmap from the image file and displays it in the PictureBox named picOriginal.
|
|
Private Sub mnuFileOpen_Click(ByVal sender As _
System.Object, ByVal e As System.EventArgs) Handles _
mnuFileOpen.Click
If dlgOpen.ShowDialog() = Windows.Forms.DialogResult.OK _
Then
Try
m_OriginalBm = New Bitmap(dlgOpen.FileName)
picOriginal.Image = m_OriginalBm
picOriginal.Visible = True
picCropped.Visible = True
Catch ex As Exception
MessageBox.Show( _
"Error opening file " & dlgOpen.FileName & _
vbCrLf & ex.Message, _
"Error Opening File", _
MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
End Try
End If
End Sub
|
|
|
When you click and move the mouse over picOriginal, the program draws a rubberband box around the area you are selecting. Form-level variables m_Selecting, m_X1, m_Y1, m_X2, and m_Y2 keep track of the box.
|
|
Private m_OriginalBm As Bitmap
Private m_CroppedBm As Bitmap
Private m_Selecting As Boolean = False
Private m_X1 As Integer
Private m_Y1 As Integer
Private m_X2 As Integer
Private m_Y2 As Integer
Private Sub picOriginal_MouseDown(ByVal sender As Object, _
ByVal e As System.Windows.Forms.MouseEventArgs) Handles _
picOriginal.MouseDown
m_Selecting = True
m_X1 = e.X
m_Y1 = e.Y
m_X2 = e.X
m_Y2 = e.Y
' Show the original image.
picOriginal.Image = m_OriginalBm
End Sub
Private Sub picOriginal_MouseMove(ByVal sender As Object, _
ByVal e As System.Windows.Forms.MouseEventArgs) Handles _
picOriginal.MouseMove
If Not m_Selecting Then Exit Sub
m_X2 = e.X
m_Y2 = e.Y
If (m_X1 = m_X2) OrElse (m_Y1 = m_Y2) Then Exit Sub
' Draw.
Dim bm As Bitmap = m_OriginalBm.Clone()
Using gr As Graphics = Graphics.FromImage(bm)
Dim rect As New Rectangle( _
Min(m_X1, m_X2), _
Min(m_Y1, m_Y2), _
Abs(m_X2 - m_X1), _
Abs(m_Y2 - m_Y1))
gr.DrawRectangle(Pens.Red, rect)
End Using
picOriginal.Image = bm
End Sub
|
|
|
When you release the mouse, the program defines a Rectangle for the area you selected and a destination rectangle the same size but positioned at the origin. It makes a new Bitmap big enough to hold the selected area, makes a Graphics object associated with that Bitmap, and uses the DrawImage method to copy the selected area into the new Bitmap.
|
|
Private Sub picOriginal_MouseUp(ByVal sender As Object, _
ByVal e As System.Windows.Forms.MouseEventArgs) Handles _
picOriginal.MouseUp
If Not m_Selecting Then Exit Sub
m_Selecting = False
Dim src_rect As New Rectangle( _
Min(m_X1, m_X2), _
Min(m_Y1, m_Y2), _
Abs(m_X2 - m_X1), _
Abs(m_Y2 - m_Y1))
Dim dest_rect As New Rectangle( _
0, 0, _
src_rect.Width, _
src_rect.Height)
m_CroppedBm = New Bitmap(src_rect.Width, _
src_rect.Height)
Using gr As Graphics = Graphics.FromImage(m_CroppedBm)
gr.DrawImage(m_OriginalBm, dest_rect, src_rect, _
GraphicsUnit.Pixel)
End Using
picCropped.Image = m_CroppedBm
End Sub
|
|
|
When you click the File menu's Save As command, the program lets you pick a file. It finds the file's extension and uses it to decide what format to use when saving the file.
|
|
Private Sub mnuFileSaveAs_Click(ByVal sender As _
System.Object, ByVal e As System.EventArgs) Handles _
mnuFileSaveAs.Click
If dlgSave.ShowDialog() = Windows.Forms.DialogResult.OK _
Then
Try
Dim ext As String = _
dlgSave.FileName.Substring(dlgSave.FileName.LastIndexOf(".")).ToLower
Select Case ext
Case ".bmp"
m_CroppedBm.Save(dlgSave.FileName, _
ImageFormat.Bmp)
Case ".gif"
m_CroppedBm.Save(dlgSave.FileName, _
ImageFormat.Gif)
Case ".jpg", ".jpeg"
m_CroppedBm.Save(dlgSave.FileName, _
ImageFormat.Jpeg)
Case Else
MessageBox.Show("Unknown extension " & _
ext, "Unknown Extension", _
MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
End Select
Catch ex As Exception
MessageBox.Show( _
"Error saving file." & vbCrLf & ex.Message, _
_
"Save Error", _
MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
End Try
End If
End Sub
|
| |
|
| |
|
|
