Question : Drag a custom drawn rectangle on an Access form

Dear experts,

some years ago I asked if it was possible to draw a rectangle on an Access form and the feedback I got worked brilliantly. Here's the original question with the solution:
http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_21853534.html

Now, I would like to take this one step further: I want to be able to drag that custom drawn rectangle to another location on the form (preferably in such a way that you can actually see the rectangle move across the form).

And (while we're at it) I would like to copy a rectangle (for instance by holding the control key) and then dragging the copy to another part of the form.

Can you help me accomplish this?

Kind regards,
Keimpe Wiersma

Answer : Drag a custom drawn rectangle on an Access form

> You answered the question last time.

That's quite funny! I should have checked. In the meantime I was off for quite some time... You know that I even remember the Marina application?

Anyway, I'm glad you found a way to merge both pieces of code. This looks very good.

I added a second rectangle to my form, initially hidden. The module below will trigger a copy when the first mouse down event is with Ctrl down. Next you will want to make copies of the copy, and start adding mouse events for the new rectangle, right?

At some point, it will have to be managed through a class module, or your code will become unmanageable... And you will have to decide on the maximum number of rectangles you are willing to manage.

Have fun! (didn't I say that a few years ago?)
(°v°)

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:



Option Explicit
 
Dim Started As Boolean, Copy As Boolean, StartX As Single, StartY As Single
 
Private Sub Box0_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Started = True: StartX = X: StartY = Y
    Copy = (Shift And acCtrlMask)
    If Copy Then
        Box1.Top = Box0.Top
        Box1.Left = Box0.Left
        Box1.Width = Box0.Width
        Box1.Height = Box0.Height
        Box1.Visible = True
    End If
    
End Sub
 
Private Sub Box0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
    If Started Then
        If Copy Then
            Box1.Left = Box0.Left + X - StartX
            Box1.Top = Box0.Top + Y - StartY
        Else
            Box0.Left = Box0.Left + X - StartX
            Box0.Top = Box0.Top + Y - StartY
        End If
    End If
End Sub
 
Private Sub Box0_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Started = False
End Sub

Open in New Window

Select All