I got tired of fighting and fighting Access for centering a form with different screen resolutions using MoveSize. So, I looked up some windows APIs and created a function to center any form for any screen resolution (almost). The only thing is that it doesn't resize the form so if your form is half of the screen at 1280x960, then it will go off the screen at a resolution of 800x600. I might update this later with a resize option, but...maybe not
This code should be good for any version of access except a 64 bit OS. For that, you will have to find where the APIs are kept (instead of "user32") and also if the API name has changed.
put APIs, constants and user defined type in a module:
CODE
Public Declare Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nwidth As Long, ByVal nheight As Long, ByVal brepaint As Long) As Boolean
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Const SM_CXSCREEN As Long = 0
Public Const SM_CYSCREEN As Long = 1
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nwidth As Long, ByVal nheight As Long, ByVal brepaint As Long) As Boolean
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Const SM_CXSCREEN As Long = 0
Public Const SM_CYSCREEN As Long = 1
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
put the sub either in a new module or in the same module as the APIs:
CODE
Public Sub CenterFrm(frm As Form)
Dim MeRect As RECT, frmRect As RECT
Dim xRes As Integer, yRes As Integer
Dim xTwipAdj As Integer, yTwipAdj As Integer
Dim RC As Long, hwindow As Long, xPass As Long, yPass As Long, frmxPass As Long, frmyPass As Long
Dim thisone As Boolean
Dim ctl As Control
'get the desktop's handle
hwindow = GetDesktopWindow()
'get the screen rectangle (only needed if calculating twips) and the form rectangle
'RC = GetWindowRect(hwindow, MeRect)
RC = GetWindowRect(frm.hwnd, frmRect)
'find adjustment for converting pixels to twips on screen resolution
'use this if you want to play with resizing the form and moving controls.
'each screen resolution has it's own twip adjustment.
'xTwipAdj = 12000 / (MeRect.Right - MeRect.Left)
'yTwipAdj = 9000 / (MeRect.Bottom - MeRect.Top)
'get pixel dimensions of screen for resolution
xRes = GetSystemMetrics(SM_CXSCREEN)
yRes = GetSystemMetrics(SM_CYSCREEN)
'calculate the form's size for passing to api function
frmxPass = (frmRect.Right - frmRect.Left)
frmyPass = (frmRect.Bottom - frmRect.Top)
'calculate x and y center point for the form to be placed
xPass = (xRes - frmxPass) / 2
yPass = (yRes - frmyPass) / 2
'force move of form and repaint through windows api
thisone = MoveWindow(frm.hwnd, xPass, yPass, frmxPass, frmyPass, True)
End Sub
Dim MeRect As RECT, frmRect As RECT
Dim xRes As Integer, yRes As Integer
Dim xTwipAdj As Integer, yTwipAdj As Integer
Dim RC As Long, hwindow As Long, xPass As Long, yPass As Long, frmxPass As Long, frmyPass As Long
Dim thisone As Boolean
Dim ctl As Control
'get the desktop's handle
hwindow = GetDesktopWindow()
'get the screen rectangle (only needed if calculating twips) and the form rectangle
'RC = GetWindowRect(hwindow, MeRect)
RC = GetWindowRect(frm.hwnd, frmRect)
'find adjustment for converting pixels to twips on screen resolution
'use this if you want to play with resizing the form and moving controls.
'each screen resolution has it's own twip adjustment.
'xTwipAdj = 12000 / (MeRect.Right - MeRect.Left)
'yTwipAdj = 9000 / (MeRect.Bottom - MeRect.Top)
'get pixel dimensions of screen for resolution
xRes = GetSystemMetrics(SM_CXSCREEN)
yRes = GetSystemMetrics(SM_CYSCREEN)
'calculate the form's size for passing to api function
frmxPass = (frmRect.Right - frmRect.Left)
frmyPass = (frmRect.Bottom - frmRect.Top)
'calculate x and y center point for the form to be placed
xPass = (xRes - frmxPass) / 2
yPass = (yRes - frmyPass) / 2
'force move of form and repaint through windows api
thisone = MoveWindow(frm.hwnd, xPass, yPass, frmxPass, frmyPass, True)
End Sub
put this in the On Load or On Open of the form:
CODE
Call CenterFrm(Me)
As always have fun chopping up and changing anything you want
