[RESOLVED] Copy Selection in Picturebox

Hello guys!

This is probably a very dumb question, but I did not get any sleep the last couple of days.. :blush:

I have 2 pictureboxes. In one picturebox I select an area with this code :

Code:

---

Option Explicit

Dim StartX As Single  'Starting X Position
Dim StartY As Single  'Starting Y Position
Dim EndX As Single  'Ending X Position
Dim EndY As Single  'Ending Y Position
Dim DrawBox As Boolean

Private Sub Pic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    pic.Cls 'Clear The Previous Box
    If Button = vbLeftButton Then 'If Left Is Pressed
       
        'Store Coordinates
       
        StartX = X
        EndX = X
        StartY = Y
        EndY = Y
       
        DrawBox = False
    End If
End Sub

Private Sub Pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then 'If Left Button Is Pressed
        pic.DrawMode = vbInvert 'Invert The Line
       
        If DrawBox Then 'If
            pic.Line (StartX, StartY)-(EndX, EndY), , B
        End If
       
        pic.Line (StartX, StartY)-(X, Y), , B
        EndX = X
        EndY = Y
       
        DrawBox = True
    End If
End Sub

---

Now, I want to copy the selection into another picturebox. How can I do this ¿

I tried BitBlitting, but it did not produce any results. This is what I attempted :

Code:

---

'APIs declarations omitted
Private Sub Command1_Click()

  Dim hTmp As Long        'DC in memory
    Dim hBitmap As Long    'Bitmap to be associated with the DC

    'Create a DC with the same settings as the picturebox
    hTmp = CreateCompatibleDC(pic.hdc)
   
    'Do this. Also set the AutoRedraw of the Form to true
    Me.ScaleMode = vbPixels
   
    'If the DC was created...
    If hTmp Then
        'Obtain a bitmap with compatible settings
        hBitmap = CreateCompatibleBitmap(pic.hdc, pic.Width, pic.Height)
       
        If hBitmap Then
            'associate this bitmap with the DC
            SelectObject hTmp, hBitmap
           
            'Copy the picture from Picture1 on to the memory DC
            BitBlt hTmp, 0, 0, pic.Width, pic.Height, pic.hdc, 0, 0, vbSrcCopy
           
            'Now copy it back to the Form
            BitBlt Pic2.hdc, 0, 0, pic.Width, pic.Height, hTmp, 0, 0, vbSrcCopy 
         
        End If
    End If
   
    'Remove these objects now
    DeleteObject hBitmap
    DeleteDC hTmp
End Sub

---

But, Picturebox2 did not show anything. How can I copy only the selection on Picturebox1 to picturebox2 ¿

Any help would be greatlt appreciated.

Try this, Picture2 is the other PictureBox.

Code:

---

Private Sub Pic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With Picture2
        .Cls
        .PaintPicture Pic.Picture, 0, 0, EndX - StartX, EndY - StartY, _
                      StartX, StartY, EndX - StartX, EndY - StartY
    End With
End Sub

---

Why do you use the sidestep via the memory DC?
You are not using the Start and End vlaues you got from the selection in the mouse-events!
I'd try it like this:

Code:

---


'Copy the picture from Picture1 on to Picture2
            BitBlt Pic2.hdc, StartX, StartY, EndX-StartX, EndY-StartY, Pic.hdc, 0, 0, vbSrcCopy

---

Note: I can't test this on this PC I'm using now!!

Thanx, but I Tried both those methods guys ( before & now again ), but nothing appears into picturebox2 :confused:

It works perfectly for me. On Mouse Up, it adds the selection to Picture2. And you don't need APIs, just use PaintPicture.

I copied something wrongly in my previous post.
After I tried your code in post #2, I get an Invalid Picture error.

In my picturebox1, I drew a picture with code, so it's not an image I loaded.
How can I fix this error ¿

Use Pic.Image instead of Pic.Picture

I see you need to use .Picture, because you need to redraw the Selection Box, try this example then, see I used .Picture = .Image after drawing the Lines.

Code:

---

Option Explicit

Dim StartX As Single  'Starting X Position
Dim StartY As Single  'Starting Y Position
Dim EndX As Single  'Ending X Position
Dim EndY As Single  'Ending Y Position
Dim DrawBox As Boolean

Private Sub Form_Load()
    With Pic
        .AutoRedraw = True
        .DrawWidth = 2
        .BackColor = vbYellow
        .Line 3, 0, 0, .ScaleWidth, .ScaleHeight, vbBlue
        .CurrentY = 0
        .Line 3, .ScaleWidth, 0, 0, .ScaleHeight, vbRed
        .DrawWidth = 1
        .Picture = .Image
    End With
End Sub

Private Sub Pic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic.Cls 'Clear The Previous Box
    If Button = vbLeftButton Then 'If Left Is Pressed
       
        'Store Coordinates
        StartX = X
        EndX = X
        StartY = Y
        EndY = Y
       
        DrawBox = False
    End If
End Sub

Private Sub Pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then 'If Left Button Is Pressed
        Pic.DrawMode = vbInvert 'Invert The Line
       
        If DrawBox Then 'If
            Pic.Line (StartX, StartY)-(EndX, EndY), , B
        End If
       
        Pic.Line (StartX, StartY)-(X, Y), , B
        EndX = X
        EndY = Y
       
        DrawBox = True
    End If
End Sub

Private Sub Pic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With Picture2
        .Cls
        .PaintPicture Pic.Picture, 0, 0, EndX - StartX, EndY - StartY, _
                      StartX, StartY, EndX - StartX, EndY - StartY
    End With
End Sub

---

So, after any change in PictureBox PIC, you need to add Pic.Picture = Pic.Image.

And you need some extra Validation cause the selection could be extremelly little or the user might make a selection starting from the End, this would need to Swap values, so:

Code:

---

Private Sub Pic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lAuxValue As Single
   
    If StartX > EndX Then
        lAuxValue = StartX
        StartX = EndX
        EndX = lAuxValue
    End If
   
    If StartY > EndY Then
        lAuxValue = StartY
        StartY = EndY
        EndY = lAuxValue
    End If
   
    If EndX - StartX = 0 Or EndY - StartY = 0 Then Exit Sub
   
    With Picture2
        .Cls
        .PaintPicture Pic.Picture, 0, 0, EndX - StartX, EndY - StartY, _
                      StartX, StartY, EndX - StartX, EndY - StartY
    End With
End Sub

---

Thanx I appreciate all your efforts..

Fixed - it was the Picturebox2's Scalemode property that needed to be set to Pixels....