Version 3.5 Approx 0.6 MB (zipped) First Published 14 Mar 2024 Last Updated 30 Mar 2024
Section Links (this page):
Introduction
Download
How the Example App Works
Update to version 3.5
Video
Feedback
Introduction Return To Top
The first part of this article demonstrated how a borderless form can be moved using a mouse down event.
Doing this requires just one line of code DragFormWindow Me and two APIs.
In this article, the idea is extended further to show how borderless forms can also be resized using a combination of mouse down and mouse move events.
The idea for this article came from a comment by @gonefishing2016 in response to the YouTube video which accompanied my previous article.
The exchange was as follows:
Download Return To Top
Click to download: Move & Resize Borderless Form v3.5 ACCDB file Approx 0.6 MB (zipped)
Download and unblock the zip file. For more details, see my article: Unblock downloaded files by removing the Mark of the Web
Unzip and save the ACCDB file to a trusted location.
How the Example App works Return To Top
The solution involves using code to:
a) detect when the mouse cursor is within a specified distance of the edges of the form.
b) respond to mouse move events when within that region to drag the form edge in the direction of mouse movement.
NOTE:
1. I chose a distance range of 100 twips for resizing purposes where 1440 twips = 1 inch or 567 twips = 1 cm.
However, this value can be altered to suit individual preferences.
2. The resize code would also work with forms using Thin & Dialog border styles.
However, I have disabled that functionality as those border styles are specifically selected when a fixed border is required.
3. The code to move the form by dragging has no effect if the form's Movable property is set to No.
4. As we now have several different mouse actions, the mouse cursor changes depending on which action is currently being done.
The two APIs used to manage the mouse cursor are in module modChangeCursor:
CODE:
Option Compare Database
Option Explicit
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=929
'Declarations for API Functions (Access 2010 or later (32-bit / 64-bit)
Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As LongPtr, ByVal lpCursorName As Long) As LongPtr
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As LongPtr) As LongPtr
' Declare Windows API Constants for Windows System cursors
Public Const GCW_HCURSOR As Long = (-12)
Public Const IDC_APPSTARTING As Long = 32650&
Public Const IDC_HAND As Long = 32649&
Public Const IDC_ARROW As Long = 32512&
Public Const IDC_CROSS As Long = 32515&
Public Const IDC_IBEAM As Long = 32513&
Public Const IDC_ICON As Long = 32641&
Public Const IDC_NO As Long = 32648&
Public Const IDC_SIZE As Long = 32640&
Public Const IDC_SIZEALL As Long = 32646&
Public Const IDC_SIZENESW As Long = 32643&
Public Const IDC_SIZENS As Long = 32645&
Public Const IDC_SIZENWSE As Long = 32642&
Public Const IDC_SIZEWE As Long = 32644&
Public Const IDC_UPARROW As Long = 32516&
Public Const IDC_WAIT As Long = 32514&
'================================================
'Omit optional parameter for default cursor
Public Sub ChangeCursorTo(Optional ByVal lngCursor As Long = IDC_ARROW)
SetCursor LoadCursor(0&, lngCursor)
End Sub
The ChangeCursorTo procedure has been added to the DragFormWindow function in modMoveResizeForm:
Public Function DragFormWindow(frm As Form)
'Colin Riddington - April 2019 / Updated March 2024
'change cursor to a 4-headed arrow
ChangeCursorTo (IDC_SIZEALL)
With frm
ReleaseCapture
SendMessage .hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End With
'revert to default arrow cursor
ChangeCursorTo
End Function
As a result, the mouse cursor is changed to a 4-headed arrow when dragging the form to a new position.
When resizing, the cursor appearance changes to one of 8 possible values depending on the direction of mouse movement when close to the form edges.
The short video (0:51) below (no audio) shows both moving and resizing the form in action.
The ResizeFormWindow function used to move and resize the form window is also in modMoveResizeForm. It is based on some VB.net code by Nick Thissen dating back to 2009 which I found at Move and Resize a Control or a Borderless Form - using window messages
The code was converted to VBA on my behalf by Xevi Batlle. Other than some minor tweaks, I can take very little credit for this code.
Many thanks to both Nick and Xevi for the following code:
Public Function ResizeFormWindow(frm As Form, direction As RESIZEDIRECTION)
Dim directionConstant As Integer
Dim cursorShape As Integer
'Adapted by Xevi Batlle from VB.net code originally by Nick Thissen - May 2009
https://www.vbforums.com/showthread.php?568015-Move-and-Resize-a-Control-or-a-Borderless-Form-using-window-messages-(smooth!)
Select Case direction
Case TopLeft
directionConstant = HTTOPLEFT
cursorShape = IDC_SIZENWSE
Case BottomLeft
directionConstant = HTBOTTOMLEFT
cursorShape = IDC_SIZENESW
Case BottomRight
directionConstant = HTBOTTOMRIGHT
cursorShape = IDC_SIZENWSE
Case TopRight
directionConstant = HTTOPRIGHT
cursorShape = IDC_SIZENESW
Case Left
directionConstant = HTLEFT
cursorShape = IDC_SIZEWE
Case Right
directionConstant = HTRIGHT
cursorShape = IDC_SIZEWE
Case Top
directionConstant = HTTOP
cursorShape = IDC_SIZENS
Case Bottom
directionConstant = HTBOTTOM
cursorShape = IDC_SIZENS
Case Else
Exit Function
End Select
'change mouse cursor
ChangeCursorTo (cursorShape)
With frm
ReleaseCapture
SendMessage .hWnd, WM_NCLBUTTONDOWN, directionConstant, 0
End With
End Function
The same module also contains a function used to define the BorderWidth value which determines the distance (in twips) from the form edges within which resizing is implemented using mouse events.
Public Function SetBorderWidth(frm As Form) As Integer
'Colin Riddington - 13/03/2024
'Border style: 0 =none, 1 = thin, 2 = sizable, 3 = dialog
'BorderWidth = 0 unless specified so code deliberately restricted to borderless forms
If frm.BorderStyle = 0 Then
BorderWidth = 100
Else
BorderWidth = 0
End If
End Function
The main form has 3 sections: header, detail and footer, each of which allows the form to be both moved and resized
The Form_Load event loads the SetBorderWidth function to allow resizing for borderless forms ONLY
Private Sub Form_Load()
'set 'BorderWidth' value to 100 for borderless forms, otherwise 0 (to disable resizing)
SetBorderWidth Me
End Sub
Each section of the form has mouse down and mouse move events to control both resizing the form and dragging it to a new position.
For example, the Form Header section code allows resizing to the left / right and upwards
Private Sub FormHeader_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case resizeDir
Case Is = RESIZEDIRECTION.TopLeft, RESIZEDIRECTION.TopRight, RESIZEDIRECTION.Left, RESIZEDIRECTION.Right, RESIZEDIRECTION.Top
'allow resize dragging up/left/right only
ResizeFormWindow Me, resizeDir
Case Else
DragFormWindow Me
End Select
End Sub
'=============================================================
Private Sub FormHeader_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Determine which direction to resize based on mouse position
'Modify mouse cursor accordingly
Dim height As Long
Dim width As Long
Dim cursorShape As Integer
height = Me.Section(1).height
width = Me.WindowWidth
If X < BorderWidth And Y < BorderWidth Then
resizeDir = RESIZEDIRECTION.TopLeft
cursorShape = IDC_SIZENWSE
ElseIf X > width - BorderWidth And Y < BorderWidth Then
resizeDir = RESIZEDIRECTION.TopRight
cursorShape = IDC_SIZENESW
ElseIf X < BorderWidth Then
resizeDir = RESIZEDIRECTION.Left
cursorShape = IDC_SIZEWE
ElseIf X > width - BorderWidth Then
resizeDir = RESIZEDIRECTION.Right
cursorShape = IDC_SIZEWE
ElseIf Y < BorderWidth Then
resizeDir = RESIZEDIRECTION.Top
cursorShape = IDC_SIZENS
Else
resizeDir = RESIZEDIRECTION.none
cursorShape = IDC_ARROW
End If
ChangeCursorTo (cursorShape)
End Sub
Very similar code is used for the Detail section. This allows resizing to the left and right only
Private Sub Detail_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case resizeDir
Case Is = RESIZEDIRECTION.Left, RESIZEDIRECTION.Right
'allow resize dragging left/right only
ResizeFormWindow Me, resizeDir
Case Else
DragFormWindow Me
End Select
End Sub
'=============================================================
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Determine which direction to resize based on mouse position
'Modify mouse cursor accordingly
Dim height As Long
Dim width As Long
Dim cursorShape As Integer
height = Me.Section(1).height
width = Me.WindowWidth
If X < BorderWidth Then
resizeDir = RESIZEDIRECTION.Left
cursorShape = IDC_SIZEWE
ElseIf X > width - BorderWidth Then
resizeDir = RESIZEDIRECTION.Right
cursorShape = IDC_SIZEWE
Else
resizeDir = RESIZEDIRECTION.none
cursorShape = IDC_ARROW
End If
ChangeCursorTo (cursorShape)
End Sub
The Form Footer section code is again very similar. This allows resizing to the left / right and downwards.
Private Sub FormFooter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case resizeDir
'allow resize dragging down/left/right only
Case Is = RESIZEDIRECTION.BottomLeft, RESIZEDIRECTION.BottomRight, RESIZEDIRECTION.Left, RESIZEDIRECTION.Right, RESIZEDIRECTION.Bottom
If Me.BorderStyle = 0 Then ResizeFormWindow Me, resizeDir
Case Else
DragFormWindow Me
End Select
End Sub
'=============================================================
Private Sub FormFooter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Determine which direction to resize based on mouse position
'Modify mouse cursor accordingly
Dim height As Long
Dim width As Long
Dim cursorShape As Integer
height = Me.Section(2).height
width = Me.WindowWidth
If X < BorderWidth And Y > height - BorderWidth Then
resizeDir = RESIZEDIRECTION.BottomLeft
cursorShape = IDC_SIZENESW
ElseIf X > width - BorderWidth And Y > height - BorderWidth Then
cursorShape = IDC_SIZENWSE
ElseIf X < BorderWidth Then
resizeDir = RESIZEDIRECTION.Left
cursorShape = IDC_SIZEWE
ElseIf X > width - BorderWidth Then
resizeDir = RESIZEDIRECTION.Right
cursorShape = IDC_SIZEWE
ElseIf Y > height - BorderWidth Then
resizeDir = RESIZEDIRECTION.Bottom
cursorShape = IDC_SIZENS
Else
resizeDir = RESIZEDIRECTION.none
cursorShape = IDC_ARROW
End If
ChangeCursorTo (cursorShape)
End Sub
The example app also includes a second form with no header and footer sections
The only difference in the code is that resizing can be done in any direction from the edges of the detail section
Private Sub Detail_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case resizeDir
Case Is = RESIZEDIRECTION.Left, RESIZEDIRECTION.Right, RESIZEDIRECTION.BottomLeft, RESIZEDIRECTION.BottomRight, _
RESIZEDIRECTION.Bottom, RESIZEDIRECTION.TopLeft, RESIZEDIRECTION.TopRight, RESIZEDIRECTION.Top
'allow resize dragging in all directions
ResizeFormWindow Me, resizeDir
Case Else
DragFormWindow Me
End Select
End Sub
'=============================================================
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Determine which direction to resize based on mouse position
'Modify mouse cursor accordingly
Dim height As Long
Dim width As Long
Dim cursorShape As Integer
height = Me.WindowHeight
width = Me.WindowWidth
If X < BorderWidth And Y < BorderWidth Then
resizeDir = RESIZEDIRECTION.TopLeft
cursorShape = IDC_SIZENWSE
ElseIf X > width - BorderWidth And Y < BorderWidth Then
resizeDir = RESIZEDIRECTION.TopRight
cursorShape = IDC_SIZENESW
ElseIf X < BorderWidth And Y >> height - BorderWidth Then
resizeDir = RESIZEDIRECTION.BottomLeft
cursorShape = IDC_SIZENESW
ElseIf X > width - BorderWidth And Y > height - BorderWidth Then
resizeDir = RESIZEDIRECTION.BottomRight
cursorShape = IDC_SIZENWSE
ElseIf X < BorderWidth Then
resizeDir = RESIZEDIRECTION.Left
cursorShape = IDC_SIZEWE
ElseIf X > width - BorderWidth Then
resizeDir = RESIZEDIRECTION.Right
cursorShape = IDC_SIZEWE
ElseIf Y > height - BorderWidth Then
resizeDir = RESIZEDIRECTION.Bottom
cursorShape = IDC_SIZENS
ElseIf Y < BorderWidth Then
resizeDir = RESIZEDIRECTION.Top
cursorShape = IDC_SIZENS
Else
resizeDir = RESIZEDIRECTION.none
cursorShape = IDC_ARROW
End If
ChangeCursorTo (cursorShape)
End Sub
Update to version 3.5 Return To Top
Following a suggestion by Jesús Mansilla, I have added a small button with an Access icon to the top left of the main form.
Hold the left mouse button over this button whilst moving the mouse. The application window and the form move together in the direction of the mouse movement.
This simple action requires 3 more APIs in modAppWindow
'used for moving application window
Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINTAPI
X As Long
Y As Long
End Type
The following code was added to the form:
Dim AppX As Long, AppY As Long, AppTop As Long, AppLeft As Long, WinRECT As RECT, Apointapi As POINTAPI
Private Sub cmdMoveWindow_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetWindowRect Application.hWndAccessApp, WinRECT
AppTop = WinRECT.Top
AppLeft = WinRECT.Left
GetCursorPos Apointapi
AppX = Apointapi.X
AppY = Apointapi.Y
End Sub
'================================================
Private Sub cmdMoveWindow_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Const HWND_TOP = 0 'Moves MS Access window to top of Z-order
Const SWP_NOZORDER = &H4 'wFlags: Ignores the hWndInsertAfter
Const SWP_NOMOVE = &H2 'wFlags: don't change the window position
Const SWP_NOSIZE = &H1 'wFlags: don't change the window size
If Button = 0 Then Exit Sub
GetCursorPos Apointapi
SetWindowPos Application.hWndAccessApp, HWND_TOP, AppLeft - (AppX - Apointapi.X), _
AppTop - (AppY - Apointapi.Y), 0, 0, SWP_NOZORDER + SWP_NOSIZE
End Sub
Video Return To Top
A longer video with a full audio commentary explaining all the features and code used in this app is now available on YouTube.
You can watch the Move / Resize Borderless Form video on my Isladogs YouTube channel or you can click below:
If you liked the video, please subscribe to my Isladogs on Access channel on YouTube. Thanks.
Feedback Return To Top
Please use the contact form below to let me know whether you found this article interesting/useful or if you have any questions/comments.
Please also consider making a donation towards the costs of maintaining this website. Thank you
Colin Riddington Mendip Data Systems Last Updated 30 Mar 2024
Return to Example Databases Page
Page 2 of 2
1
2
Return To Top
|
|
|