Dragging objects over containers

Images, because they're not real windows, automatically sit behind any 'real-windowed' contols on the form.
This also goes for labels and shapes.
Even zorder won't help you here.
You may need to use a picture control, copy the image control's picture into it, then hide the image control. The problem with this is of course that pictures don't do transparency or stretching easily.

Here's a solution that will allow you to move any object. It does this by drawing directly onto the screen.

Option Explicit

'API Constants
Private Const VK_LBUTTON = &H1
Private Const PS_SOLID = 0
Private Const R2_NOTXORPEN = 10
Private Const BLACK_PEN = 7

'API Types
Private Type RECT
  Left As Long
  Top As Long
  right As Long
  bottom As Long
End Type

Private Type POINTAPI
  X As Long
  Y As Long
End Type

'API Declares
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Function DragObject(lLeft As Long, lTop As Long, lWidth As Long, lHeight As Long, OwnerhWnd As Long, ScaleMode As ScaleModeConstants, Optional lMinLeft As Long, Optional lMinTop As Long, Optional lMaxLeft As Long, Optional lMaxTop As Long) As Boolean

  Dim pt As POINTAPI
  Dim lOffsetX As Long
  Dim lOffsetY As Long
  Dim rtRectangle As RECT
  Dim ptPrevious As POINTAPI
  Dim ptOriginal As POINTAPI
  Dim bRestricted As Boolean
 
  'If the object to be moved is restricted to
  'a certain screen area then calculat the
  'screen coordinates
  If (lMinLeft > 0) Or (lMinTop > 0) Or (lMaxLeft > 0) Or (lMaxTop > 0) Then
    bRestricted = True
    lMinLeft = ScaleX(lMinLeft, ScaleMode, vbPixels)
    lMinTop = ScaleX(lMinTop, ScaleMode, vbPixels)
    lMaxLeft = ScaleX(lMaxLeft, ScaleMode, vbPixels)
    lMaxTop = ScaleX(lMaxTop, ScaleMode, vbPixels)
    pt.X = lMinLeft
    pt.Y = lMinTop
    Call ClientToScreen(hwnd, pt)
    lMinLeft = pt.X
    lMinTop = pt.Y
    pt.X = lMaxLeft
    pt.Y = lMaxTop
    Call ClientToScreen(hwnd, pt)
    lMaxLeft = pt.X
    lMaxTop = pt.Y
  End If
 
  'Convert the parameters to pixels
  lLeft = ScaleX(lLeft, ScaleMode, vbPixels)
  lWidth = ScaleX(lWidth, ScaleMode, vbPixels)
  lTop = ScaleY(lTop, ScaleMode, vbPixels)
  lHeight = ScaleY(lHeight, ScaleMode, vbPixels)
 
  'Convert the position to relative screen
  pt.X = lLeft
  pt.Y = lTop
  Call ClientToScreen(hwnd, pt)
  lLeft = pt.X
  lTop = pt.Y
 
  'Store the initial cursor position
  Call GetCursorPos(ptOriginal)
  pt = ptOriginal
 
  'Calculate the offset of the mouse position
  'compared to the upper-left corner of the
  'rectangle to be drawn
  lOffsetX = ptOriginal.X - lLeft
  lOffsetY = ptOriginal.Y - lTop
 
  'Calculate the first rectangle
  With rtRectangle
    .Left = lLeft
    .Top = lTop
    .right = lLeft + lWidth
    .bottom = lTop + lHeight
  End With
 
  'Draw the first rectangle
  Call DrawDragRectangle(rtRectangle.Left, rtRectangle.Top, rtRectangle.right, rtRectangle.bottom, 3)
 
  'Redraw the rectangle whenever the user
  'moves the mouse as long as the left
  'mouse button is pressed
  Do While (GetKeyState(VK_LBUTTON) < 0)
    Call GetCursorPos(pt)
    If (pt.X <> ptPrevious.X) Or (pt.Y <> ptPrevious.Y) Then
      ptPrevious.X = pt.X
      ptPrevious.Y = pt.Y
     
      'Erase the previous drag rectangle
      Call DrawDragRectangle(rtRectangle.Left, rtRectangle.Top, rtRectangle.right, rtRectangle.bottom, 3)
     
      'Recalculate the rectangle to draw
      With rtRectangle
        .Left = pt.X - lOffsetX
        .Top = pt.Y - lOffsetY
        If (bRestricted) Then
          If (.Left < lMinLeft) Then
            .Left = lMinLeft
          ElseIf (.Left > lMaxLeft) Then
            .Left = lMaxLeft
          End If
          If (.Top < lMinTop) Then
            .Top = lMinTop
          ElseIf (.Top > lMaxTop) Then
            .Top = lMaxTop
          End If
        End If
        .right = .Left + lWidth
        .bottom = .Top + lHeight
      End With
     
      'Draw the new rectangle onto the screen
      Call DrawDragRectangle(rtRectangle.Left, rtRectangle.Top, rtRectangle.right, rtRectangle.bottom, 3)
    End If
    DoEvents
  Loop
 
  'Erase the previous drag rectangle
  Call DrawDragRectangle(rtRectangle.Left, rtRectangle.Top, rtRectangle.right, rtRectangle.bottom, 3)
 
  'Convert the position to relative object's container
  lLeft = rtRectangle.Left
  lTop = rtRectangle.Top
  pt.X = lLeft
  pt.Y = lTop
  Call ScreenToClient(hwnd, pt)
  lLeft = pt.X
  lTop = pt.Y
   
  'Convert the parameters back from pixels
  'to the object's container's scalemode
  lLeft = ScaleX(lLeft, vbPixels, ScaleMode)
  lTop = ScaleY(lTop, vbPixels, ScaleMode)
  lWidth = ScaleX(lWidth, vbPixels, ScaleMode)
  lHeight = ScaleY(lHeight, vbPixels, ScaleMode)
 
  'Notify if this object was moved
  DragObject = (pt.X <> ptOriginal.X) Or (pt.Y <> ptOriginal.Y)
 
End Function

Private Sub DrawDragRectangle(ByVal X As Long, ByVal Y As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal lWidth As Long)

  'Draw a rectangle using the Win32 API

  Dim hdc As Long
  Dim hPen As Long
 
  hdc = GetDC(0)
  hPen = CreatePen(PS_SOLID, lWidth, &HE0E0E0)
  Call SelectObject(hdc, hPen)
  Call SetROP2(hdc, R2_NOTXORPEN)
  Call Rectangle(hdc, X, Y, X1, Y1)
  Call SelectObject(hdc, GetStockObject(BLACK_PEN))
  Call DeleteObject(hPen)
  Call SelectObject(hdc, hPen)
  Call ReleaseDC(0, hdc)
   
End Sub



Now you probably want an example too. And here it is...

1) Create a form and add a picturebox to the form.
2) Paste the function, API's and stuff into the form's (Declarations) part
3) Edit the Piture1_MouseDown event to this...

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

  Dim Top As Long
  Dim Left As Long
  Dim Width As Long
  Dim Height As Long
 
  Left = Picture1.Left
  Top = Picture1.Top
  Width = Picture1.Width
  Height = Picture1.Height
  If (DragObject(Left, Top, Width, Height, Picture1.Container.hwnd, Picture1.Container.ScaleMode, 0, 0, Me.ScaleWidth - Picture1.Width, Me.ScaleHeight - Picture1.Height)) Then
    Call Picture1.Move(Left, Top, Width, Height)
  End If

End Sub


Now you can click on the picturebox and be allowed to move it to anywhere on the form. Notice the picturebox is restricted to the form, so you can not move the picturebox outside the form. This is done by the lMinLeft/lMinTop/lMaxLeft/lMaxTop parameters. It should be fairly easy to use this solution, but if you need any more info let me know.

You 'll have to use some other control instead of Image.
Here is the quick example

' add three Pictureboxes and paste this code
Option Explicit
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Dim startx As Single, starty As Single
Dim moving As Boolean

Private Sub Form_Load()
    Picture1.Picture = Me.Icon
    Picture1.AutoSize = True
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim ptTemp As POINTAPI
    If Button = vbLeftButton Then
        Dim bdrx As Long, bdry As Long
        getBorderXY Picture1, bdrx, bdry
        startx = X + bdrx * 15
        starty = Y + bdry * 15
       
        GetCursorPos ptTemp
        Picture1.Visible = False
        SetParent Picture1.hwnd, 0&
        Picture1.Move ptTemp.X * 15 - startx, ptTemp.Y * 15 - starty
        Picture1.Visible = True
       
        SetCapture Picture1.hwnd
        moving = True
    End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim ptTemp As POINTAPI
    If moving And Button = vbLeftButton Then
        GetCursorPos ptTemp
        Picture1.Move ptTemp.X * 15 - startx, ptTemp.Y * 15 - starty
    End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim ptTemp As POINTAPI
    If moving And Button = vbLeftButton Then
        moving = False
        ReleaseCapture
       
        GetCursorPos ptTemp
       
        Picture1.Visible = False
       
        Dim NewContainer As Object ' form or control
        Dim HwndNewContainer As Long
        Dim ptNewContainer As POINTAPI
        HwndNewContainer = WindowFromPoint(ptTemp.X, ptTemp.Y)
       
        ' get new container
        If HwndNewContainer = Picture2.hwnd Then
            Set NewContainer = Picture2
        ElseIf HwndNewContainer = Picture3.hwnd Then
            Set NewContainer = Picture3
        ElseIf HwndNewContainer = Me.hwnd Then
            Set NewContainer = Me
        Else
            Set NewContainer = Me
            Beep
        End If

'        SetParent Picture1.hwnd, NewContainer.hwnd
        Set Picture1.Container = NewContainer
        ScreenToClient NewContainer.hwnd, ptTemp
        Picture1.Move ptTemp.X * 15 - startx, ptTemp.Y * 15 - starty
        Picture1.Visible = True
    End If
End Sub

Private Sub getBorderXY(Control As Control, bdrx As Long, bdry As Long)
    ' calculate border
    'bdrx = 2
    'bdry = 2
    Dim ptContainer As POINTAPI
    Dim ptControl As POINTAPI
    ClientToScreen Control.Container.hwnd, ptContainer
    ClientToScreen Control.hwnd, ptControl
   
    bdrx = ptControl.X - (ptContainer.X + Control.Left / 15)
    bdrx = ptControl.Y - (ptContainer.Y + Control.Top / 15)
End Sub

Dear friends,

First, thank you for your kind answers.

Vbmaster, your code does not work. I added another PictureBox and used it as a container for the first one. I could not drag Picture1 out of Picture2.

ameba, your code works fine, but - as andyclap mentioned - picture boxes don't do transparency. My pictures are not rectangled and I don't want to see the background of the PictureBox.

Besides, I have a large number of pictures and a control that is lighter than PictureBox is preferable.

Is there a way to solve this thing?...

I found one bug where all "hWnd" should be "OwnerhWnd". Silly me. ,)

With my current code you should be able to move the image control outside the picturebox but it will not change the container incase you move the control "onto" another control. For this you will need to run WindowFromPoint API with the cursor position (GetCursorPos API) to get the hWnd of the control the mouse cursor is over, and then use the SetParent API to change the container, or you can loop thru all controls on the form using something like...

Dim Control As Control

If (Me.hWnd = [the_hwnd_given_from_windowfrompoint]) Then
  Set Image1.Container = Me
Else
  For Each Control In Formname.Controls
    If (Not (TypeOf Control Is Line)) Then
      If (Control.hWnd = [the_hwnd_given_from_windowfrompoint]) Then
        Set Image1.Container = Control
        Exit For
      End If
    End If
  Next
End If

To pass control anywhere and have it on-top, it must be 'heavy' control, with Hwnd.

Maybe this can work - only one temporary picture control:

In Image1_MouseDown:
Hide your image control. Show picturebox picTemp and move it around

In Image1_MouseDown:
When user drops picTemp, show your Image control, change its container and set its position.
Hide picTemp for later use.

What do you thank?

corr.
>What do you thank?
What do you think?  :)

You could do a couple of things:

Draw the picture to the desktop hwnd. This is what vbmaster is proposing, but using a dragrectangle, not the picture. You'll need to think about refreshing what's underneath your image as you draw it, and it could be quite tricky to do to get the transparency right.

Use a picture box, and use the setwindowregion api commands to make it irregularly shaped. Unfortunately there's no createregion functions to create an irregular region from a mask or a transparent part of a gif, but if your image is a predictable shape, this would be straightforward. If your picture's transparency is unknown, you'll have to look into the picture's data and change the region pixel by pixel, which would probably be slow and as much work as drawing to the desktop hwnd.

>        movImage.Visible = True
>    End If
>End Sub

You can also add 2 lines:

        movImage.Visible = True
        movImage.ZOrder 0
        Set movImage = Nothing ' cleanup
    End If
End Sub

or make the picturebox picTemp transparent.

If you are targetting Win2K only, there's a whole new ball-game of transparent (and alpha-channeled) windows.
But of course, nobody just targets Win2K...


Have you though about not using windowed controls at all on your form, ie getting rid of your picture box containers, just drawing them using shape controls (or GDI API)?

Friends,
I realize now that there is no easy way of dealing with transparency while dragging over containers.

andyclap, the shapes of the images are not predictable and going pixel by pixel is not realistic at this stage. I thought about giving up on the containers, but I need them for scrolling, tabbing (TabStrip) and stuff like that, and not using containers will cause me much more headache than dragging the pictures.

ameba, I'm accepting your answer, although the transparency matter is not solved.

You are all so kind and helping, I wish I could give points to all of you.

And one more thing...
I'm not familiar with DirectX processing, but I think there is a way to define different levels of screens (like layers). If so, it could be the solution. Do you know anything about it?