'adapted, and now not very similar, from code in [URL unfurl="true"]http://www.freevbcode.com/source/0207/Multi-MonitorFormCentering.zip[/URL]
Option Explicit
'required but declared public by me elsewhere
'Private Type RECT
' Left As Long
' Top As Long
' Right As Long
' Bottom As Long
'End Type
'Constants for the return value when finding a monitor
Private Enum dwFlags
MONITOR_DEFAULTTONULL = &H0 'If the monitor is not found, return 0
MONITOR_DEFAULTTOPRIMARY& = &H1 'If the monitor is not found, return the primary monitor
MONITOR_DEFAULTTONEAREST = &H2 'If the monitor is not found, return the nearest monitor
End Enum
Private Const MONITORINFOF_PRIMARY = 1
'Structure for the position of a monitor
Private Type tagMONITORINFO
cbSize As Long 'Size of structure
rcMonitor As RECT 'Monitor rect
rcWork As RECT 'Working area rect
dwFlags As Long 'Flags
End Type
Type UDTMonitor
handle As Long
Left As Long
Right As Long
Top As Long
Bottom As Long
WorkLeft As Long
WorkRight As Long
WorkTop As Long
Workbottom As Long
Height As Long
Width As Long
WorkHeight As Long
WorkWidth As Long
IsPrimary As Boolean
End Type
Private Declare Function MonitorFromRect Lib "user32" (rc As RECT, ByVal dwFlags As dwFlags) As Long
Private Declare Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, MonInfo As tagMONITORINFO) As Long
Public Sub EnsureFormIsInsideMonitor(Frm As Form, Optional RefForm As Form)
'typically used to determine if the previously saved position/size of a Form needs adjustment re the current monitor layout
' if a Form is mapped to a disconnected monitor the Form is remapped to the Primary monitor
'typical usage:
'Private Sub Form_Load()
' retrieve previous left and top positions from file and apply them to Me.Left and Me.Top Properties
' EnsureFormIsInsideMonitor Me
'End Sub
'If Reform is not specified Frm is positioned to be displayed entirely within the monitor on which most of it is currently mapped
'If Reform is specified Frm is positioned to be displayed entirely on the same monitor as that on which most of Reform is mapped
'adjusts Frm Left and Top so that all the borders of Frm are contained within the same Monitor
' if Frm.Width or Height exceed monitor.width or height Frm is positioned at Left/ Top of monitor and
' Width/ Height of Frm may be adjusted if Frm is Sizable
Dim VFlag As Boolean, HFlag As Boolean
Dim cMonitor As UDTMonitor
If RefForm Is Nothing Then Set RefForm = Frm
cMonitor = MonitorProperties(RefForm)
With Frm
If .Width > cMonitor.WorkWidth Then
If .BorderStyle = vbSizable Or .BorderStyle = vbSizableToolWindow Then
.Width = cMonitor.WorkWidth
Else
.Left = cMonitor.WorkLeft: HFlag = True
End If
End If
If .Height > cMonitor.WorkHeight Then
If .BorderStyle = vbSizable Or .BorderStyle = vbSizableToolWindow Then
.Height = cMonitor.WorkHeight
Else
.Top = cMonitor.WorkTop: VFlag = True
End If
End If
If Not HFlag Then
If .Left < cMonitor.WorkLeft Then .Left = cMonitor.WorkLeft
If (.Left + .Width) > cMonitor.WorkRight Then .Left = cMonitor.WorkRight - .Width
End If
If Not VFlag Then
If .Top < cMonitor.WorkTop Then .Top = cMonitor.WorkTop
If (.Top + .Height) > cMonitor.Workbottom Then .Top = cMonitor.Workbottom - .Height
End If
End With
End Sub
Public Function MonitorProperties(Frm As Form) As UDTMonitor
'Return the properties (in Twips) of the monitor on which most of Frm is mapped
Dim hMonitor As Long
Dim MonitorInfo As tagMONITORINFO
Dim tppx&, tppy&
Dim Frect As RECT
GetWindowRect Frm.hWnd, Frect
hMonitor = MonitorFromRect(Frect, MONITOR_DEFAULTTOPRIMARY) 'get handle for monitor containing most of Frm
' if disconnected return handle (and properties) for primary monitor
tppx = Screen.TwipsPerPixelX
tppy = Screen.TwipsPerPixelY
On Error GoTo GetMonitorInformation_Err
MonitorInfo.cbSize = Len(MonitorInfo)
GetMonitorInfo hMonitor, MonitorInfo
With MonitorProperties
.handle = hMonitor
'convert all dimensions from pixels to twips
.Left = MonitorInfo.rcMonitor.Left * tppx
.Right = MonitorInfo.rcMonitor.Right * tppx
.Top = MonitorInfo.rcMonitor.Top * tppy
.Bottom = MonitorInfo.rcMonitor.Bottom * tppy
.WorkLeft = MonitorInfo.rcWork.Left * tppx
.WorkRight = MonitorInfo.rcWork.Right * tppx
.WorkTop = MonitorInfo.rcWork.Top * tppy
.Workbottom = MonitorInfo.rcWork.Bottom * tppy
.Height = (MonitorInfo.rcMonitor.Bottom - MonitorInfo.rcMonitor.Top) * tppy
.Width = (MonitorInfo.rcMonitor.Right - MonitorInfo.rcMonitor.Left) * tppx
.WorkHeight = (MonitorInfo.rcWork.Bottom - MonitorInfo.rcWork.Top) * tppy
.WorkWidth = (MonitorInfo.rcWork.Right - MonitorInfo.rcWork.Left) * tppx
.IsPrimary = MonitorInfo.dwFlags And MONITORINFOF_PRIMARY
End With
Exit Function
GetMonitorInformation_Err:
Beep
If Err.Number = 453 Then
'should be handled if pre win2k compatibility is required
'Non-Multimonitor OS, return -1
'GetMonitorInformation = -1
'etc
End If
End Function