Mendip Data Systems

Database applications for businesses and schools

LogoTransparent

 

Option Compare Database

Option Explicit

 

#If VBA7 Then

   Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

   

   Public Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long

   

   Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr

   

   Public Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWndPtr As LongPtr, ByVal hDC As LongPtr) As Long

   

   Public Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long

#Else

   Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

   

   Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

   

   Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

   

   Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long

   

   Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long

#End If

 

Public Type RECT

       Left As Long

       Top As Long

       Right As Long

       Bottom As Long

End Type

 

Public Const WU_LOGPIXELSX = 88

Public Const WU_LOGPIXELSY = 90

 

Public Function TwipsPerPixel(strDirection As String) As Long

'Purpose  : Get monitor's Twips per pixel

   'Handle to device

   

   #If VBA7 Then

       Dim lngDC                       As LongPtr

   #Else

       Dim lngDC                       As Long

   #End If

   Dim lngPixelsPerInch            As Long

   Const nTwipsPerInch = 1440

   lngDC = GetDC(0)

 

   If strDirection = "X" Then                                  'Horizontal

       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)

   Else                                                        'Vertical

       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)

   End If

   lngDC = ReleaseDC(0, lngDC)

   TwipsPerPixel = nTwipsPerInch / lngPixelsPerInch

 

End Function

 

Public Sub WindowSize(ByRef Height As Long, ByRef Width As Long)

'Purpose  : Get Access window size.

   #If VBA7 Then

       Dim hWnd                        As LongPtr

   #Else

       Dim hWnd                        As Long

   #End If

   Dim rct                         As RECT

 

    'use project name in line below

   hWnd = FindWindow(vbNullString, "CentreFormExamples")

   If hWnd <> 0 And GetWindowRect(hWnd, rct) <> 0 Then

       Height = (rct.Bottom - rct.Top) * TwipsPerPixel("Y")

       Width = (rct.Right - rct.Left) * TwipsPerPixel("X")

   End If

End Sub

 

Public Function CenterMe(frm As Form)

'Purpose  : Center form on screen.

'Requires :

'   Code

'       TwipsPerPixel()

'       WindowSize()

'       Type RECT

'   API Libraries

'       FindWindow

'       GetWindowRect

'       GetDC

'       ReleaseDC

'       GetDeviceCaps

   Dim lngWinWidth As Long

   Dim lngWinHeight As Long

   Dim lngFrmWidth As Long

   Dim lngFrmHeight As Long

 

   Call WindowSize(lngWinHeight, lngWinWidth)

   frm.SetFocus

 

   DoCmd.MoveSize (lngWinWidth - frm.WindowWidth) \ 2, _

                (lngWinHeight - frm.WindowHeight) \ 2

 

End Function

Code Samples for Businesses, Schools & Personal Use

Updated 03/12/2020              

 

Access provides a built in 'Center Form' as part of the form property sheet. However this only centres the form in a horizontal direction. The outcomes at times can also be visibly well off-centre.

 

Over the years, I have acquired various code samples that can be used to centre forms in both horizontal and vertical directions.

 

However, I have found that these do not all give identical results. The outcomes depend on whether:

a) Access is maximised or not (occupies part of the screen only)

b) the navigation pane is maximised/minimised or hidden

b) the forms are popup or not

 

This article includes two example applications which can be used to compare the results and, from that, determine the code that appears to work best

 

Each application contains 4 identical forms (apart from colour). One uses 4 standard forms, the other has 4 popups

Each form is coded so it should open at the centre of the screen (but see below)

 

Each form is borderless but can be dragged to a new position by holding down the left mouse button on any blank space in the form header. You can then click the Re-centre Form button to run the code used again

 

NOTE: Click any screenshot to view a larger image

Centre Form On Screen

Return to Code Samples Page

Standard forms

Popup forms

CentreForm1Popup CentreForm1 CentreForm2PopupMAX CentreForm3Restore

These are the results obtained with Access maximised after clicking the Re-centre form buttpn on each form

In both examples, forms 3 & 4 give identical centre positions.

 

For standard forms, form 1 & 2 give very different results. Forms 3 & 4 both placed close to Form 1

For popup forms, results are more consistent. Forms 1 & 2 are identically positioned with forms 3 & 4 only slightly displaced

Standard forms

Popup forms

However, when Access occupies only part of the screen space, results are different again

Once again, in both examples, forms 3 & 4 give identical centre positions.

 

For standard forms, form 1 & 2 give very different results with form 2 appearing most central. Forms 3 & 4 are both shifted well to the bottom right, ignoring the actual size of the Access screen

For popup forms,  Forms 1 & 2 are both shifted well to the top left. Forms 3 & 4 appear to be centred correctly!

CentreForm3Restore

Standard forms

Popup forms

Conclusions:

Unfortunately none of the forms give the correct position in all situations

 

Based on my tests:

For standard forms, form 2 appears to give good results whether or not the form is maximised.

For popup forms, any form is acceptable when the screen is maximised. Forms 3 and 4 are central when only part of the screen is used.

 

 

Click to Download:

     Centre Form Examples - v1 - Not Popup                         Centre Form Examples - v2 - Popup    (Each approx 0.8 MB zipped)

 

     

 

 

Below I have provided the code used for each form to make it easier to use whichever code you prefer.

CentreForm2MAX

Module code (based on new instance of class module clFormWindow)

Option Compare Database

Option Explicit

 

'*************************************************************

' Class module: clFormWindow                                 *

'*************************************************************

' Moves and resizes a window in the coordinate system        *

' of its parent window.                                      *

' N.B.: This class was developed for use on Access forms     *

'       and has not been tested for use with other window    *

'       types.                                               *

'*************************************************************

 

'*************************************************************

' Type declarations

'*************************************************************

 

Private Type RECT       'RECT structure used for API calls.

   Left As Long

   Top As Long

   Right As Long

   Bottom As Long

End Type

 

Private Type POINTAPI   'POINTAPI structure used for API calls.

   X As Long

   Y As Long

End Type

 

'*************************************************************

' Member variables

'*************************************************************

Private m_hWnd As Long          'Handle of the window.

Private m_rctWindow As RECT     'Rectangle describing the sides of the last polled location of the window.

 

'*************************************************************

' Private error constants for use with RaiseError procedure

'*************************************************************

Private Const m_ERR_INVALIDHWND = 1

Private Const m_ERR_NOPARENTWINDOW = 2

 

'*************************************************************

' API function declarations

'*************************************************************

#If VBA7 Then

   Private Declare PtrSafe Function apiIsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As LongPtr) As Long

   

   Private Declare PtrSafe Function apiMoveWindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As LongPtr, ByVal X As Long, ByVal Y As Long, _

       ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

       'Moves and resizes a window in the coordinate system of its parent window.

   

   Private Declare PtrSafe Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWndPtr As Long, lpRect As RECT) As Long

       'After calling, the lpRect parameter contains the RECT structure describing the sides of the window in screen coordinates.

   

   Private Declare PtrSafe Function apiScreenToClient Lib "user32" Alias "ScreenToClient" (ByVal hWnd As LongPtr, lpPoint As POINTAPI) As Long

       'Converts lpPoint from screen coordinates to the coordinate system of the specified client window.

   

   Private Declare PtrSafe Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hWnd As LongPtr) As Long

       'Returns the handle of the parent window of the specified window.

 

#Else

   Private Declare Function apiIsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As Long) As Long

   

   Private Declare Function apiMoveWindow Lib "user32" Alias "MoveWindow" (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 Long

       'Moves and resizes a window in the coordinate system of its parent window.

   

   Private Declare Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As RECT) As Long

       'After calling, the lpRect parameter contains the RECT structure describing the sides of the window in screen coordinates.

   

   Private Declare Function apiScreenToClient Lib "user32" Alias "ScreenToClient" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

       'Converts lpPoint from screen coordinates to the coordinate system of the specified client window.

   

   Private Declare Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hWnd As Long) As Long

       'Returns the handle of the parent window of the specified window.

#End If

 

 

'*************************************************************

' Private procedures

'*************************************************************

Private Sub RaiseError(ByVal lngErrNumber As Long, ByVal strErrDesc As String)

'Raises a user-defined error to the calling procedure.

 

   Err.Raise vbObjectError + lngErrNumber, "clFormWindow", strErrDesc

   

End Sub

 

Private Sub UpdateWindowRect()

'Places the current window rectangle position (in pixels, in coordinate system of parent window) in m_rctWindow.

 

   Dim ptCorner As POINTAPI

   

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       apiGetWindowRect m_hWnd, m_rctWindow   'm_rctWindow now holds window coordinates in screen coordinates.

       

       If Not Me.Parent Is Nothing Then

           'If there is a parent window, convert top, left of window from screen coordinates to parent window coordinates.

           With ptCorner

               .X = m_rctWindow.Left

               .Y = m_rctWindow.Top

           End With

       

           apiScreenToClient Me.Parent.hWnd, ptCorner

       

           With m_rctWindow

               .Left = ptCorner.X

               .Top = ptCorner.Y

           End With

   

           'If there is a parent window, convert bottom, right of window from screen coordinates to parent window coordinates.

           With ptCorner

               .X = m_rctWindow.Right

               .Y = m_rctWindow.Bottom

           End With

       

           apiScreenToClient Me.Parent.hWnd, ptCorner

       

           With m_rctWindow

               .Right = ptCorner.X

               .Bottom = ptCorner.Y

           End With

       End If

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

   

End Sub

 

'*************************************************************

' Public read-write properties

'*************************************************************

Public Property Get hWnd() As Long

'Returns the value the user has specified for the window's handle.

 

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       hWnd = m_hWnd

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

   

End Property

 

Public Property Let hWnd(ByVal lngNewValue As Long)

'Sets the window to use by specifying its handle.

'Only accepts valid window handles.

 

   If lngNewValue = 0 Or apiIsWindow(lngNewValue) Then

       m_hWnd = lngNewValue

   Else

       RaiseError m_ERR_INVALIDHWND, "The value passed to the hWnd property is not a valid window handle."

   End If

   

End Property

'----------------------------------------------------

 

Public Property Get Left() As Long

'Returns the current position (in pixels) of the left edge of the window in the coordinate system of its parent window.

 

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       UpdateWindowRect

       Left = m_rctWindow.Left

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

   

End Property

'----------------------------------------------------

 

Public Property Let Left(ByVal lngNewValue As Long)

'Moves the window such that its left edge falls at the position indicated

'(measured in pixels, in the coordinate system of its parent window).

 

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       UpdateWindowRect

       With m_rctWindow

           apiMoveWindow m_hWnd, lngNewValue, .Top, .Right - .Left, .Bottom - .Top, True

       End With

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

   

End Property

'----------------------------------------------------

 

Public Property Get Top() As Long

'Returns the current position (in pixels) of the top edge of the window in the coordinate system of its parent window.

 

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       UpdateWindowRect

       Top = m_rctWindow.Top

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

 

End Property

'----------------------------------------------------

 

Public Property Let Top(ByVal lngNewValue As Long)

'Moves the window such that its top edge falls at the position indicated

'(measured in pixels, in the coordinate system of its parent window).

 

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       UpdateWindowRect

       With m_rctWindow

           apiMoveWindow m_hWnd, .Left, lngNewValue, .Right - .Left, .Bottom - .Top, True

       End With

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

 

End Property

 

'----------------------------------------------------

 

Public Property Get Width() As Long

'Returns the current width (in pixels) of the window.

   

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       UpdateWindowRect

       With m_rctWindow

           Width = .Right - .Left

       End With

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

 

End Property

'----------------------------------------------------

 

Public Property Let Width(ByVal lngNewValue As Long)

'Changes the width of the window to the value provided (in pixels).

 

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       UpdateWindowRect

       With m_rctWindow

           apiMoveWindow m_hWnd, .Left, .Top, lngNewValue, .Bottom - .Top, True

       End With

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

 

End Property

'----------------------------------------------------

 

Public Property Get Height() As Long

'Returns the current height (in pixels) of the window.

   

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       UpdateWindowRect

       With m_rctWindow

           Height = .Bottom - .Top

       End With

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

 

End Property

'----------------------------------------------------

 

Public Property Let Height(ByVal lngNewValue As Long)

'Changes the height of the window to the value provided (in pixels).

 

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then

       UpdateWindowRect

       With m_rctWindow

           apiMoveWindow m_hWnd, .Left, .Top, .Right - .Left, lngNewValue, True

       End With

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

 

End Property

 

'*************************************************************

' Public read-only properties

'*************************************************************

Public Property Get Parent() As clFormWindow

'Returns the parent window as a clFormWindow object.

'For forms, this should be the Access MDI window.

 

   Dim fwParent As New clFormWindow

   Dim lngHWnd As Long

   

   If m_hWnd = 0 Then

       Set Parent = Nothing

   ElseIf apiIsWindow(m_hWnd) Then

       lngHWnd = apiGetParent(m_hWnd)

       fwParent.hWnd = lngHWnd

       Set Parent = fwParent

   Else

       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."

   End If

 

   Set fwParent = Nothing

   

End Property

 

Option Compare Database

Option Explicit

 

'===============================================

'Colin Riddington 18/02/2019

'Functions to get form dimensions and to reset to default size

'===============================================

 

Public intWindowLeft As Integer

Public intWindowTop As Integer

 

Public intInsideHeight As Integer

Public intInsideWidth As Integer

 

Public intWindowHeight As Integer

Public intWindowWidth As Integer

Public intTotalFormHeight As Integer

Public intTotalFormWidth As Integer

Public intHeightHeader As Integer

Public intHeightDetail As Integer

Public intHeightFooter As Integer

' Public intFormControlBarHeight As Integer

' Public intFormControlBarWidth As Integer

Public intTitleBarHeight As Integer

Public intNavBarHeight As Integer

Public intRecSelWidth As Integer

Public intScrollBarWidth As Integer

Public intScrollBarHeight As Integer

Public frm As Access.Form

Public intBorderWidth As Integer

Public intBorderHeight As Integer

 

Public intBorderStyle As Integer

Public intScrollbars As Integer

 

Sub CentreForm(frm As Form)

 

On Error GoTo Err_Handler

 

   ' Determine form's height.

   intHeightHeader = frm.Section(acHeader).Height

   intHeightDetail = frm.Section(acDetail).Height

   intHeightFooter = frm.Section(acFooter).Height

   intTotalFormHeight = intHeightHeader + intHeightDetail + intHeightFooter

   

   ' Determine form's width.

   intTotalFormWidth = frm.Width

   

   'Centre the form on screen

   DoCmd.MoveSize (MetricsScreenWidth - intTotalFormWidth) / 2, (MetricsScreenHeight - intTotalFormHeight) / 2 ', intTotalFormWidth, intTotalFormHeight

   

Exit_Handler:

  Exit Sub

 

Err_Handler:

  MsgBox "Error " & Err.Number & " in ResetWindowSize procedure : " & Err.description

  Resume Exit_Handler

 

End Sub

Function GetFormDimensions(frm As Form)

 

On Error GoTo Err_Handler

 

   'form position

   intWindowLeft = frm.WindowLeft

   intWindowTop = frm.WindowTop

 

   'form external size

   intTotalFormHeight = frm.WindowHeight

   intTotalFormWidth = frm.WindowWidth

 

   'form internal size

   intInsideHeight = frm.InsideHeight

   intInsideWidth = frm.InsideWidth

 

  'section heights

   intHeightHeader = frm.Section(acHeader).Height

   intHeightDetail = frm.Section(acDetail).Height

   intHeightFooter = frm.Section(acFooter).Height

   

   '------------------------------------------------

   'get border & title bar height

   Select Case frm.BorderStyle

   

   Case 0 'none

        intTitleBarHeight = 0

        intBorderHeight = 45

   Case 1 'thin

        intBorderHeight = 45

        intTitleBarHeight = 390 '345 title bar + 45 top border

   Case 2 'sizable

       intBorderHeight = 150

       intTitleBarHeight = 495 '345 title bar + 150 top border

   Case 3 ' dialog

       intBorderHeight = 45

       intTitleBarHeight = 390 '345 title bar + 45 top border

   End Select

   

   intBorderWidth = intBorderHeight

    '------------------------------------------------

   

   'get scrollbar sizes

   Select Case frm.ScrollBars

   

   Case 0 'none

        intScrollBarHeight = 0

        intScrollBarWidth = 0

   Case 1 ''horiz only

        intScrollBarWidth = 0

        intScrollBarHeight = 255

   Case 2 'vert only

        intScrollBarWidth = 255

        intScrollBarHeight = 0

   Case 3 ' dialog

        intScrollBarWidth = 255

        intScrollBarHeight = 255

   End Select

   

   'If nav buttons visible, horiz scrollbar shares space with nav button bar

   If frm.NavigationButtons = True Then

       intNavBarHeight = 285

       intScrollBarHeight = 0

   Else

       intNavBarHeight = 0

   End If

   

   '------------------------------------------------

   If frm.RecordSelectors = True Then

       intRecSelWidth = 255

  Else

       intRecSelWidth = 0

  End If

 

Exit_Handler:

  Exit Function

 

Err_Handler:

  ' If Err = 5 Then Resume Next

  MsgBox "Error " & Err.Number & " in GetFormDimensions procedure : " & Err.description

  Resume Exit_Handler

   

End Function

Sub ResetWindowSize(frm As Form)

 

On Error GoTo Err_Handler

 

   ' Determine form's height.

   intHeightHeader = frm.Section(acHeader).Height

   intHeightDetail = frm.Section(acDetail).Height

   intHeightFooter = frm.Section(acFooter).Height

   intTotalFormHeight = intHeightHeader + intHeightDetail + intHeightFooter

   

   ' Determine form's width.

   intTotalFormWidth = frm.Width

   

   ' Determine window's height and width.

   intWindowHeight = frm.InsideHeight

   intWindowWidth = frm.InsideWidth

 

   'reset to fit intended size

   If intWindowWidth <> intTotalFormWidth Then

      frm.InsideWidth = intTotalFormWidth

   End If

   

   If intWindowHeight <> intTotalFormHeight Then

      frm.InsideHeight = intTotalFormHeight

   End If

   

Exit_Handler:

  Exit Sub

 

Err_Handler:

  MsgBox "Error " & Err.Number & " in ResetWindowSize procedure : " & Err.description

  Resume Exit_Handler

 

End Sub

Code for Form 4:

' (c) Renaud Bompuis, 2008

' Licensed under the Creative Commons Attribution License

' http://creativecommons.org/licenses/by/3.0/

' http://creativecommons.org/licenses/by/3.0/legalcode

'

' Free for re-use in any application or tutorial providing clear credit

' is made about the origin of the code and a link to the site above

' is prominently displayed where end-user can access it.

'

' updated for 64bit

'-----------------------------------------------------------------------------

Option Compare Database

Option Explicit

 

Private Type RECT

   X1 As Long

   Y1 As Long

   X2 As Long

   Y2 As Long

End Type

#If VBA7 Then

   Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr

   Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long

   Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr

   Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long

   Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long

#Else

   Private Declare Function GetDesktopWindow Lib "user32" () As Long

   Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, Rectangle As RECT) As Boolean

   Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

   Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long

   Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long

#End If

Private Const WU_LOGPIXELSX = 88

Private Const WU_LOGPIXELSY = 90

 

Sub CenterForm(f As Form)

   Dim formWidth As Long, formHeight As Long

   Dim maxWidth As Long, maxHeight As Long

   Dim ScreenWidth As Long, ScreenHeight As Long

   Dim formAllMarginsHeight As Long, formAllMarginsWidth As Long

 

   ' Compute maximal acceptable dialog box size in twips

   GetScreenResolution ScreenWidth, ScreenHeight

   ScreenWidth = ConvertPixelsToTwips(ScreenWidth, 0)

   ScreenHeight = ConvertPixelsToTwips(ScreenHeight, 0)

   maxWidth = ScreenWidth * 0.6

   maxHeight = ScreenHeight * 0.9

 

   ' Calculate the height and width of the area around the textbox

   formAllMarginsHeight = f.WindowHeight - f.Section(acDetail).Height

   formAllMarginsWidth = f.Width

 

   ' Assess proper width and height of the overall dialog box

   formWidth = formAllMarginsWidth

   formHeight = formAllMarginsHeight

 

   ' Adjust position of the th box to the middle if there is not much text.

   If formHeight < f.WindowHeight Then

       formHeight = f.WindowHeight

   End If

 

   ' Redimension the dialog and display the message at the center of the screen

   DoCmd.MoveSize (ScreenWidth - formWidth) / 2, (ScreenHeight - formHeight) / 2, formWidth, formHeight

 

End Sub

 

 

'-----------------------------------------------------------------------------

' Pixel to Twips conversions

'-----------------------------------------------------------------------------

' cf http://support.microsoft.com/default.aspx?scid=kb;en-us;210590

' To call this function, pass the number of twips you want to convert,

' and another parameter indicating the horizontal or vertical measurement

' (0 for horizontal, non-zero for vertical). The following is a sample call:

'

 

Function ConvertTwipsToPixels(lngTwips As Long, lngDirection As Long) As Long

'Handle to device

   Dim lngPixelsPerInch As Long

   Const nTwipsPerInch = 1440

 

#If Win64 Then

   Dim lngDC As LongPtr

#Else

   Dim lngDC As Long

#End If

   

   lngDC = GetDC(0)

   If (lngDirection = 0) Then       'Horizontal

       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)

   Else                            'Vertical

       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)

   End If

   lngDC = ReleaseDC(0, lngDC)

   ConvertTwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch

End Function

 

Function ConvertPixelsToTwips(lngPixels As Long, lngDirection As Long) As Long

'Handle to device

   Dim lngPixelsPerInch As Long

   Const nTwipsPerInch = 1440

   

#If Win64 Then

   Dim lngDC As LongPtr

#Else

   Dim lngDC As Long

#End If

   

   lngDC = GetDC(0)

 

   If (lngDirection = 0) Then       'Horizontal

       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)

   Else                            'Vertical

       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)

   End If

   lngDC = ReleaseDC(0, lngDC)

   ConvertPixelsToTwips = (lngPixels * nTwipsPerInch) / lngPixelsPerInch

End Function

 

Private Sub GetScreenResolution(ByRef Width As Long, ByRef Height As Long)

   Dim r As RECT

   Dim RetVal As Long

 

#If Win64 Then

   Dim hWnd As LongPtr

#Else

   Dim hWnd As Long

#End If

   hWnd = GetDesktopWindow()

   RetVal = GetWindowRect(hWnd, r)

   Width = r.X2 - r.X1

   Height = r.Y2 - r.Y1

End Sub

Private Sub cmdCentre_Click()

   CenterMe Me

End Sub

 

 

Private Sub Form_Load()

   CenterMe Me

End Sub

Code for Form 1:

Module code - CenterMe (in modCentreForm):

Code for Form 2:

Private Sub cmdCentre_Click()

   Form_Load

End Sub

 

Private Sub Form_Load()

   Dim fw As New clFormWindow

 

   fw.hWnd = Me.hWnd

   With fw

       .Top = (.Parent.Height - .Height) / 2

       .Left = (.Parent.Width - .Width) / 2

   End With

   Set fw = Nothing

End Sub

Private Sub cmdCentre_Click()

   CentreForm Me

End Sub

 

Private Sub Form_Load()

   CentreForm Me

End Sub

Private Sub cmdCentre_Click()

   CenterForm Me

End Sub

 

Private Sub Form_Load()

   CenterForm Me

End Sub

Module code (CentreForm procedure in module modFormInfo)

Code for Form 3:

Code for Form 4 (based on CenterForm procedure in module modFormCentre)