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".
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.
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".
- 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 basHandleCursor3. On the form's Detail properties' MouseDown event, added the following code.
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
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.


Comments