How To Make An Access Form Draggable

A few years ago, I built a MS Access client/server application for a RI direct marketing firm.

I wanted to build a nice interface that resembled a standard desktop application. I especially wanted to add the ability for the user to drag the form around the screen.

Of course the standard form with a border can be dragged everywhere; however, I removed the border and was looking for dragging capability either without the border or with a custom border.

See example of my draggable form below.


I accomplished this task with two modules and a mouse down event.

First, set the form's Border Style in the Format tab of the Property Sheet window to "None".

  1. Module basAPIDeclaration
Option Compare Database
Option Explicit

'To set the Shape of the FORM
Public Declare Function apiCreateEllipticRgn Lib "GDI32" _
  Alias "CreateEllipticRgn" _
  (ByVal X1 As Long, _
  ByVal Y1 As Long, _
  ByVal X2 As Long, _
  ByVal Y2 As Long) As Long

Public Declare Function apiCreatePolygonRgn Lib "GDI32" _
  Alias "CreatePolygonRgn" _
  (lpPoint As Any, _
  ByVal nCount As Long, _
  ByVal nPolyFillMode As Long) As Long

Public Const WINDING = 2
Public Const ALTERNATE = 1

Public Declare Function apiCreateRectRgn Lib "GDI32" _
    Alias "CreateRectRgn" _
    (ByVal X1 As Long, _
    ByVal Y1 As Long, _
    ByVal X2 As Long, _
    ByVal Y2 As Long) _
    As Long

'combine two regions
Public Declare Function apiCombineRgn Lib "GDI32" _
  Alias "CombineRgn" _
  (ByVal hDestRgn As Long, _
  ByVal hSrcRgn1 As Long, _
  ByVal hSrcRgn2 As Long, _
  ByVal nCombineMode As Long) As Long

'Const for the nCombineMode
Public Const RGN_AND = 1
Public Const RGN_COPY = 5
Public Const RGN_DIFF = 4
Public Const RGN_OR = 2
Public Const RGN_XOR = 3

Public Declare Function apiDeleteObject Lib "GDI32" _
  Alias "DeleteObject" _
  (ByVal hObject As Long) As Long

Public Declare Function apiSetWindowRgn Lib "user32" _
  Alias "SetWindowRgn" _
  (ByVal hwnd As Long, _
  ByVal hRgn As Long, _
  ByVal bRedraw As Boolean) As Long
 
Public Declare Function apiGetWindowRect Lib "user32" _
  Alias "GetWindowRect" _
  (ByVal hwnd As Long, _
  lpRect As RECT) _
  As Long

Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

'To Simulate the Caption Move
Public Declare Function apiReleaseCapture Lib "user32" _
  Alias "ReleaseCapture" () As Long

Public Declare Function apiSendMessage Lib "user32" _
  Alias "SendMessageA" _
  (ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long

Public Const WM_SYSCOMMAND As Long = &H112
Public Const SC_MOVE_MOUSE As Long = &HF012&

2. Module basHandleCursor

Option Compare Database
Option Explicit

'Change The Mouse Pointer
Private Const IDC_APPSTARTING = 32650&
Private Const IDC_ARROW = 32512&
Private Const IDC_CROSS = 32515&
Private Const IDC_IBEAM = 32513&
Private Const IDC_ICON = 32641&
Private Const IDC_NO = 32648&
Private Const IDC_SIZE = 32640&
Private Const IDC_SIZEALL = 32646&
Private Const IDC_SIZENESW = 32643&
Private Const IDC_SIZENS = 32645&
Private Const IDC_SIZENWSE = 32642&
Private Const IDC_SIZEWE = 32644&
Private Const IDC_UPARROW = 32516&
Private Const IDC_WAIT = 32514&

Private Declare Function apiLoadCursorBynum Lib "user32" _
  Alias "LoadCursorA" _
  (ByVal hInstance As Long, _
  ByVal lpCursorName As Long) _
  As Long

Private Declare Function apiLoadCursorFromFile Lib "user32" _
  Alias "LoadCursorFromFileA" _
  (ByVal lpFileName As String) _
  As Long

Private Declare Function apiSetCursor Lib "user32" _
  Alias "SetCursor" _
  (ByVal hCursor As Long) _
  As Long

Public Function InsideCircle(img As Image, x As Single, Y As Single) As Boolean
  'assume you are outside the circle
  InsideCircle = False
  If (x - (img.Width / 2)) ^ 2 + (Y - (img.Height / 2)) ^ 2 <= (img.Height / 2) ^ 2 Then
    'Inside the circle
    InsideCircle = True
  End If
End Function
Public Sub ChangeCursor()
'based on the AccWebFAQ by Douglas Taylor
Dim strDBPath As String
Dim lngRet As Long
Const curNAME = "Cursor1.CUR"
 
  strDBPath = CurrentDb.Name
  strDBPath = Left(strDBPath, InStr(strDBPath, Dir(strDBPath)) - 1)
  If Len(Dir(strDBPath & curNAME)) > 0 Then
    lngRet = apiLoadCursorFromFile(strDBPath & curNAME)
    lngRet = apiSetCursor(lngRet)
    'PointM (strDBPath & curNAME)
  End If
End Sub

             3. On the form's Detail properties' MouseDown event, added the following code.

Private Sub Detail_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    'drag/move form
    apiReleaseCapture
    Call apiSendMessage(Me.hwnd, WM_SYSCOMMAND, SC_MOVE_MOUSE, 0)
End Sub

Now, whenever you click on the Details section of the form, it becomes draggable. I recently noticed that the MouseDown event can be implemented with any control on the page.

In closing, I cannot take credit for this amazing functionality in MS Access, as I found the code online. I wish I knew the person who took the time to write these two modules. It was sheer brilliance, and if it was you, then thank you! This works so very well.
 

What did you think of this article?




Trackbacks
  • No trackbacks exist for this post.
Comments
  • No comments exist for this post.
Leave a comment

Submitted comments are subject to moderation before being displayed.

 Name (required)

 Email (will not be published) (required)

Your comment is 0 characters limited to 3000 characters.