-
Mar 22nd, 2018, 05:53 PM
#1
Remember Form's Position for Next Execution, Multi-Monitor
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:
Code:
Option Explicit
Private Sub Form_Load()
FetchAndSetFormPos Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveFormPos Me
End Sub
And here's code for it that you can throw into a BAS module:
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
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.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Mar 23rd, 2018, 09:56 AM
#2
Re: Remember Form's Position for Next Execution, Multi-Monitor
Thanks Elroy. This is something I have thought about doing for a while now. It just wasn't a priority, and you saved me the effort.
J.A. Coutts
-
Mar 23rd, 2018, 03:00 PM
#3
Re: Remember Form's Position for Next Execution, Multi-Monitor
I don't know about you, but windows positioned below the translucent Taskbar but the H out of me. So I simplified the routine, added saving the window size, and accounted for the location of the Taskbar. This required adding the Microsoft SysInfo Control. I also used the application name instead of the form name, because once the main form is loaded, the location of other forms can be controlled by the main form. As well, I did not account for multiple monitors. The resizing of the form would have to be made optional, or an option to restore to original would have to be included.
J.A. Coutts
Code:
Option Explicit
Private Const gAppName As String = "frmTest"
Private WorkHeight As Long
Private WorkWidth As Long
Private WorkTop As Long
Private WorkLeft As Long
Private Sub GetPos(hWindow)
Dim lTop As Long
Dim lLeft As Long
Dim lHeight As Long
Dim lWidth As Long
lTop = GetSetting(gAppName, "Settings", "Top", -1)
lLeft = GetSetting(gAppName, "Settings", "Left", -1)
lHeight = GetSetting(gAppName, "Settings", "Height", -1)
lWidth = GetSetting(gAppName, "Settings", "Width", -1)
If lTop < 0 Then lTop = (WorkHeight - hWindow.Height) / 2 'Default
If lLeft < 0 Then lLeft = (WorkWidth - hWindow.Width) / 2 'Default
If lHeight > 0 Then hWindow.Height = lHeight 'Not default
If lWidth > 0 Then hWindow.Width = lWidth 'Not default
hWindow.Top = lTop
hWindow.Left = lLeft
End Sub
Private Sub SavePos(hWindow)
Dim lTop As Long
Dim lLeft As Long
lTop = hWindow.Top
lLeft = hWindow.Left
'Check if window will be off screen
If lTop < WorkTop Then lTop = WorkTop
If lTop > (WorkHeight - hWindow.Height) Then lTop = WorkHeight - hWindow.Height
If lLeft < WorkLeft Then lLeft = WorkLeft
If lLeft > (WorkWidth - hWindow.Width) Then lLeft = WorkWidth - hWindow.Width
SaveSetting gAppName, "Settings", "Top", lTop
SaveSetting gAppName, "Settings", "Left", lLeft
SaveSetting gAppName, "Settings", "Height", hWindow.Height
SaveSetting gAppName, "Settings", "Width", hWindow.Width
End Sub
Private Sub Form_Load()
WorkHeight = SysInfo1.WorkAreaHeight
WorkWidth = SysInfo1.WorkAreaWidth
WorkTop = SysInfo1.WorkAreaTop
WorkLeft = SysInfo1.WorkAreaLeft
GetPos Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
SavePos Me
End Sub
-
Mar 23rd, 2018, 07:01 PM
#4
Re: Remember Form's Position for Next Execution, Multi-Monitor
Hi couttsj,
For me, the multi-monitor issue was the whole reason for doing it. Also, the application I did it for has 6 forms that are always on the screen. And I wanted the user to be able to place those 6 forms wherever he/she wanted, very similar to the VB6 IDE (when not running in MDI mode). In fact, the situation I wanted to create is almost exactly like the VB6 IDE (when not docking nor running in MDI mode).
You're right, I didn't account for the TaskBar, but that wasn't a big one for me. Maybe someday I'll add that as an enhancement.
Take Care,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Mar 24th, 2018, 03:42 AM
#5
Re: Remember Form's Position for Next Execution, Multi-Monitor
As mentioned before, there are already APIs that were designed for this task.
Originally Posted by Raymond Chen
Code:
Option Explicit 'In a blank Form
Private Enum WINDOWPLACEMENT_FLAGS
WPF_SETMINPOSITION = &H1
WPF_RESTORETOMAXIMIZED = &H2
WPF_ASYNCWINDOWPLACEMENT = &H4
End Enum
#If False Then
Dim WPF_SETMINPOSITION, WPF_RESTORETOMAXIMIZED, WPF_ASYNCWINDOWPLACEMENT
#End If
Private Enum SHOWWINDOW_STATES
SW_HIDE = 0
SW_SHOWNORMAL = 1
SW_SHOWMINIMIZED = 2
SW_SHOWMAXIMIZED = 3
SW_MAXIMIZE = 3
SW_SHOWNOACTIVATE = 4
SW_SHOW = 5
SW_MINIMIZE = 6
SW_SHOWMINNOACTIVE = 7
SW_SHOWNA = 8
SW_RESTORE = 9
End Enum
#If False Then
Dim SW_HIDE, SW_SHOWNORMAL, SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED, SW_MAXIMIZE, _
SW_SHOWNOACTIVATE, SW_SHOW, SW_MINIMIZE, SW_SHOWMINNOACTIVE, SW_SHOWNA, SW_RESTORE
#End If
Private Type POINTL
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type WINDOWPLACEMENT
Length As Long
Flags As Long 'WINDOWPLACEMENT_FLAGS <-- Can't use Enums because VB6 complains "Can't Get or Put an object reference
ShowCmd As Long 'SHOWWINDOW_STATES <-- variable or a variable of user-defined type containing an object reference"
ptMinPosition As POINTL
ptMaxPosition As POINTL
rcNormalPosition As RECT
End Type
Private Declare Function GetWindowPlacement Lib "user32.dll" (ByVal hWnd As Long, ByRef lpWndPl As WINDOWPLACEMENT) As Long
Private Declare Function SetWindowPlacement Lib "user32.dll" (ByVal hWnd As Long, ByRef lpWndPl As WINDOWPLACEMENT) As Long
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Load()
Dim FN As Integer, RV As Long, sFileName As String, WP As WINDOWPLACEMENT
sFileName = App.Path & "\" & App.EXEName & ".dat"
If FileExists(sFileName) Then
FN = FreeFile
On Error GoTo 1
Open sFileName For Binary As FN
Get FN, , WP
Close FN
On Error GoTo 0
RV = SetWindowPlacement(hWnd, WP): Debug.Assert RV
End If 'StartUpPosition must be vbStartUpManual!
Exit Sub
1 MsgBox Err.Description, vbCritical, "Error " & Err
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim FN As Integer, RV As Long, sFileName As String, WP As WINDOWPLACEMENT
WP.Length = LenB(WP)
RV = GetWindowPlacement(hWnd, WP): Debug.Assert RV
If RV Then
sFileName = App.Path & "\" & App.EXEName & ".dat"
FN = FreeFile
On Error GoTo 1
Open sFileName For Binary As FN
Put FN, , WP
Close FN
On Error GoTo 0
End If
Exit Sub
1 MsgBox Err.Description, vbCritical, "Error " & Err
End Sub
Private Function FileExists(ByRef FileName As String) As Boolean
On Error Resume Next
FileExists = (GetAttr(FileName) And vbDirectory) <> vbDirectory
On Error GoTo 0
End Function
-
Mar 24th, 2018, 09:10 AM
#6
Re: Remember Form's Position for Next Execution, Multi-Monitor
Hi Victor,
Not quite the same thing (handling changes in monitor configuration, re-showing the form as normalized, making sure the form is wholly on the screen, easily handling multiple forms). But hey ho, to each their own. There's always more than one way to skin a cat.
You Take Care,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Mar 24th, 2018, 10:50 AM
#7
Re: Remember Form's Position for Next Execution, Multi-Monitor
Perhaps these links will help convince you there's really no need to reinvent the wheel.
Originally Posted by MSDN
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|