Opening a Form at a Specific Postion

  • Thread starter IanOxon via AccessMonster.com
  • Start date
I

IanOxon via AccessMonster.com

Hi All,

I'm opening a pop-up form from a control (ctlLaunch) on another form
(frmParent). The idea is to open the popup immediately below ctlLaunch and
with the same left position. I can position the popup relative to the control
but there's some overlap. Here's the code I'm using:

'Pop-up Form OnOpen Event:
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open

MoveForm Screen.ActiveForm, Screen.ActiveControl

Exit_Form_Open:
Exit Sub

Err_Form_Open:
MsgBox Name & "_Open Error: " & Err.Number & ": " & Err.Description
Resume Exit_Form_Open
End Sub

'general module basPositionForm
Option Compare Database
'API Functions
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal
nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal
hdc As Long) As Long

'RECT type declaration.
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public Sub MoveForm(ByVal frmParent As Form, ByVal ctlLaunch As Control)
On Error GoTo Err_MoveForm
Dim rctParent As RECT
Dim lngLeft As Long
Dim lngTop As Long
Dim lngWidth As Long
Dim lngHeight As Long

'Get parent form RECT.
GetWindowRect frmParent.hwnd, rctParent
With rctParent
lngLeft = .Left
lngTop = .Top
lngWidth = .Right - .Left
lngHeight = .Bottom - .Top
End With
'Convert RECT dimensions to twips
CPixTwip lngLeft, lngTop, lngWidth, lngHeight
'Get CurrentSection position relative to parent form window.
With frmParent
lngLeft = lngLeft + .CurrentSectionLeft
lngTop = lngTop + .CurrentSectionTop
End With
'Get CurrentSection position relative to parent form window.
With ctlLaunch
lngLeft = lngLeft + .Left
lngTop = lngTop + .Top + .Height
End With
'Move last form object opened to new position.
DoCmd.MoveSize lngLeft, lngTop

Exit_MoveForm:
Exit Sub

Err_MoveForm:
MsgBox "MoveForm Error: " & Err.Number & ": " & Err.Description
Resume Exit_MoveForm
End Sub

Public Sub CPixTwip(lngLeft As Long, lngTop As Long, lngWidth As Long,
lngHeight As Long)
On Error GoTo Err_CPixTwip
Dim lngHDC As Long
Dim lngReturn As Long
Dim lngXPixPerIn As Long
Dim lngYPixPerIn As Long
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Const TWIPSPERINCH = 1440

'Get pixels per inch.
lngHDC = GetDC(0) 'desktop display device context.
lngXPixPerIn = GetDeviceCaps(lngHDC, LOGPIXELSX)
lngYPixPerIn = GetDeviceCaps(lngHDC, LOGPIXELSY)
lngReturn = ReleaseDC(0, lngHDC)
'Return dimensions in twips.
If lngLeft > 0 Then
lngLeft = (lngLeft / lngXPixPerIn) * TWIPSPERINCH
End If
If lngTop > 0 Then
lngTop = (lngTop / lngXPixPerIn) * TWIPSPERINCH
End If
lngWidth = (lngWidth / lngXPixPerIn) * TWIPSPERINCH
lngHeight = (lngHeight / lngYPixPerIn) * TWIPSPERINCH

Exit_CPixTwip:
Exit Sub

Err_CPixTwip:
MsgBox Err.Number & " " & Err.Description
Resume Exit_CPixTwip
End Sub

What am I missing? Is there a better way?
Edit/Delete Message
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top