Results 1 to 7 of 7

Thread: Remember Form's Position for Next Execution, Multi-Monitor

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    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.

  2. #2
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,470

    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

  3. #3
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,470

    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

  4. #4

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    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.

  5. #5
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    380

    Re: Remember Form's Position for Next Execution, Multi-Monitor

    As mentioned before, there are already APIs that were designed for this task.

    Quote Originally Posted by Raymond Chen
    The GetWindowPlacement and SetWindowPlacement functions are typically used by programs that wish to save/restore window positioning information across runs. 🔗
    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

  6. #6

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    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.

  7. #7
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    380

    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.

    Quote Originally Posted by MSDN
    To save, and later restore, the position of a window when an application exits, use the GetWindowPlacement and SetWindowPlacement functions.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width