Here's something I just cobbled together for a project I'm working on, and this occasionally comes up in these forums.
It's a couple of procedures (with support procedures) for saving the last position of a form, and putting it back there the next time it's shown. Now, this is easy so long as we only have one monitor. However, things get a bit tricky when we're on a multi-monitor system, and especially if that system may often have different monitor configurations (such as my laptop I haul around with me all over the place).
These procedures should be robust to changes in configurations. Furthermore, they make sure the form will always be fully shown on some monitor the next time it's shown.
The registry is used to store last position, so it'll be machine/user specific.
It's very easy to use. Here's an example in a form:
And here's code for it that you can throw into a BAS module:
All will work fine in the IDE. However, the last form position won't be saved if you use the IDE's stop button. I didn't want to use sub-classing, so I don't have any way to track form movement, other than querying it when the form closes.
Enjoy,
Elroy
EDIT1: Also, it should work just fine for as many forms as you'd like to use it for in a project.
It's a couple of procedures (with support procedures) for saving the last position of a form, and putting it back there the next time it's shown. Now, this is easy so long as we only have one monitor. However, things get a bit tricky when we're on a multi-monitor system, and especially if that system may often have different monitor configurations (such as my laptop I haul around with me all over the place).
These procedures should be robust to changes in configurations. Furthermore, they make sure the form will always be fully shown on some monitor the next time it's shown.
The registry is used to store last position, so it'll be machine/user specific.
It's very easy to use. Here's an example in a form:
Code:
Option Explicit
Private Sub Form_Load()
FetchAndSetFormPos Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveFormPos Me
End Sub
Code:
Option Explicit
'
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long ' This is +1 (right - left = width)
Bottom As Long ' This is +1 (bottom - top = height)
End Type
Private Type MONITORINFO
cbSize As Long
rcMonitor As RECT
rcWork As RECT
dwFlags As Long
End Type
'
Private Declare Function EnumDisplayMonitors Lib "user32" (ByVal hdc As Long, lprcClip As Any, ByVal lpfnEnum As Long, dwData As Long) As Long
Private Declare Function MonitorFromWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFO) As Long
'
Public Sub FetchAndSetFormPos(frm As Form, Optional TopPixelsAdd As Long, Optional LeftPixelsAdd As Long)
' Initial (default) position is in center, biased toward top.
' The TopPixelsAdd and LeftPixelsAdd can be used to move from the center (top biased) default position. They can be negative.
'
Dim iMon As Long
Dim iTop As Long
Dim iLeft As Long
Dim hMonitor As Long
Dim iFrmHeight As Long
Dim iFrmWidth As Long
Dim iMonHeight As Long
Dim iMonWidth As Long
'
iFrmHeight = WindowHeightPx(frm.hWnd)
iFrmWidth = WindowWidthPx(frm.hWnd)
'
iMon = GetSetting(App.Title, "Settings", frm.Name & "Mon", 1&)
If iMon < 1& Then iMon = 1&
If iMon > MonitorCount Then iMon = 1&
hMonitor = MonitorHandle(iMon)
iMonHeight = MonitorHeightPx(hMonitor)
iMonWidth = MonitorWidthPx(hMonitor)
'
iTop = GetSetting(App.Title, "Settings", frm.Name & "Top", (iMonHeight - iFrmHeight) \ 3 + TopPixelsAdd)
iLeft = GetSetting(App.Title, "Settings", frm.Name & "Left", (iMonWidth - iFrmWidth) \ 2 + LeftPixelsAdd)
If iTop + iFrmHeight > iMonHeight Then iTop = iMonHeight - iFrmHeight
If iLeft + iFrmWidth > iMonWidth Then iLeft = iMonWidth - iFrmWidth
If iTop < 0 Then iTop = 0
If iLeft < 0 Then iLeft = 0
'
PositionWindowOnMonitor frm.hWnd, hMonitor, iLeft, iTop
End Sub
Public Sub SaveFormPos(frm As Form)
SaveSetting App.Title, "Settings", frm.Name & "Top", WindowTopPx(frm.hWnd)
SaveSetting App.Title, "Settings", frm.Name & "Left", WindowLeftPx(frm.hWnd)
SaveSetting App.Title, "Settings", frm.Name & "Mon", MonitorNumForHwnd(frm.hWnd)
End Sub
Public Function MonitorCount() As Long
EnumDisplayMonitors 0&, ByVal 0&, AddressOf MonitorCountEnum, MonitorCount
End Function
Private Function MonitorCountEnum(ByVal hMonitor As Long, ByVal hdcMonitor As Long, uRect As RECT, dwData As Long) As Long
dwData = dwData + 1
MonitorCountEnum = 1 ' Count them all.
End Function
Public Function MonitorNumForHwnd(hWnd As Long) As Long
MonitorNumForHwnd = MonitorNum(MonitorHandleForHwnd(hWnd))
End Function
Public Function MonitorHandleForHwnd(hWnd As Long) As Long
Const MONITOR_DEFAULTTONULL = &H0
MonitorHandleForHwnd = MonitorFromWindow(hWnd, MONITOR_DEFAULTTONULL)
End Function
Public Function MonitorNum(hMonitor As Long) As Long
' This one returns the monitor number from the monitor's handle.
' ZERO is returned if not found.
' Monitors are ONE based when counted, no holes.
' These numbers do NOT necessarily match numbers in control panel.
Dim dwData As Long
dwData = -hMonitor ' Send it in negative to indicate first iteration.
EnumDisplayMonitors 0&, ByVal 0&, AddressOf MonitorNumEnum, dwData
If Abs(dwData) <> hMonitor Then MonitorNum = dwData ' The number is returned in dwData if found.
End Function
Private Function MonitorNumEnum(ByVal hMonitor As Long, ByVal hdcMonitor As Long, uRect As RECT, dwData As Long) As Long
Static iCount As Long
If dwData < 0 Then
iCount = 1
dwData = -dwData
Else
iCount = iCount + 1
End If
If dwData = hMonitor Then
dwData = iCount
MonitorNumEnum = 0 ' Found it.
Else
MonitorNumEnum = 1 ' Keep looking.
End If
End Function
Public Sub PositionWindowOnMonitor(hWnd As Long, hMonitor As Long, ByVal lLeftPixel As Long, ByVal lTopPixel As Long)
' This can be used to position windows on other programs so long as you have the hWnd.
Dim lHeight As Long
Dim lWidth As Long
'
lHeight = WindowHeightPx(hWnd)
lWidth = WindowWidthPx(hWnd)
'
lLeftPixel = lLeftPixel + MonitorLeftPx(hMonitor)
lTopPixel = lTopPixel + MonitorTopPx(hMonitor)
'
MoveWindow hWnd, lLeftPixel, lTopPixel, lWidth, lHeight, 1&
End Sub
Public Function WindowHeightPx(hWnd As Long) As Long
Dim r As RECT
GetWindowRect hWnd, r
WindowHeightPx = r.Bottom - r.Top
End Function
Public Function WindowWidthPx(hWnd As Long) As Long
Dim r As RECT
GetWindowRect hWnd, r
WindowWidthPx = r.Right - r.Left
End Function
Public Function WindowTopPx(hWnd As Long) As Long
' This adjusts for the monitor the window is on.
Dim r As RECT
GetWindowRect hWnd, r
WindowTopPx = r.Top - MonitorTopPx(MonitorHandleForHwnd(hWnd))
End Function
Public Function WindowLeftPx(hWnd As Long) As Long
' This adjusts for the monitor the window is on.
Dim r As RECT
GetWindowRect hWnd, r
WindowLeftPx = r.Left - MonitorLeftPx(MonitorHandleForHwnd(hWnd))
End Function
Public Function MonitorLeftPx(hMonitor As Long) As Long
' If you just have the number, do: MonitorLeftPx(MonitorHandle(MonitorNum))
Dim uMonInfo As MONITORINFO
uMonInfo.cbSize = LenB(uMonInfo)
If GetMonitorInfo(hMonitor, uMonInfo) = 0 Then Exit Function
MonitorLeftPx = uMonInfo.rcMonitor.Left
End Function
Public Function MonitorTopPx(hMonitor As Long) As Long
' If you just have the number, do: MonitorTopPx(MonitorHandle(MonitorNum))
Dim uMonInfo As MONITORINFO
uMonInfo.cbSize = LenB(uMonInfo)
If GetMonitorInfo(hMonitor, uMonInfo) = 0 Then Exit Function
MonitorTopPx = uMonInfo.rcMonitor.Top
End Function
Public Function MonitorHandle(ByVal MonitorNum As Long) As Long
' Monitors are ONE based when counted, no holes.
' These numbers do NOT necessarily match numbers in control panel.
Dim dwData As Long
dwData = -MonitorNum ' Send it in negative.
EnumDisplayMonitors 0&, ByVal 0&, AddressOf MonitorHandleEnum, dwData
If dwData > 0 Then MonitorHandle = dwData ' The handle is returned in dwData if found.
End Function
Private Function MonitorHandleEnum(ByVal hMonitor As Long, ByVal hdcMonitor As Long, uRect As RECT, dwData As Long) As Long
dwData = dwData + 1 ' They come in negative to stay out of the way of handles.
If dwData = 0 Then ' We're at the one we want.
dwData = hMonitor
MonitorHandleEnum = 0
Else
MonitorHandleEnum = 1
End If
End Function
Public Function MonitorWidthPx(hMonitor As Long) As Long
' If you just have the number, do: MonitorWidthPx(MonitorWidthPx(MonitorNum))
Dim uMonInfo As MONITORINFO
uMonInfo.cbSize = LenB(uMonInfo)
If GetMonitorInfo(hMonitor, uMonInfo) = 0 Then Exit Function
MonitorWidthPx = uMonInfo.rcMonitor.Right - uMonInfo.rcMonitor.Left
End Function
Public Function MonitorHeightPx(hMonitor As Long) As Long
' If you just have the number, do: MonitorHeightPx(MonitorWidthPx(MonitorNum))
Dim uMonInfo As MONITORINFO
uMonInfo.cbSize = LenB(uMonInfo)
If GetMonitorInfo(hMonitor, uMonInfo) = 0 Then Exit Function
MonitorHeightPx = uMonInfo.rcMonitor.Bottom - uMonInfo.rcMonitor.Top
End Function
Enjoy,
Elroy
EDIT1: Also, it should work just fine for as many forms as you'd like to use it for in a project.