Article ID: 121100
Article Last Modified on 11/6/2000
Option Explicit
Type Rect
x1 As Integer
y1 As Integer
x2 As Integer
y2 As Integer
End Type
Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, _
lpRect As Rect)
Declare Function GetDC Lib "User" (ByVal hWnd As Integer) _
As Integer
Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, _
ByVal hDC As Integer) As Integer
Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, _
ByVal nIndex As Integer) As Integer
Declare Function GetActiveWindow Lib "User" () As Integer
Declare Function GetParent Lib "User" (ByVal hWnd As Integer) _
As Integer
Declare Function GetClassName Lib "User" (ByVal hWnd As Integer, _
ByVal lpClassName As String, ByVal nMaxCount As Integer) _
As Integer
Global Const TWIPSPERINCH = 1440
Sub GetFormDimensions (F As Form, FRight, FDown, FWidth, FHeight)
'*************************************************************
' PURPOSE: Returns the right, down, width, and height
' measurements of a form window in twips.
' ARGUMENTS:
' F: The form object whose measurements are to be determined.
' FRight, FDown, 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
Dim MDIClient As Rect
Dim MDIClientRight, MDIClientDown
' 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.
GetWindowRect F.hWnd, FormRect
FRight = FormRect.x1
FDown = FormRect.y1
FWidth = FormRect.x2 - FormRect.x1
FHeight = FormRect.y2 - FormRect.y1
' Convert the measurements from pixels to twips.
ConvertPIXELSToTWIPS FRight, FDown
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.
GetWindowRect GetParent(F.hWnd), MDIClient
MDIClientRight = MDIClient.x1
MDIClientDown = MDIClient.y1
ConvertPIXELSToTWIPS MDIClientRight, MDIClientDown
' Adjust the form dimensions from the MDIClient
' measurements.
FRight = FRight - MDIClientRight
FDown = FDown - MDIClientDown
End If
End Sub
Sub ConvertPIXELSToTWIPS (X, Y)
'*************************************************************
' 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 Integer, hWnd As Integer, RetVal As Integer
Dim XPIXELSPERINCH, YPIXELSPERINCH
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
' Retrieve the current number of pixels per inch, which is
' resolution-dependent.
hDC = GetDC(0)
XPIXELSPERINCH = GetDeviceCaps(hDC, LOGPIXELSX)
YPIXELSPERINCH = GetDeviceCaps(hDC, LOGPIXELSY)
RetVal = ReleaseDC(0, hDC)
' Compute and return the measurements in twips.
X = (X / XPIXELSPERINCH) * TWIPSPERINCH
Y = (Y / YPIXELSPERINCH) * TWIPSPERINCH
End Sub
Function GetWindowClass (hWnd) 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 = GetClassName(hWnd, Buff, 255)
GetWindowClass = Left$(Buff, BuffSize)
End Function
Sub MoveEmployeesAround ()
Dim frmCust As Form, frmEmp As Form
Dim CustRight, CustDown, CustWidth, CustHeight
Dim EmpRight, EmpDown, EmpWidth, EmpHeight
Set frmCust = Forms!Customers
Set frmEmp = Forms!Employees
GetFormDimensions frmCust, CustRight, CustDown, _
CustWidth, CustHeight
GetFormDimensions frmEmp, EmpRight, EmpDown, _
EmpWidth, EmpHeight
frmEmp.SetFocus
MsgBox "Move Employees to the right of Customers!"
DoCmd MoveSize CustRight + CustWidth, CustDown
MsgBox "Move Employees below Customers!"
DoCmd MoveSize CustRight, CustDown + CustHeight
End Sub
Keywords: kbhowto kbusage KB121100