Article ID: 143162
Article Last Modified on 1/19/2007
150895 ACC95: Microsoft Access Sample Forms Available in Download Center
175066 ACC97: Microsoft Access 97 Sample Forms Available in Download Center
Option Explicit
Type RECT_Type
left As Long
top As Long
right As Long
bottom As Long
End Type
Declare Function apiGetWindowRect Lib "user32" Alias _
"GetWindowRect" (ByVal hWnd As Long, lpRect As RECT_Type) As Long
Declare Function apiGetDC Lib "user32" Alias "GetDC" _
(ByVal hWnd As Long) As Long
Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal _
hWnd As Long, ByVal hDC As Long) As Long
Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
Declare Function apiGetActiveWindow Lib "user32" Alias _
"GetActiveWindow" () As Long
Declare Function apiGetParent Lib "user32" Alias "GetParent" (ByVal _
hWnd As Long) As Long
Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal _
nMaxCount As Long) As Long
Global Const TWIPSPERINCH = 1440
Sub GetFormDimensions(F As Form, FLeft As Long, FTop As Long, _
FWidth As Long, FHeight As Long)
'*************************************************************
' PURPOSE: Returns the left, top, width, and height
' measurements of a form window in tdwips.
' ARGUMENTS:
' F: The form object whose measurements are to be determined.
' FLeft, FTop, FWidth, FHeight: Measurement variables
' that will return the dimensions of form F "by reference."
' NOTE: The FWidth and FHeight values will be equivalent to
' those provided by the form WindowWidth and WindowHeight
' properties.
'*************************************************************
Dim FormRect As RECT_Type
Dim MDIClient As RECT_Type
Dim MDIClientLeft As Long
Dim MDIClientTop As Long
' Get the screen coordinates and window size of the form.
' The screen coordinates are returned in pixels measured
' from the upper-left corner of the screen.
apiGetWindowRect F.hWnd, FormRect
FLeft = FormRect.left
FTop = FormRect.top
FWidth = FormRect.right - FormRect.left
FHeight = FormRect.bottom - FormRect.top
' Convert the measurements from pixels to twips.
ConvertPIXELSToTWIPS FLeft, FTop
ConvertPIXELSToTWIPS FWidth, FHeight
' If the form is not a pop-up form, adjust the screen
' coordinates to measure from the top of the Microsoft
' Access MDIClient window. Position 0,0 for a pop-up form
' is the upper-left corner of the screen, whereas position
' 0,0 for a normal window is the upper-left corner of the
' Microsoft Access client window below the menu bar.
If GetWindowClass(F.hWnd) <> "OFormPopup" Then
' Get the screen coordinates and window size of the
' MDIClient window.
apiGetWindowRect apiGetParent(F.hWnd), MDIClient
MDIClientLeft = MDIClient.left
MDIClientTop = MDIClient.top
ConvertPIXELSToTWIPS MDIClientLeft, MDIClientTop
' Adjust the form dimensions from the MDIClient
' measurements.
FLeft = FLeft - MDIClientLeft
FTop = FTop - MDIClientTop
End If
End Sub
Sub ConvertPIXELSToTWIPS(X As Long, Y As Long)
'*************************************************************
' PURPOSE: Converts the two pixel measurements passed as
' arguments to twips.
' ARGUMENTS:
' X, Y: Measurement variables in pixels. These will be
' converted to twips and returned through the same
' variables "by reference."
'*************************************************************
Dim hDC As Long, hWnd As Long, RetVal As Long
Dim XPIXELSPERINCH, YPIXELSPERINCH
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
' Retrieve the current number of pixels per inch, which is
' resolution-dependent.
hDC = apiGetDC(0)
XPIXELSPERINCH = apiGetDeviceCaps(hDC, LOGPIXELSX)
YPIXELSPERINCH = apiGetDeviceCaps(hDC, LOGPIXELSY)
RetVal = apiReleaseDC(0, hDC)
' Compute and return the measurements in twips.
X = (X / XPIXELSPERINCH) * TWIPSPERINCH
Y = (Y / YPIXELSPERINCH) * TWIPSPERINCH
End Sub
Function GetWindowClass(hWnd As Long) As String
'*************************************************************
' PURPOSE: Retrieve the class of the passed window handle.
' ARGUMENTS:
' hWnd: The window handle whose class is to be retrieved.
' RETURN:
' The window class name.
'*************************************************************
Dim Buff As String
Dim BuffSize As Integer
Buff = String$(255, " ")
BuffSize = apiGetClassName(hWnd, Buff, 255)
GetWindowClass = left$(Buff, BuffSize)
End Function
Sub MoveEmployeesAround ()
Dim frmCust As Form
Dim frmEmp As Form
Dim frmCustLeft As Long
Dim frmCustTop As Long
Dim frmCustWidth As Long
Dim frmCustHeight As Long
Dim frmEmpLeft As Long
Dim frmEmpTop As Long
Dim frmEmpWidth As Long
Dim frmEmpHeight As Long
Set frmCust = Forms!Customers
Set frmEmp = Forms!Employees
GetFormDimensions frmCust, frmCustLeft, frmCustTop, _
frmCustWidth, frmCustHeight
GetFormDimensions frmEmp, frmEmpLeft, frmEmpTop, _
frmEmpWidth, frmEmpHeight
frmEmp.SetFocus
MsgBox "Move Employees to the right of Customers!"
DoCmd.MoveSize frmCustLeft + frmCustWidth, frmCustTop
MsgBox "Move Employees below Customers!"
DoCmd.MoveSize frmCustLeft, frmCustTop + frmCustHeight
End Sub
MoveEmployeesAround
121100 ACC2: How to Get Form's Right and Down Measurements
Keywords: kbhowto kbprogramming KB143162