Selecting and moving multiple controls at runtime

"The ideal solution would be to be able to select them as a group by drawing a square around them with the mouse"

Here is a basic approach to allow "rubberbanding" on your form and then how to determine which controls were touched by the selection area:

Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As Point) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex&) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle&, ByVal nWidth&, ByVal crColor&) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, 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&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
Private Declare Function IntersectRect Lib "user32" (lpDestRect As Rect, lpSrc1Rect As Rect, lpSrc2Rect As Rect) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As Point) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Type Point
    X As Long
    Y As Long
End Type

Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const SW_NORMAL = 1
Private Const NULLBRUSH = 5

Private desktopDC As Long
Private cxBorder&
Private capturing As Boolean
Private startBox As Point
Private lastPt As Point
Private endBox As Point
Private boxDrawn As Boolean

Private Sub Form_Load()
    capturing = False
    cxBorder = GetSystemMetrics(5) ' window border size
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    capturing = True
    GetCursorPos startBox
    lastPt.X = startBox.X
    lastPt.Y = startBox.Y
    boxDrawn = False
    Dim r As Rect
    Call GetWindowRect(Me.hwnd, r)
    Call ClipCursor(r)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pt As Point
    If capturing Then
        GetCursorPos pt
        If Abs(pt.X - startBox.X) >= cxBorder And Abs(pt.Y - startBox.Y) >= cxBorder And _
                (pt.X <> lastPt.X Or pt.Y <> lastPt.Y) Then
            If boxDrawn Then
                rubberBand lastPt
            End If
            rubberBand pt
            lastPt.X = pt.X
            lastPt.Y = pt.Y
            boxDrawn = True
        End If
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    capturing = False
    GetCursorPos endBox
    rubberBand endBox
    Call ClipCursor(Null)
   
    ' see what was selected
    Call FindSelectedControls
End Sub

Private Sub rubberBand(curPt As Point)
    Dim hPen&, hOldPen&, hOldBrush&, hNullBrush&
   
    Dim cr As Long
    Dim rc As Rect
    Const NULL_BRUSH = 5
    Const R2_NOT = 6
    Const PS_INSIDEFRAME = 6
       
    ' normalize the box
    If startBox.X < curPt.X Then
        rc.Left = startBox.X
        rc.Right = curPt.X
    Else
        rc.Left = curPt.X
        rc.Right = startBox.X
    End If
   
    If startBox.Y < curPt.Y Then
        rc.Top = startBox.Y
        rc.Bottom = curPt.Y
    Else
        rc.Top = curPt.Y
        rc.Bottom = startBox.Y
    End If

    desktopDC = GetWindowDC(GetDesktopWindow())
   
    ' Create an inverse pen that is the size of a window border.
    SetROP2 desktopDC, R2_NOT
    cr = RGB(0, 0, 0)
    hPen = CreatePen(PS_INSIDEFRAME, 3 * cxBorder, cr)

    ' Draw the rectangle
    hOldPen = SelectObject(desktopDC, hPen)
    hNullBrush = GetStockObject(NULL_BRUSH)
    hOldBrush = SelectObject(desktopDC, hNullBrush)
    Rectangle desktopDC, rc.Left, rc.Top, rc.Right, rc.Bottom
    SelectObject desktopDC, hOldBrush
    SelectObject desktopDC, hOldPen
    DeleteObject hPen
    DeleteObject hNullBrush
    ReleaseDC GetDesktopWindow(), desktopDC
End Sub

Private Sub FindSelectedControls()
    On Error GoTo hWndLessControl
   
    Dim c As Control
    Dim p As Point
    Dim selectR As Rect
    Dim controlR As Rect
    Dim intersectR As Rect
       
    ' normalize the selection box
    If startBox.X < endBox.X Then
        selectR.Left = startBox.X
        selectR.Right = endBox.X
    Else
        selectR.Left = endBox.X
        selectR.Right = startBox.X
    End If
    If startBox.Y < endBox.Y Then
        selectR.Top = startBox.Y
        selectR.Bottom = endBox.Y
    Else
        selectR.Top = endBox.Y
        selectR.Bottom = startBox.Y
    End If

    ' calculate intersections for each control
    Debug.Print "Selected Controls:"
    For Each c In Me.Controls
        Call GetWindowRect(c.hwnd, controlR)
calcIntersection:
        Call IntersectRect(intersectR, selectR, controlR)
        If ((intersectR.Right - intersectR.Left) > 0) Or ((intersectR.Bottom - intersectR.Top) > 0) Then
            Debug.Print c.Name & " Selected"
        End If
    Next c
    Debug.Print
    Exit Sub
   
hWndLessControl:
    p.X = Me.ScaleX(c.Left, Me.ScaleMode, vbPixels)
    p.Y = Me.ScaleY(c.Top, Me.ScaleMode, vbPixels)
    Call ClientToScreen(Me.hwnd, p)
    controlR.Left = p.X
    controlR.Top = p.Y
    controlR.Right = controlR.Left + Me.ScaleX(c.Width, Me.ScaleMode, vbPixels)
    controlR.Bottom = controlR.Top + Me.ScaleY(c.Height, Me.ScaleMode, vbPixels)
    Resume calcIntersection
End Sub

Thanks Idle Mind...

I did a quick try of it and it works for selecting the controls.  I haven't been able to move them with the mouse yet, but I have been able to move them with another button.  I haven't had much time to play around with it though but I will again later.  Will I be able to move the selection with the mouse using this solution??

Thanks a lot!!
ahamamr

The code I posted above just provides a way to "select" more than one control with rubberbanding.  You need to figure out a way to display your user control differently so that it appears selected.

I'll post another snippet of code that shows how to drag more than control later.

Right now I have to take the family off to Thanksgiving dinner...        =)

Thanks!...
Yes...enjoy your Thanksgiving immensly!!  I am stuffed and I need to get back to visiting instead of being so obsessed with getting this to work.
I figured out how I am going to display my controls when they are selected, and like I said before, I can use that as the property to look for (BorderStyle) in an event to move them with a button, but I would really like that code you said that would move more than one control with the mouse in case I can't figure it out.

Thank you very much!!

Happy Thanksgiving!
ahammar

Hi again Idle Mind

Just thought I would let you know I have been playing around with it some more.  I applied it to the app I am currently designing and could not get it to work at first.  I had quite a time figuring out why.  Come to find out... this code won't work if you have menus on your form or a common dialog control on your form, even if you are not selecting it.  I don't know if there is more you cannot have on your form.  I did get it to work partially so far but I had to add some code to tell it not to run the hWndLessControl section if it was currently working with menu items or a common dialog control.  Another problem I am having is when I make an exe file out of it, and use it, my mouse shoots to the top of the window and gets stuck there.  Very weird.  But I just installed a VB6 update before that, so I don't know if that has anything to do with it or not.  Anyway...just giving you heads up and I will be working with it more later...
Thanks again!
ahammar

this is just to do selection rest is just moving the selected controls

https://www.experts-exchange.com/questions/21281410/Select-Mutiple-textboxes-at-runtime.html?query=Selecting+and+moving+multiple+controls+at+runtime&clearTAFilter=true

ahammar,

I'm not getting the mouse problem with the EXE...not sure why that is happening for you.

As far as the other problem is concerned, we can restrict the selection of controls to only a certain type using either the TypeOf keyword or the TypeName() function.

The example below works with a control array of type Label.  Create a New Project and add a Label.  Copy and Paste it several times to make a control array (Label1).  Move the labels around so you can select them independently or with rubberbanding.

You should be able to select a group of controls using rubberbanding.  Try holding down the Ctrl key and then adding or removing labels from the selection group.  

Try dragging them around now...

The code will need modification to work with your usercontrols but I think it demonstrates the idea.

Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As Point) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex&) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle&, ByVal nWidth&, ByVal crColor&) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, 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&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
Private Declare Function IntersectRect Lib "user32" (lpDestRect As Rect, lpSrc1Rect As Rect, lpSrc2Rect As Rect) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As Point) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Private Type Point
    X As Long
    Y As Long
End Type

Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const SW_NORMAL = 1
Private Const NULLBRUSH = 5
Private Const VK_CONTROL = &H11

Private desktopDC As Long
Private cxBorder&
Private capturing As Boolean
Private startBox As Point
Private lastPt As Point
Private endBox As Point
Private boxDrawn As Boolean
Private selected As New Collection
Private sX As Single
Private sY As Single
Private dragged As Boolean

Private Sub Form_Load()
    capturing = False
    cxBorder = GetSystemMetrics(5) ' window border size
    Dim c As Control
    For Each c In Me.Controls
        If TypeOf c Is Label Then
            c.Appearance = 0 'flat
            c.BackColor = &H8000000F
        End If
    Next
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    capturing = True
    GetCursorPos startBox
    lastPt.X = startBox.X
    lastPt.Y = startBox.Y
    boxDrawn = False
    Dim r As Rect
    Call GetWindowRect(Me.hwnd, r)
    Call ClipCursor(r)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pt As Point
    If capturing Then
        GetCursorPos pt
        If Abs(pt.X - startBox.X) >= cxBorder And Abs(pt.Y - startBox.Y) >= cxBorder And _
                (pt.X <> lastPt.X Or pt.Y <> lastPt.Y) Then
            If boxDrawn Then
                rubberBand lastPt
            End If
            rubberBand pt
            lastPt.X = pt.X
            lastPt.Y = pt.Y
            boxDrawn = True
        End If
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    capturing = False
    GetCursorPos endBox
    rubberBand endBox
    Call ClipCursor(Null)
   
    ' see what was selected
    Call FindSelectedControls
End Sub

Private Sub rubberBand(curPt As Point)
    Dim hPen&, hOldPen&, hOldBrush&, hNullBrush&
   
    Dim cr As Long
    Dim rc As Rect
    Const NULL_BRUSH = 5
    Const R2_NOT = 6
    Const PS_INSIDEFRAME = 6
       
    ' normalize the box
    If startBox.X < curPt.X Then
        rc.Left = startBox.X
        rc.Right = curPt.X
    Else
        rc.Left = curPt.X
        rc.Right = startBox.X
    End If
   
    If startBox.Y < curPt.Y Then
        rc.Top = startBox.Y
        rc.Bottom = curPt.Y
    Else
        rc.Top = curPt.Y
        rc.Bottom = startBox.Y
    End If

    desktopDC = GetWindowDC(GetDesktopWindow())
   
    ' Create an inverse pen that is the size of a window border.
    SetROP2 desktopDC, R2_NOT
    cr = RGB(0, 0, 0)
    hPen = CreatePen(PS_INSIDEFRAME, 3 * cxBorder, cr)

    ' Draw the rectangle
    hOldPen = SelectObject(desktopDC, hPen)
    hNullBrush = GetStockObject(NULL_BRUSH)
    hOldBrush = SelectObject(desktopDC, hNullBrush)
    Rectangle desktopDC, rc.Left, rc.Top, rc.Right, rc.Bottom
    SelectObject desktopDC, hOldBrush
    SelectObject desktopDC, hOldPen
    DeleteObject hPen
    DeleteObject hNullBrush
    ReleaseDC GetDesktopWindow(), desktopDC
End Sub

Private Sub FindSelectedControls()
    Dim c As Control
    Dim p As Point
    Dim selectR As Rect
    Dim controlR As Rect
    Dim intersectR As Rect
       
    ' normalize the selection box
    If startBox.X < endBox.X Then
        selectR.Left = startBox.X
        selectR.Right = endBox.X
    Else
        selectR.Left = endBox.X
        selectR.Right = startBox.X
    End If
    If startBox.Y < endBox.Y Then
        selectR.Top = startBox.Y
        selectR.Bottom = endBox.Y
    Else
        selectR.Top = endBox.Y
        selectR.Bottom = startBox.Y
    End If

    ' calculate intersections for each control
    SelectControls False
    Set selected = New Collection
    For Each c In Me.Controls
        ' for controls with an hWnd, use the line below
        'Call GetWindowRect(c.hwnd, controlR)
   
        ' for controls with no hWnd (like the label), use code like below
        If TypeOf c Is Label Then
            p.X = Me.ScaleX(c.Left, Me.ScaleMode, vbPixels)
            p.Y = Me.ScaleY(c.Top, Me.ScaleMode, vbPixels)
            Call ClientToScreen(Me.hwnd, p)
            controlR.Left = p.X
            controlR.Top = p.Y
            controlR.Right = controlR.Left + Me.ScaleX(c.Width, Me.ScaleMode, vbPixels)
            controlR.Bottom = controlR.Top + Me.ScaleY(c.Height, Me.ScaleMode, vbPixels)
           
            Call IntersectRect(intersectR, selectR, controlR)
            If ((intersectR.Right - intersectR.Left) > 0) Or ((intersectR.Bottom - intersectR.Top) > 0) Then
                selected.Add c
            End If
        End If
    Next c
    SelectControls True
End Sub

Private Sub SelectControls(ByVal state As Boolean)
    Dim c As Control
    For Each c In selected
        If state Then
            c.BorderStyle = 1
        Else
            c.BorderStyle = 0
        End If
    Next c
End Sub

Private Sub Label1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        sX = X
        sY = Y
        dragged = False
    End If
End Sub

Private Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        dragged = True
        Dim c As Control
        For Each c In selected
            c.Left = c.Left + (X - sX)
            c.Top = c.Top + (Y - sY)
        Next
    End If
End Sub

Private Sub Label1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton And Not dragged Then
        If Not CtrlKey Then
            If Label1(Index).BorderStyle = 0 Then
                Label1(Index).BorderStyle = 1
                SelectControls False
                Set selected = New Collection
                selected.Add Label1(Index)
            Else
                SelectControls False
                Set selected = New Collection
                Label1(Index).BorderStyle = 0
            End If
        Else
            If Label1(Index).BorderStyle = 0 Then
                Label1(Index).BorderStyle = 1
                selected.Add Label1(Index)
            Else
                Label1(Index).BorderStyle = 0
                Dim i As Integer
                For i = 1 To selected.Count
                    If selected.Item(i) Is Label1(Index) Then
                        selected.Remove i
                        Exit For
                    End If
                Next
            End If
        End If
    End If
End Sub

Private Function CtrlKey() As Boolean
   CtrlKey = GetKeyState(VK_CONTROL) And &H80
End Function

Thanks Idle Mind.  I tried this and it works great!...even as an exe.  I haven't tried it with my app yet.  I am using some simple active x controls as an array (just like your example above with labels) on my form.  Do you know what I need to call them in my TypeOf control statement??  Also, there is one little glitch that may cause a problem, but I can live with that if you don't know how to fix it.  When I make a selection of labels, move them, then click on an unselected control without letting the mouse button up and try and move it, the rest of the controls that were previously selected shoot off the screen with the movement of the mouse.  After I make a selection I have to be sure and click and release on a different control, then click on it again before I try to move that one.
But I am happy with the way it works other than that and I am going to try to implement it into my app later on.
Thanks!


Navstar16,
Thanks  for your comment.  I checked it out, but haven't tried it yet.  I am working with Idle Mind's solution for the moment, but it is going to take some time.  If it won't work with the design I already have, then I will give your's a try.  I greatly appreciate your comment.  Thanks!

Cheers!
ahammar

Hi Idle Mind

I got your code working good!  There is one small problem that maybe you can fix, maybe not, but you got the points regardless.  It works really good!
The minor problem I have is when I click on my file menu to open a file (by using a commonDialog control) then double click on the file to open, it draws a rectangle on my form that will not go away.  If I just select the file by single clicking on it, then click open, that doesn't happen and it works fine.
I don't know why it does that.  Actually I can erase the rectangle if I grab a control and wipe over it, like an eraser in Paint or something.  I can live with that though if it's to hard to fix.

Also, if you are up for even more of a challenge, I will up the points by 500 to make it 1000 if you can show me how to rotate a selection in small increments, but that's entirely up to you.  If you don't want to do that, that is fine, I will post another question, I just figured it would be easier for you since you are already familiar with the code to make the selection in the first place.  If you do that, I would need the selection of controls to rotate, then afterwards be able to select any single control  (or different selection of controls) and move it around with it still in it's rotated position just as if it was originally put on the form that way.  I believe that will be a very difficult task, so it's up to you whether you want to tackle that or not.

Thanks for all your help!  You got the points!  Just let me know if you want the extra points for the rotating now...

ahammar

ahammar,

I can't reproduce the box on your form after a double click in a common dialog bug.  Not sure what is going on there.  Perhaps it is something about the way you have the form layed out...would it be possible for you to upload a project with the bug somewhere?

The CreateFont() API would be used to rotate the text:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/fontext_8fp0.asp

Here is an example of it in action:
http://www.mentalis.org/apilist/CreateFont.shtml
http://www.mentalis.org/apilist/47692B4BB2CD48B5E60CFD96A5A39F20.html

So as the selection is rotated you could update an "angle" value in your UserControl and draw it's contents accordingly.  The tricky part is adjusting the height/width of the usercontrol to properly accomodate your rotated text.

This is much trickier than simply moving around labels...

Hi Idle Mind.

I haven't had a chance to look at the links you supplied yet, but wanted to let you know that I don't have anywhere I can upload it too.  I could e-mail you a simplified version along with the ActiveX control for you to look at if that will work, but only at your convienience.  I still have a lot of other work to do to it.

As far as rotating, I only need to rotate my custom controls, there is not text I need to rotate.  The labels are seperate controls from my custom controls, and they don't need to rotate.  I have my code now so that when I select a bunch of controls, the labels aren't even included.  My controls are very simple...just a container with either a line, or a shape and minimal design code.

I will check out your links later... off to work right now...have a great day!

Thanks again

So you need to rotate some shapes in your usercontrols?  What kinds of shapes we talking?

I actually need to rotate the the entire control in coincidence with whatever controls are selected.  In other words rotate a selection of controls as if they were 1.
My ActiveX controls are nothing more than a container with a line, or shape.  I have 5 controls in all so far.  1 with a vertical line, 1 with a horizontal line, 1 with a back diagonal, 1 with a forward diagonal, and 1 with a shape (oval) .  They are each set up in an array  on my project so that I can load them at run time,  move them around and create diagrams or pictures.  About the only thing programmed into the control itself is code to keep the line the same width or height as the container, a couple of events, and properties.  That way I can change the dimensions of the control at run time which in turn will change the length of the lines, (also angles of the diagonals).  I would like to be able to select my entire diagram (or just a portion of it) and rotate the entire selection.

I still haven't had a chance to look at the link you posted yet, but I will sometime soon.

If I get information from you that leads to me being able to rotate a selection of controls along with moving them like I can now, then I will, as promised, increase the points to 1000

Thanks again.

The links I provided won't be of much help to you as they are only for creating text at any angle.

What you are asking for is NOT trivial...

In fact, if I were to write an application in VB6 that does what you describe I probably wouldn't use UserControls at all.  I would take a different approach and create a Class to represent the shapes and store them in a Collection object.  Then I would use the Paint() event of a PictureBox to iterate thru the class instances and draw each shape onto the PictureBox.  This would eliminate the problem of changing the size of the UserControl to properly accomadate the new size of the shapes as they are rotated.

I would use handles on the shapes to allow the user to change the shapes.  This makes hit testing easier since you don't have to do an expensive calculation to handle any point along a line at any angle.

The oval will be particularly difficult to draw at any angle as you will need to calculate the points manually...not easy.

Unfortunately I don't have a good example of this type of system in VB6.  I do have several demos that use this type of approach written in VB.Net though.  It is easy to rotate shapes there because you can actually rotate and translate the entire coordinate system itself before you draw...so easy.

I'll see if I can come up with a simplified example for you.

Yeah, I kinda figured it was going to be really hard.  That wasn't in my original thoughts for my application, so I may skip that still.  I have put so many hours into this, I don't think I want to redo it, although your suggestion would probably have worked better.  I actually was advised to create custom controls to do this, and these are my first ones, so I am just learning how to make ActiveX controls.  I am going to go ahead and give you these points now.  You have been a great help.  Thanks!!
If you do figure something out for rotating a selection the way I am selecting them now, you can always still post it here and I will give you another 500 points with another question.

Thanks and Cheers!

ahammar