Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Centering a popup box over a form - problem:

Status
Not open for further replies.

Gazonice

Programmer
Jul 30, 2002
103
GB
Hello,

I have hacked some code off the net that I use to open a popup, modal, message box - centrally over a main form, regardless of where that main form is positioned on a screen or on multiple screens... this gets over the 'twips' limitation that exists in multi screen environments.

This works just fine when the popup is called from the main form (such as an 'about us' button), but if the focus happens to be on a control or in a subform on the main form when the 'about us' button is clicked, my popup centralises itself over the control instead of the centre of the main form.

I really would appreciate some help in getting the popup to always open centrally on the main form or calling form rather than a control.

The module:

Code:
'code start
Option Compare Database
Option Explicit

Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Type Dimensions
    Width As Long
    Height As Long
End Type

Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As Rect) As Long
Private Const HWND_TOP = 0
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOZORDER = &H4

Public Function FormPlacement(ByRef ctl As Control, ByRef frm As Form)
    Dim CtlRect As Rect
    Dim frmRect As Rect
    Dim frmDimensions As Dimensions
    Dim wFlag As Long
    CtlRect = ControlRect(ctl)
    frmDimensions = FormDimensions(frm)
            frmRect.Left = CtlRect.Left + (((CtlRect.Right - CtlRect.Left) / 2) - ((frmDimensions.Width) / 2))
            frmRect.Top = CtlRect.Top + (((CtlRect.Bottom - CtlRect.Top) / 2) - ((frmDimensions.Height) / 2))
    SetWindowPos frm.hWnd, HWND_TOP, frmRect.Left, frmRect.Top, frmDimensions.Width, frmDimensions.Height, wFlag
    frm.Visible = True
End Function

Private Function ControlRect(ByRef ctl As Control) As Rect
    ctl.SetFocus
    GetWindowRect GetFocus(), ControlRect
End Function
    
Private Function FormDimensions(ByRef frm As Form) As Dimensions
    Dim frmRect As Rect
    GetWindowRect frm.hWnd, frmRect
    With FormDimensions
        .Width = frmRect.Right - frmRect.Left
        .Height = frmRect.Bottom - frmRect.Top
    End With
End Function
'code end

The code used to call the popup is:

Code:
Private Sub ButtonAbout_Click()
    DoCmd.OpenForm "AboutPoupForm"
End Sub

If I add Me.Refresh to ButtonAbout_Click() the popup opens correctly centred but I would prefer not to do this if it could be avoided.

Kind Regards,

Garry.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top