|
|
|
| Title | Crop a picture and save the result in Visual Basic 6 |
|---|
| Description | This example shows how to crop a picture and save the result in Visual Basic 6. |
|---|
| Keywords | crop picture, crop, trim, Visual Basic |
|---|
| Categories | Graphics, Controls |
|---|
|
|
|
When you use the menu's Open command, the program lets you pick an image file. It uses LoadPicture to display the image in the PictureBox named picOriginal.
|
|
Private Sub mnuFileOpen_Click()
On Error Resume Next
dlgOpen.ShowOpen
If (Err.Number = cdlCancel) Then Exit Sub
If (Err.Number <> 0) Then
MsgBox "Error " & Err.Number & " selecting file." & _
vbCrLf & _
Err.Description, vbOKOnly Or vbExclamation, _
"File Select Error"
Exit Sub
End If
On Error GoTo mnuFileOpen_Error
picOriginal.Picture = LoadPicture(dlgOpen.FileName)
picOriginal.Visible = True
picCropped.Visible = True
Exit Sub
mnuFileOpen_Error:
MsgBox "Error " & Err.Number & " opening file " & _
dlgOpen.FileName & "." & vbCrLf & _
Err.Description, vbOKOnly Or vbExclamation, "File " & _
"Select Error"
Exit Sub
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_Selecting As Boolean
Private m_X1 As Single
Private m_Y1 As Single
Private m_X2 As Single
Private m_Y2 As Single
Private Sub picOriginal_MouseDown(Button As Integer, Shift _
As Integer, X As Single, Y As Single)
m_Selecting = True
m_X1 = X
m_Y1 = Y
m_X2 = X
m_Y2 = Y
' Draw.
picOriginal.Line (m_X1, m_Y1)-(m_X2, m_Y2), , B
End Sub
Private Sub picOriginal_MouseMove(Button As Integer, Shift _
As Integer, X As Single, Y As Single)
If Not m_Selecting Then Exit Sub
' Erase.
picOriginal.Line (m_X1, m_Y1)-(m_X2, m_Y2), , B
m_X2 = X
m_Y2 = Y
' Draw.
picOriginal.Line (m_X1, m_Y1)-(m_X2, m_Y2), , B
End Sub
|
|
|
When you release the mouse, the program finds the upper left corner, width, and height of the area you selected. It resizes the picCropped PictureBox so it is the right size to hold that area and then uses the control's PaintPicture method to copy the selected area into picCropped.
|
|
Private Sub picOriginal_MouseUp(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
Dim wid As Single
Dim hgt As Single
Dim temp As Single
If Not m_Selecting Then Exit Sub
m_Selecting = False
' Erase.
picOriginal.Line (m_X1, m_Y1)-(m_X2, m_Y2), , B
' Make pt2 > pt1.
If m_X1 > m_X2 Then
temp = m_X1
m_X1 = m_X2
m_X2 = temp
End If
If m_Y1 > m_Y2 Then
temp = m_Y1
m_Y1 = m_Y2
m_Y2 = temp
End If
wid = m_X2 - m_X1
hgt = m_Y2 - m_Y1
If (wid = 0) Or (hgt = 0) Then Exit Sub
' Size the result.
picCropped.Width = wid + (picCropped.Width - _
picCropped.ScaleWidth)
picCropped.Height = hgt + (picCropped.Height - _
picCropped.ScaleHeight)
' Copy the selected area.
picCropped.PaintPicture picOriginal.Picture, 0, 0, wid, _
hgt, m_X1, m_Y1, wid, hgt
picCropped.Picture = picCropped.Image
End Sub
|
|
|
When you click the File menu's Save As command, the program lets you pick a file and it saves the result in that file. The program uses SavePicture, which only saves in the bitmap format.
|
|
Private Sub mnuFileSaveAs_Click()
On Error Resume Next
dlgSaveAs.ShowSave
If (Err.Number = cdlCancel) Then Exit Sub
If (Err.Number <> 0) Then
MsgBox "Error " & Err.Number & " selecting file." & _
vbCrLf & _
Err.Description, vbOKOnly Or vbExclamation, _
"File Select Error"
Exit Sub
End If
On Error GoTo mnuFileSaveAs_Error
SavePicture picCropped.Picture, dlgSaveAs.FileName
Exit Sub
mnuFileSaveAs_Error:
MsgBox "Error " & Err.Number & " saving file " & _
dlgSaveAs.FileName & "." & vbCrLf & _
Err.Description, vbOKOnly Or vbExclamation, "File " & _
"Select Error"
Exit Sub
End Sub
|
| |
|
| |
|
|
