I am using the below code to centre a popup form, both horizontally and vertically.
All my non-popup forms are 25cm wide.
It looks weird that the popup forms appear on the centre of the screen, when the centre of the form is more towards the left. This is especially true in widescreens.
How can I alter this code, so that the popup form appears on the centre (horizontally only) of the first 25cm of the screen.
25 cm = 9.8425 in = 14173 twips = 945 pixels
Edit:
I've attached a picture to explain better
Thanks.
All my non-popup forms are 25cm wide.
It looks weird that the popup forms appear on the centre of the screen, when the centre of the form is more towards the left. This is especially true in widescreens.
How can I alter this code, so that the popup form appears on the centre (horizontally only) of the first 25cm of the screen.
25 cm = 9.8425 in = 14173 twips = 945 pixels
Edit:
I've attached a picture to explain better
Code:
' API declarations:
#If Win64 Then
Private Declare PtrSafe Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hwnd As Long, lpRect As typRect) As Long
Private Declare PtrSafe Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Long, lpRect As typRect) As Long
Private Declare PtrSafe Function apiSetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#Else
Private Declare Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hwnd As Long, lpRect As typRect) As Long
Private Declare Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Long, lpRect As typRect) As Long
Private Declare Function apiSetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#End If
' Type declarations:
Private Type typRect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' Constant declarations:
Private Const SW_RESTORE = 9
Private Const SWP_NOSIZE = &H1 ' Don't alter the size
Private Const SWP_NOZORDER = &H4 ' Don't change the Z-order
Private Const SWP_SHOWWINDOW = &H40 ' Display the window
' **************************************
' * Center a form in the Access window *
' **************************************
' Created 1-22-2002 by Peter M. Schroeder
Public Function gfncCenterForm(parForm As Form) As Boolean
Dim varAccess As typRect, varForm As typRect
Dim varX As Long, varY As Long
On Error GoTo CenterForm_Error
Call apiGetClientRect(hWndAccessApp, varAccess) ' Get the Access client area coordinate
Call apiGetWindowRect(parForm.hwnd, varForm) ' Get the form window coordinates
varX = CLng((varAccess.Left + varAccess.Right) / 2) - CLng((varForm.Right - varForm.Left) / 2) ' Calculate a new left for the form
varY = CLng((varAccess.Top + varAccess.Bottom) / 2) - CLng((varForm.Bottom - varForm.Top) / 2) ' Calculate a new top for the form
varY = varY - 45 ' Adjust top for true center
varY = varY - 20 ' Adjust top for appearance
Call apiShowWindow(parForm.hwnd, SW_RESTORE) ' Restore form window
Call apiSetWindowPos(parForm.hwnd, 0, varX, varY, (varForm.Right - varForm.Left), (varForm.Bottom - varForm.Top), SWP_NOZORDER Or SWP_SHOWWINDOW Or SWP_NOSIZE) ' Set new form coordinates
gfncCenterForm = True
Exit Function
CenterForm_Error:
gfncCenterForm = False
End Function
Thanks.
Attachments
Last edited: