Created
July 5, 2013 15:38
-
-
Save DaveRandom/5935361 to your computer and use it in GitHub Desktop.
Module for repositioning windows in Access using Window API calls
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Compare Database | |
Option Explicit | |
Private Type Point | |
x As Long | |
y As Long | |
End Type | |
Private Type Position | |
left As Long | |
top As Long | |
width As Long | |
height As Long | |
End Type | |
Private Type Dimensions | |
width As Long | |
height As Long | |
End Type | |
Private Type Rect | |
x1 As Long | |
y1 As Long | |
x2 As Long | |
y2 As Long | |
End Type | |
Public Enum Dimension | |
DIMENSION_X = 1 | |
DIMENSION_Y = 2 | |
End Enum | |
' VBA (or possibly just the editor) is stupid and doesn't handle hex literals correctly | |
' Luckily it doesn't seem to be able to cope with x64 so for now we can get away with decimals | |
Public Enum PositionMode | |
DISPLAY_LEFT = -2013265920 ' 0x88000000 | |
DISPLAY_RIGHT = -2080374784 ' 0x84000000 | |
DISPLAY_X_CENTER = -2113929216 ' 0x82000000 | |
DISPLAY_TOP = 34816 ' 0x00008800 | |
DISPLAY_BOTTOM = 33792 ' 0x00008400 | |
DISPLAY_Y_CENTER = 33280 ' 0x00008200 | |
WINDOW_LEFT = 1207959552 ' 0x48000000 | |
WINDOW_RIGHT = 1140850688 ' 0x44000000 | |
WINDOW_X_CENTER = 1107296256 ' 0x42000000 | |
WINDOW_TOP = 18432 ' 0x00004800 | |
WINDOW_BOTTOM = 17408 ' 0x00004400 | |
WINDOW_Y_CENTER = 16896 ' 0x00004200 | |
CURSOR_LEFT = 671088640 ' 0x28000000 | |
CURSOR_RIGHT = 603979776 ' 0x24000000 | |
CURSOR_X_CENTER = 570425344 ' 0x22000000 | |
CURSOR_TOP = 10240 ' 0x00002800 | |
CURSOR_BOTTOM = 9216 ' 0x00002400 | |
CURSOR_Y_CENTER = 8704 ' 0x00002200 | |
PREVENT_OVERFLOW_X = 16777216 ' 0x01000000 | |
PREVENT_OVERFLOW_Y = 256 ' 0x00000100 | |
PREVENT_OVERFLOW = 16777472 ' 0x01000100 | |
End Enum | |
Private Enum PositionModeMeta | |
DISPLAY_X = -2147483648# ' 0x80000000 | |
WINDOW_X = 1073741824 ' 0x40000000 | |
CURSOR_X = 536870912 ' 0x20000000 | |
DISPLAY_Y = 32768 ' 0x00008000 | |
WINDOW_Y = 16384 ' 0x00004000 | |
CURSOR_Y = 8192 ' 0x00002000 | |
LEFT_X = 134217728 ' 0x08000000 | |
RIGHT_X = 67108864 ' 0x04000000 | |
CENTER_X = 33554432 ' 0x02000000 | |
TOP_Y = 2048 ' 0x00000800 | |
BOTTOM_Y = 1024 ' 0x00000400 | |
CENTER_Y = 512 ' 0x00000200 | |
BASE_X = -536870912 ' 0xE0000000 | |
BASE_Y = 57344 ' 0x0000E000 | |
LOCATION_X = 234881024 ' 0x0E000000 | |
LOCATION_Y = 2584 ' 0x00000E00 | |
End Enum | |
' Some constants from the windows API (with more sensible names) | |
Private Const RESOLUTION_X = 8 | |
Private Const RESOLUTION_Y = 10 | |
Private Const DPI_X = 88 | |
Private Const DPI_Y = 90 | |
Private Const VIRTUALDISPLAY_LEFT = 76 | |
Private Const VIRTUALDISPLAY_TOP = 77 | |
Private Const VIRTUALDISPLAY_WIDTH = 78 | |
Private Const VIRTUALDISPLAY_HEIGHT = 79 | |
' Import some calls from the windows API | |
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long | |
Private Declare Function GetCursorPos Lib "user32" (lpPoint As Point) As Long | |
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long | |
Private Declare Function GetDesktopWindow Lib "user32" () As Long | |
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long | |
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As Rect) As Long | |
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal W As Long, ByVal H As Long, ByVal Repaint As Boolean) As Long | |
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long | |
' Get the current co-ordinate of the mouse pointer | |
Private Function GetCursorPoint() As Point | |
Dim udtMousePointer As Point | |
GetCursorPos udtMousePointer | |
GetCursorPoint = udtMousePointer | |
End Function | |
' Get the DPI setting for the desktop | |
Private Function GetDPI() As Point | |
Dim intWindow As Long, _ | |
intContext As Long | |
intWindow = GetDesktopWindow() | |
intContext = GetDC(intWindow) | |
GetDPI.x = GetDeviceCaps(intContext, DPI_X) | |
GetDPI.y = GetDeviceCaps(intContext, DPI_Y) | |
ReleaseDC intWindow, intContext | |
End Function | |
' Get the resolution of the the primary display | |
Private Function GetResolution() As Dimensions | |
Dim intWindow As Long, _ | |
intContext As Long | |
intWindow = GetDesktopWindow() | |
intContext = GetDC(intWindow) | |
GetResolution.width = GetDeviceCaps(intContext, RESOLUTION_X) | |
GetResolution.height = GetDeviceCaps(intContext, RESOLUTION_Y) | |
ReleaseDC intWindow, intContext | |
End Function | |
' Get the number of twips per pixel with the current settings of the primary display | |
Private Function GetTwipsPerPixel(Optional Dimension As Dimension = DIMENSION_X) As Double | |
Dim udtPrimaryDisplayResolution As Dimensions, _ | |
udtDPI As Point | |
udtPrimaryDisplayResolution = GetResolution() | |
udtDPI = GetDPI() | |
If Dimension = DIMENSION_Y Then | |
GetTwipsPerPixel = ((udtPrimaryDisplayResolution.height / udtDPI.y) * 1440) / udtPrimaryDisplayResolution.height | |
Else | |
GetTwipsPerPixel = ((udtPrimaryDisplayResolution.width / udtDPI.x) * 1440) / udtPrimaryDisplayResolution.width | |
End If | |
End Function | |
' Get a Position structure describing the supplied window handle | |
Private Function GetWindowPosition(hWnd As Long) As Position | |
Dim udtRect As Rect | |
GetWindowRect hWnd, udtRect | |
GetWindowPosition.left = udtRect.x1 | |
GetWindowPosition.top = udtRect.y1 | |
GetWindowPosition.width = udtRect.x2 - udtRect.x1 | |
GetWindowPosition.height = udtRect.y2 - udtRect.y1 | |
End Function | |
' Get a Dimensions structure describing the supplied window handle | |
Private Function GetWindowDimensions(hWnd As Long) As Dimensions | |
Dim udtRect As Rect | |
GetWindowRect hWnd, udtRect | |
GetWindowDimensions.width = udtRect.x2 - udtRect.x1 | |
GetWindowDimensions.height = udtRect.y2 - udtRect.y1 | |
End Function | |
' Convert the specified number of pixels to twips | |
Public Function PixelsToTwips(Pixels As Long, Optional Dimension As Dimension = DIMENSION_X) As Long | |
PixelsToTwips = CLng(Pixels * GetTwipsPerPixel(Dimension)) | |
End Function | |
' Convert the specified number of twips to pixels | |
Public Function TwipsToPixels(Twips As Long, Optional Dimension As Dimension = DIMENSION_X) As Long | |
TwipsToPixels = CLng(Twips / GetTwipsPerPixel(Dimension)) | |
End Function | |
Public Function PositionWindow(hWnd As Long, Mode As PositionMode, Optional OffsetX As Long = 0, Optional OffsetY As Long = 0) | |
Dim udtTargetWindowDimensions As Dimensions, _ | |
udtPrimaryDisplayResolution As Dimensions, _ | |
udtAccessWindowPosition As Position, _ | |
udtVirtualDisplayPosition As Position, _ | |
udtMousePointer As Point, _ | |
intActiveDisplayLeft As Long, _ | |
intActiveDisplayTop As Long, _ | |
intFormLeft As Long, _ | |
intFormTop As Long | |
' Validate mode mask | |
If (Mode And PositionModeMeta.BASE_X) = 0 Or (Mode And PositionModeMeta.BASE_Y) = 0 Or (Mode And PositionModeMeta.LOCATION_X) = 0 Or (Mode And PositionModeMeta.LOCATION_Y) = 0 Then | |
Err.Raise 1, "GUI.PositionWindow()", "Invalid mode mask, must contain base and location for X and Y axes" | |
End If | |
' Get some info about the current state of the desktop environment and the windows we're interested in | |
udtTargetWindowDimensions = GetWindowDimensions(hWnd) | |
udtPrimaryDisplayResolution = GetResolution() | |
udtAccessWindowPosition = GetWindowPosition(Application.hWndAccessApp) | |
udtMousePointer = GetCursorPoint() | |
udtVirtualDisplayPosition.left = GetSystemMetrics(VIRTUALDISPLAY_LEFT) | |
udtVirtualDisplayPosition.top = GetSystemMetrics(VIRTUALDISPLAY_TOP) | |
udtVirtualDisplayPosition.width = GetSystemMetrics(VIRTUALDISPLAY_WIDTH) | |
udtVirtualDisplayPosition.height = GetSystemMetrics(VIRTUALDISPLAY_HEIGHT) | |
' Find the X co-ordinate of the left-most pixel column on the target display | |
intActiveDisplayLeft = udtPrimaryDisplayResolution.width * (Math.Ceil(((udtAccessWindowPosition.width / 2) + udtAccessWindowPosition.left) / udtPrimaryDisplayResolution.width) - 1) | |
If intActiveDisplayLeft < udtVirtualDisplayPosition.left Then | |
intActiveDisplayLeft = udtVirtualDisplayPosition.left | |
ElseIf intActiveDisplayLeft >= udtVirtualDisplayPosition.left + udtVirtualDisplayPosition.width Then | |
intActiveDisplayLeft = udtVirtualDisplayPosition.width - udtPrimaryDisplayResolution.width | |
End If | |
' Find the Y co-ordinate of the top-most pixel row on the target display | |
intActiveDisplayTop = udtPrimaryDisplayResolution.height * (Math.Ceil(((udtAccessWindowPosition.height / 2) + udtAccessWindowPosition.top) / udtPrimaryDisplayResolution.height) - 1) | |
If intActiveDisplayTop < udtVirtualDisplayPosition.top Then | |
intActiveDisplayTop = udtVirtualDisplayPosition.top | |
ElseIf intActiveDisplayTop >= udtVirtualDisplayPosition.top + udtVirtualDisplayPosition.height Then | |
intActiveDisplayTop = udtVirtualDisplayPosition.height - udtPrimaryDisplayResolution.height | |
End If | |
' Find the desired X co-ordinate for the target window | |
If (Mode And PositionModeMeta.DISPLAY_X) = PositionModeMeta.DISPLAY_X Then | |
If (Mode And PositionModeMeta.LEFT_X) = PositionModeMeta.LEFT_X Then | |
intFormLeft = intActiveDisplayLeft + IIf(OffsetX <> 0, OffsetX, 1) | |
ElseIf (Mode And PositionModeMeta.RIGHT_X) = PositionModeMeta.RIGHT_X Then | |
intFormLeft = intActiveDisplayLeft + (udtPrimaryDisplayResolution.width - udtTargetWindowDimensions.width) + IIf(OffsetX <> 0, OffsetX, -1) | |
ElseIf (Mode And PositionModeMeta.CENTER_X) = PositionModeMeta.CENTER_X Then | |
intFormLeft = intActiveDisplayLeft + OffsetX + (udtPrimaryDisplayResolution.width / 2) - (udtTargetWindowDimensions.width / 2) | |
End If | |
Else | |
If (Mode And PositionModeMeta.WINDOW_X) = PositionModeMeta.WINDOW_X Then | |
If (Mode And PositionModeMeta.LEFT_X) = PositionModeMeta.LEFT_X Then | |
intFormLeft = udtAccessWindowPosition.left + IIf(OffsetX <> 0, OffsetX, 1) | |
ElseIf (Mode And PositionModeMeta.RIGHT_X) = PositionModeMeta.RIGHT_X Then | |
intFormLeft = udtAccessWindowPosition.left + (udtAccessWindowPosition.width - udtTargetWindowDimensions.width) + IIf(OffsetX <> 0, OffsetX, -1) | |
ElseIf (Mode And PositionModeMeta.CENTER_X) = PositionModeMeta.CENTER_X Then | |
intFormLeft = udtAccessWindowPosition.left + OffsetX + (udtAccessWindowPosition.width / 2) - (udtTargetWindowDimensions.width / 2) | |
End If | |
ElseIf (Mode And PositionModeMeta.CURSOR_X) = PositionModeMeta.CURSOR_X Then | |
If (Mode And PositionModeMeta.LEFT_X) = PositionModeMeta.LEFT_X Then | |
intFormLeft = udtMousePointer.x + OffsetX - udtTargetWindowDimensions.width | |
ElseIf (Mode And PositionModeMeta.RIGHT_X) = PositionModeMeta.RIGHT_X Then | |
intFormLeft = udtMousePointer.x + OffsetX | |
ElseIf (Mode And PositionModeMeta.CENTER_X) = PositionModeMeta.CENTER_X Then | |
intFormLeft = udtMousePointer.x + OffsetX - (udtTargetWindowDimensions.width / 2) | |
End If | |
End If | |
' Correct horizontal overflow off the target display | |
If (Mode And PositionMode.PREVENT_OVERFLOW_X) = PositionMode.PREVENT_OVERFLOW_X Then | |
If intFormLeft < intActiveDisplayLeft Then | |
intFormLeft = intActiveDisplayLeft + 1 | |
ElseIf intFormLeft >= intActiveDisplayLeft + udtPrimaryDisplayResolution.width - (udtTargetWindowDimensions.width + 1) Then | |
intFormLeft = intActiveDisplayLeft + udtPrimaryDisplayResolution.width - (udtTargetWindowDimensions.width + 1) | |
End If | |
End If | |
End If | |
' Find the desired Y co-ordinate for the target window | |
If (Mode And PositionModeMeta.DISPLAY_Y) = PositionModeMeta.DISPLAY_Y Then | |
If (Mode And PositionModeMeta.TOP_Y) = PositionModeMeta.TOP_Y Then | |
intFormTop = intActiveDisplayTop + IIf(OffsetY <> 0, OffsetY, 1) | |
ElseIf (Mode And PositionModeMeta.BOTTOM_Y) = PositionModeMeta.BOTTOM_Y Then | |
intFormTop = intActiveDisplayTop + (udtPrimaryDisplayResolution.height - udtTargetWindowDimensions.height) + IIf(OffsetY <> 0, OffsetY, -1) | |
ElseIf (Mode And PositionModeMeta.CENTER_Y) = PositionModeMeta.CENTER_Y Then | |
intFormTop = intActiveDisplayTop + OffsetY + (udtPrimaryDisplayResolution.height / 2) - (udtTargetWindowDimensions.height / 2) | |
End If | |
Else | |
If (Mode And PositionModeMeta.WINDOW_Y) = PositionModeMeta.WINDOW_Y Then | |
If (Mode And PositionModeMeta.TOP_Y) = PositionModeMeta.TOP_Y Then | |
intFormTop = udtAccessWindowPosition.top + IIf(OffsetY <> 0, OffsetY, 1) | |
ElseIf (Mode And PositionModeMeta.BOTTOM_Y) = PositionModeMeta.BOTTOM_Y Then | |
intFormTop = udtAccessWindowPosition.top + (udtAccessWindowPosition.height - udtTargetWindowDimensions.height) + IIf(OffsetY <> 0, OffsetY, -1) | |
ElseIf (Mode And PositionModeMeta.CENTER_Y) = PositionModeMeta.CENTER_Y Then | |
intFormTop = udtAccessWindowPosition.top + OffsetY + (udtAccessWindowPosition.height / 2) - (udtTargetWindowDimensions.height / 2) | |
End If | |
ElseIf (Mode And PositionModeMeta.CURSOR_Y) = PositionModeMeta.CURSOR_Y Then | |
If (Mode And PositionModeMeta.TOP_Y) = PositionModeMeta.TOP_Y Then | |
intFormTop = udtMousePointer.y + OffsetY - udtTargetWindowDimensions.height | |
ElseIf (Mode And PositionModeMeta.BOTTOM_Y) = PositionModeMeta.BOTTOM_Y Then | |
intFormTop = udtMousePointer.y + OffsetY | |
ElseIf (Mode And PositionModeMeta.CENTER_Y) = PositionModeMeta.CENTER_Y Then | |
intFormTop = udtMousePointer.y + OffsetY - (udtTargetWindowDimensions.height / 2) | |
End If | |
End If | |
' Correct vertical overflow off the target display | |
If (Mode And PositionMode.PREVENT_OVERFLOW_Y) = PositionMode.PREVENT_OVERFLOW_Y Then | |
If intFormTop < intActiveDisplayTop Then | |
intFormTop = intActiveDisplayTop + 1 | |
ElseIf intFormTop >= intActiveDisplayTop + udtPrimaryDisplayResolution.height - (udtTargetWindowDimensions.height + 1) Then | |
intFormTop = intActiveDisplayTop + udtPrimaryDisplayResolution.height - (udtTargetWindowDimensions.height + 1) | |
End If | |
End If | |
End If | |
' Move the window to the calculated position | |
MoveWindow hWnd, intFormLeft, intFormTop, udtTargetWindowDimensions.width, udtTargetWindowDimensions.height, True | |
End Function |
Hi @DittoBird, in order for the code to function as designed, @lars49's function needs to be placed in a separate module named "Math". You can also simply place the function into the same module as this code, and remove Math.
from the function reference.
Apologies for publishing broken code, I haven't touched Access for a few years but this code came from a wider ecosystem with a few "standard" modules, where I basically wrote a few shims to make VBA behave a bit more like VB.net/C#/JS/Java/a generally saner programming language :-P
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Hi Dave :) I came here from StackOverflow at https://stackoverflow.com/questions/1290125/how-can-i-find-the-width-of-the-parent-window-in-ms-access and am looking desperately for some means to measure the height of an Access window - I'm using A2016 ATM. Unfortunately, even adding in that ceiling function Lars49 has suggested on the same module (I changed it to public in the screen shot to see if it helped), I get errors on compilation.
Is there a specific reference I need? Thank you.