Cropping a small bitmap out of a big bitmap and saving it to disk

[Athenis]

Hi,
Is it possible to write a program whereby the user will see a big picture box on a form, then when he enters two co-ordinates like (0,0) and (30,40), the area within these 2 co-ords will be cropped out and saved to disk as a separate bitmap?

[John]

You can use the paintpicture function to copy part of the picture from on picturebox to another, then use the savepicture method to save the picture. Look up both functions in the online help.


------------------
John Percival
Editor, VB-World.net
[email protected]

[Athenis]

Sorry John,
I was trying out the function.. then I ended up with a blank target picture box.
I tried the command:
Picturet.PaintPicture Pictures.Picture, 0, 0

where picturet is the target picturebox (blank) and pictures is the source picturebox with a picture.
What is wrong?

[Aaron Young]

Try this:

Private oX As Integer
Private oY As Integer
Private lX As Integer
Private lY As Integer

Private Sub Form_Load()
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
    Picture2.AutoRedraw = True
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        With Picture1
            .DrawMode = vbInvert
            oX = X
            oY = Y
            lX = oX
            lY = oY
        End With
    End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        Picture1.Line (oX, oY)-Step(lX - oX, lY - oY), , B
        Picture1.Line (oX, oY)-Step(X - oX, Y - oY), , B
        lX = X
        lY = Y
    End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim iTmp As Integer
    Dim iW As Integer
    Dim iH As Integer
    If Button = vbLeftButton Then
        Picture1.Line (oX, oY)-Step(lX - oX, lY - oY), , B
        Picture2.Cls
        If X < oX Then
            iTmp = oX
            oX = X
            X = iTmp
        End If
        If Y < oY Then
            iTmp = oY
            oY = Y
            Y = iTmp
        End If
        If X = oX Then X = 1
        If Y = oY Then Y = 1
        iW = X - oX
        iH = Y - oY
        Picture2.Width = ScaleX(iW, vbPixels, vbTwips)
        Picture2.Height = ScaleY(iH, vbPixels, vbTwips)
        Picture2.PaintPicture Picture1.Image, 0, 0, iW, iH, oX, oY, iW, iH
        SavePicture Picture2.Image, InputBox("Save Cropped Image as..", "Save As..", "C:\Cropped.bmp")
    End If
End Sub

To Crop, just Click and Drag a Crop Outline on the Picture1 Picturebox.

------------------
Aaron Young
Analyst Programmer
[email protected]
[email protected]