I wanted to extend my App (MDI Form) on only 3 monitors (I have 5)
So I wrote this small code.
I added a button in the app to extend the application to 3 monitors, by just calling
' Extend the form to monitor 4, 3 & 5
Call MaximizeToSpecificMonitors(Me, 4, 3, 5)
I have also added a small procedure to draw the monitors in a picturebox
So I wrote this small code.
I added a button in the app to extend the application to 3 monitors, by just calling
' Extend the form to monitor 4, 3 & 5
Call MaximizeToSpecificMonitors(Me, 4, 3, 5)
I have also added a small procedure to draw the monitors in a picturebox
Code:
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 11/19/2024
' * Time : 14:12
' * Module Name : MonitorExtend_Module
' * Module Filename : MonitorExtend_Module.bas
' * Purpose :
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Option Explicit
Private Declare Function EnumDisplayMonitors Lib "user32" (ByVal hDC As Long, ByVal lprcClip As Long, ByVal lpfnEnum As Long, ByVal dwData As Long) As Long
Private Declare Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFO) As Long
Private Declare Function MonitorFromPoint Lib "user32" (ByVal X As Long, ByVal Y As Long, ByVal dwFlags As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type MONITORINFO
cbSize As Long
rcMonitor As RECT
rcWork As RECT
dwFlags As Long
End Type
Private mLeft As Long
Private mTop As Long
Private mRight As Long
Private mBottom As Long
Private MonitorRects() As RECT ' Store dimensions of each monitor
Private MonitorCount As Long
Private PrimaryMonitor As Long
Private Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, ByRef lprcMonitor As RECT, ByVal dwData As Long) As Long
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.immoassist.com
' * E-Mail : info@immoassist.com
' * Date : 11/19/2024
' * Time : 14:12
' * Module Name : MonitorExtend_Module
' * Module Filename : MonitorExtend_Module.bas
' * Procedure Name : MonitorEnumProc
' * Purpose :
' * Parameters :
' * ByVal hMonitor As Long
' * ByVal hdcMonitor As Long
' * ByRef lprcMonitor As RECT
' * ByVal dwData As Long
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim mi As MONITORINFO
mi.cbSize = Len(mi)
If GetMonitorInfo(hMonitor, mi) Then
MonitorCount = MonitorCount + 1
ReDim Preserve MonitorRects(1 To MonitorCount)
MonitorRects(MonitorCount) = mi.rcMonitor
' Identify the primary monitor
If (mi.dwFlags And 1) Then PrimaryMonitor = MonitorCount
End If
MonitorEnumProc = 1 ' Continue enumeration
End Function
Public Sub MaximizeToAllMonitors(frm As Form)
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.immoassist.com
' * E-Mail : info@immoassist.com
' * Date : 11/19/2024
' * Time : 14:12
' * Module Name : MonitorExtend_Module
' * Module Filename : MonitorExtend_Module.bas
' * Procedure Name : MaximizeToAllMonitors
' * Purpose :
' * Parameters :
' * frm As Form
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' Initialize global dimensions
mLeft = 0
mTop = 0
mRight = 0
mBottom = 0
' Enumerate monitors and calculate combined dimensions
Call EnumDisplayMonitors(0, 0, AddressOf MonitorEnumProc, 0)
' Convert dimensions to Twips
Dim TwipsLeft As Long
Dim TwipsTop As Long
Dim TwipsWidth As Long
Dim TwipsHeight As Long
TwipsLeft = mLeft * Screen.TwipsPerPixelX
TwipsTop = mTop * Screen.TwipsPerPixelY
TwipsWidth = (mRight - mLeft) * Screen.TwipsPerPixelX
TwipsHeight = (mBottom - mTop) * Screen.TwipsPerPixelY
' Resize the form
With frm
.Left = TwipsLeft
.Top = TwipsTop
.Width = TwipsWidth
.Height = TwipsHeight
End With
End Sub
Public Sub MaximizeToSpecificMonitors(frm As Form, ParamArray MonitorIndexes() As Variant)
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.immoassist.com
' * E-Mail : info@immoassist.com
' * Date : 11/19/2024
' * Time : 14:12
' * Module Name : MonitorExtend_Module
' * Module Filename : MonitorExtend_Module.bas
' * Procedure Name : MaximizeToSpecificMonitors
' * Purpose :
' * Parameters :
' * frm As Form
' * ParamArray MonitorIndexes() As Variant
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim i As Long
Dim MonitorIndex As Long
Dim SelectedLeft As Long
Dim SelectedTop As Long
Dim SelectedRight As Long
Dim SelectedBottom As Long
Dim FirstMonitor As Boolean
frm.WindowState = vbNormal
' Initialize monitors
MonitorCount = 0
ReDim MonitorRects(1 To 1)
Call EnumDisplayMonitors(0, 0, AddressOf MonitorEnumProc, 0)
' Check if the specified monitors exist
If MonitorCount < UBound(MonitorIndexes) + 1 Then
MsgBox "The number of one or more specified monitors is invalid.", vbExclamation
Exit Sub
End If
' Initialize combined dimensions
FirstMonitor = True
For i = LBound(MonitorIndexes) To UBound(MonitorIndexes)
MonitorIndex = MonitorIndexes(i)
If MonitorIndex < 1 Or MonitorIndex > MonitorCount Then
MsgBox "The monitor number " & MonitorIndex & " is invalid.", vbExclamation
Exit Sub
End If
With MonitorRects(MonitorIndex)
If FirstMonitor Then
SelectedLeft = .Left
SelectedTop = .Top
SelectedRight = .Right
SelectedBottom = .Bottom
FirstMonitor = False
Else
' Extend combined dimensions to include this monitor
If .Left < SelectedLeft Then SelectedLeft = .Left
If .Top < SelectedTop Then SelectedTop = .Top
If .Right > SelectedRight Then SelectedRight = .Right
If .Bottom > SelectedBottom Then SelectedBottom = .Bottom
End If
End With
Next i
' Convert dimensions to Twips
Dim TwipsLeft As Long
Dim TwipsTop As Long
Dim TwipsWidth As Long
Dim TwipsHeight As Long
TwipsLeft = SelectedLeft * Screen.TwipsPerPixelX
TwipsTop = SelectedTop * Screen.TwipsPerPixelY
TwipsWidth = (SelectedRight - SelectedLeft) * Screen.TwipsPerPixelX
TwipsHeight = (SelectedBottom - SelectedTop) * Screen.TwipsPerPixelY
' Resize the form
With frm
.Left = TwipsLeft
.Top = TwipsTop
.Width = TwipsWidth
.Height = TwipsHeight
End With
End Sub
Public Sub EnumerateMonitors()
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.immoassist.com
' * E-Mail : info@immoassist.com
' * Date : 11/19/2024
' * Time : 14:12
' * Module Name : MonitorExtend_Module
' * Module Filename : MonitorExtend_Module.bas
' * Procedure Name : EnumerateMonitors
' * Purpose :
' * Parameters :
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
MonitorCount = 0
ReDim MonitorRects(1 To 1)
EnumDisplayMonitors 0, ByVal 0&, AddressOf MonitorEnumProc, ByVal 0&
End Sub
Public Sub DrawMonitorLayout(pbox As PictureBox)
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.immoassist.com
' * E-Mail : info@immoassist.com
' * Date : 11/19/2024
' * Time : 14:12
' * Module Name : MonitorExtend_Module
' * Module Filename : MonitorExtend_Module.bas
' * Procedure Name : DrawMonitorLayout
' * Purpose :
' * Parameters :
' * pbox As PictureBox
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim i As Long
Dim BoxSize As Long
Dim OffsetX As Single
Dim OffsetY As Single
Dim Monitor As RECT
Dim MinLeft As Long
Dim MinTop As Long
Dim ScaleFactor As Single
Dim CenterX As Single
Dim CenterY As Single
' Enumerate monitors to get their positions
Call EnumerateMonitors
' Clear the PictureBox
With pbox
.Cls
.AutoRedraw = True ' Ensure drawing persists
.FillStyle = vbSolid
End With
' Define a fixed box size for each monitor
BoxSize = 1000
' Find the minimum coordinates (top-left origin)
MinLeft = MonitorRects(1).Left
MinTop = MonitorRects(1).Top
For i = 2 To MonitorCount
If MonitorRects(i).Left < MinLeft Then MinLeft = MonitorRects(i).Left
If MonitorRects(i).Top < MinTop Then MinTop = MonitorRects(i).Top
Next
ScaleFactor = 1
' Draw each monitor
For i = 1 To MonitorCount
Monitor = MonitorRects(i)
' Calculate the box position relative to the top-left corner
OffsetX = (Monitor.Left - MinLeft) * ScaleFactor
OffsetY = (Monitor.Top - MinTop) * ScaleFactor
With pbox
' Draw the monitor rectangle
.FillColor = vbWhite
pbox.Line (OffsetX, OffsetY)-(OffsetX + BoxSize, OffsetY + BoxSize), RGB(240, 240, 240), BF
' Draw the monitor number in the center
CenterX = OffsetX + (BoxSize / 2) - 50
CenterY = OffsetY + (BoxSize / 2) - 50
.CurrentX = CenterX
.CurrentY = CenterY
.ForeColor = vbBlack
pbox.Print i
End With
Next
End Sub