Multimonitor

Is there someone who can tell me how to switch a form between 2 ore more monitors .....

clsMonitor (Monitor.cls)

option Explicit

' --------------------------------------------------------------------------
' Copyright (C) 1998 Microsoft Corporation '
' --------------------------------------------------------------------------
' You have a royalty-free right to use, modify, reproduce and distribute '
' the Sample Application Files (and/or any modified version) in any way '
' you find useful, provided that you agree that Microsoft has no warranty, '
' obligations or liability for any Sample Application Files. '
' --------------------------------------------------------------------------
' Written by Mike Dixon ([email protected]) '
' --------------------------------------------------------------------------


'===================================================
'Monitor Class, Contains information about a monitor
'All values should be stored as pixels
'===================================================

private m_Handle as Long
private m_Left as Long
private m_Right as Long
private m_Top as Long
private m_Bottom as Long
private m_WorkLeft as Long
private m_Workright as Long
private m_Worktop as Long
private m_Workbottom as Long
private m_Width as Long
private m_Height as Long

public property get Handle() as Long
Handle = m_Handle
End property

public property let Handle(lHandle as Long)
m_Handle = lHandle
End property

public property get Height() as Long
Height = m_Height
End property

public property let Height(h as Long)
m_Height = h
End property

public property get Width() as Long
Width = m_Width
End property

public property let Width(w as Long)
m_Width = w
End property

public property get Left() as Long
Left = m_Left
End property

public property let Left(l as Long)
m_Left = l
End property

public property get Right() as Long
Right = m_Right
End property

public property let Right(r as Long)
m_Right = r
End property

public property get Top() as Long
Top = m_Top
End property

public property let Top(t as Long)
m_Top = t
End property

public property get Bottom() as Long
Bottom = m_Bottom
End property

public property let Bottom(b as Long)
m_Bottom = b
End property

public property get WorkLeft() as Long
WorkLeft = m_WorkLeft
End property

public property let WorkLeft(l as Long)
m_WorkLeft = l
End property

public property get WorkRight() as Long
WorkRight = m_Workright
End property

public property let WorkRight(r as Long)
m_Workright = r
End property

public property get WorkTop() as Long
WorkTop = m_Worktop
End property

public property let WorkTop(t as Long)
m_Worktop = t
End property

public property get WorkBottom() as Long
WorkBottom = m_Workbottom
End property

public property let WorkBottom(b as Long)
m_Workbottom = b
End property



clsMonitors (Monitors.cls)

option Explicit
' --------------------------------------------------------------------------
' Copyright (C) 1998 Microsoft Corporation '
' --------------------------------------------------------------------------
' You have a royalty-free right to use, modify, reproduce and distribute '
' the Sample Application Files (and/or any modified version) in any way '
' you find useful, provided that you agree that Microsoft has no warranty, '
' obligations or liability for any Sample Application Files. '
' --------------------------------------------------------------------------
' Written by Mike Dixon ([email protected]) '
' --------------------------------------------------------------------------

'Virtual Desktop sizes
Const SM_XVIRTUALSCREEN = 76 'Virtual Left
Const SM_YVIRTUALSCREEN = 77 'Virtual Top
Const SM_CXVIRTUALSCREEN = 78 'Virtual Width
Const SM_CYVIRTUALSCREEN = 79 'Virtual Height

Const SM_CMONITORS = 80 'get number of monitors
Const SM_SAMEDISPLAYFORMAT = 81

'Constants for the return value when finding a monitor
Const MONITOR_DEFAULTTONULL = &H0 'If the monitor is not found, return 0
Const MONITOR_DEFAULTTOPRIMARY = &H1 'If the monitor is not found, return the primary monitor
Const MONITOR_DEFAULTTONEAREST = &H2 'If the monitor is not found, return the nearest monitor
Const MONITORINFOF_PRIMARY = 1

'Rectangle structure, for determining
'monitors at a given position
private Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type

'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

public monitors as new Collection

private Declare Function GetSystemMetrics Lib "USER32" ( _
byval nIndex as Long) as Long

'These API's are not present in Pre Windows 98 and
'Pre Windows NT 5 operating systems, you will need
'to trap for errors when using them.
'(Err.Number 453 Can't find DLL entry point...
private Declare Function GetMonitorInfo Lib "USER32" _
Alias "GetMonitorInfoA" ( _
byval hMonitor as Long, _
MonInfo as tagMONITORINFO) as Long

private Declare Function MonitorFromWindow Lib "USER32" ( _
byval hWnd as Long, _
dwFlags as Long) as Long

private Declare Function MonitorFromRect Lib "USER32" ( _
rc as RECT, _
byval dwFlags as Long) as Long

'==================================================================================================
'public Members
'==================================================================================================
private Sub Class_Initialize()
'Load the monitors collection
Refresh
End Sub

public property get DesktopLeft() as Long
DesktopLeft = GetSystemMetrics2(SM_XVIRTUALSCREEN, 0)
End property

public property get DesktopTop() as Long
DesktopTop = GetSystemMetrics2(SM_YVIRTUALSCREEN, 0)
End property

public property get DesktopWidth() as Long
DesktopWidth = GetSystemMetrics2(SM_CXVIRTUALSCREEN, Screen.Width \ Screen.TwipsPerPixelX)
End property

public property get DesktopHeight() as Long
DesktopHeight = GetSystemMetrics2(SM_CYVIRTUALSCREEN, Screen.Height \ Screen.TwipsPerPixelY)
End property

public Function GetMonitorFromWindow(hWnd as Long, dwFlags as Long) as Long
'=====================================================
'Returns a monitor handle that the Window (hwnd) is in
'=====================================================
Dim lReturn as Long

on error GoTo GetMonitorFromWindow_Err
lReturn = MonitorFromWindow(hWnd, dwFlags)
GetMonitorFromWindow = lReturn
Exit Function
GetMonitorFromWindow_Err:
If Err.Number = 453 then
'Non-Multimonitor OS, return -1
GetMonitorFromWindow = -1
End If
End Function

public Function CenterFormOnMonitor(FormToCenter as Form, optional ReferenceForm as Variant) as Boolean
'====================================================================
'Centers the FormToCenter on the monitor that the ReferenceForm is on
'or the primary monitor if the ReferenceForm is ommited
'====================================================================
Dim lMonitor as Long
Dim lReturn as Long
Dim MonitorInfo as tagMONITORINFO
Dim lMonitorWidth as Long
Dim lMonitorHeight as Long

on error GoTo CenterFormOnMonitor_Err

'get the handle to the monitor that the reference form is on
If IsMissing(ReferenceForm) then
lMonitor = GetMonitorFromXYPoint(1, 1, MONITOR_DEFAULTTOPRIMARY)
else
lMonitor = GetMonitorFromWindow(ReferenceForm.hWnd, MONITOR_DEFAULTTOPRIMARY)
End If

'If we get a valid lMonitor
If lMonitor then

'init the structure
MonitorInfo.cbSize = len(MonitorInfo)

'get the monitor information
lReturn = GetMonitorInfo(lMonitor, MonitorInfo)
'If the Call does not fail then center the form over that monitor
If lReturn then
With MonitorInfo
lMonitorWidth = (.rcWork.Right - .rcWork.Left) * Screen.TwipsPerPixelX
lMonitorHeight = (.rcWork.Bottom - .rcWork.Top) * Screen.TwipsPerPixelY
FormToCenter.Move ((lMonitorWidth - FormToCenter.Width) \ 2) + .rcMonitor.Left * Screen.TwipsPerPixelX, ((lMonitorHeight - FormToCenter.Height) \ 2) + MonitorInfo.rcMonitor.Top * Screen.TwipsPerPixelX
End With
End If
else
'There was not a monitor found, center on default screen
FormToCenter.Move (Screen.Width - FormToCenter.Width) \ 2, (Screen.Height - FormToCenter.Height) \ 2
End If
Exit Function
CenterFormOnMonitor_Err:
If Err.Number = 453 then
'Non-Multimonitor OS
FormToCenter.Move (Screen.Width - FormToCenter.Width) \ 2, (Screen.Width - FormToCenter.Width) \ 2
End If
End Function

public Function GetMonitorFromXYPoint(x as Long, y as Long, dwFlags as Long) as Long
'==========================================
'Gets a monitor handle from the xy point
'Workaround for the GetMonitorFromPoint API
'is to use the GetMonitorFromRect API and
'build a rect instead
'==========================================
Dim lReturn as Long
Dim rcRect as RECT

'Transfer the x y into a rect 1 pixel square
With rcRect
.Top = y
.Left = x
.Right = x + 1
.Bottom = y + 1
End With
on error resume next
lReturn = MonitorFromRect(rcRect, dwFlags)
If Err.Number = 0 then
GetMonitorFromXYPoint = lReturn
else
GetMonitorFromXYPoint = -1
End If
End Function

public Sub Refresh()
'=====================================================
'Iterate through the Virtual Desktop and enumerate the
'Monitors that intersect each 640x480 grid section
'=====================================================
Dim lMonitors as Long
Dim cMonitor as clsMonitor
Dim lLoop as Long
Dim lLoop2 as Long
Dim lMonitor as Long

on error GoTo Refresh_Err

set me.monitors = nothing

'Find Out How Many monitors there are
lMonitors = GetSystemMetrics(SM_CMONITORS)

If lMonitors = 0 then
'Non multimonitor OS, just do the screen size
ClearMonitorsCollection
set cMonitor = new clsMonitor
With cMonitor
.Handle = 0
.Bottom = Screen.Height \ Screen.TwipsPerPixelY
.Left = 0
.Right = Screen.Width \ Screen.TwipsPerPixelX
.Top = 0
.WorkBottom = .Bottom
.WorkLeft = 0
.WorkRight = .Right
.WorkTop = 0
.Width = .Right
.Height = .Bottom
End With
'Add the monitor to the monitors collection
monitors.Add Item:=cMonitor, Key:=CStr(0)
else

'Loop through an imaginary grid of 640x480 cells across the virtual desktop
'testing each for the monitor it is on, then try to add that monitor to the
'collection, if it fails, it is a duplicate, so just keep going.
for lLoop = DesktopTop to DesktopHeight step 480
for lLoop2 = DesktopLeft to DesktopWidth step 640
lMonitor = GetMonitorFromXYPoint(lLoop2 + 320, lLoop + 240, 0)
If lMonitor <> 0 then
set cMonitor = new clsMonitor
Call GetMonitorInformation(lMonitor, cMonitor)
monitors.Add Item:=cMonitor, Key:=CStr(lMonitor)
End If
next
next
End If
Exit Sub
Refresh_Err:
'Duplicate in the collection, so
'just ignore it and look for the next one
If Err.Number = 457 then resume next
End Sub

'public Function ShowMonitorDialog(Prompt as string, Caption as string, optional OwnerForm as Variant) as Long
' '===========================================
' 'Shows the Monitor Selection Dialog,
' 'returns a selected monitor or 0 if canceled
' '===========================================
' Load frmMonitor
' With frmMonitor
' set .cMonitorClass = me
' If IsMissing(OwnerForm) then
' 'The form will be centered on the default (primary) monitor
' else
' 'The form will be centered on the monitor that Ownerform is on
' .Owner = OwnerForm
' End If
' .DialogCaption = Caption
' .Prompt = Prompt
' .ShowDialog
' ShowMonitorDialog = .DialogResult
' End With
' Unload frmMonitor
' set frmMonitor = nothing
'End Function

'==================================================================================================
'private Members
'==================================================================================================
private Function GetSystemMetrics2(lItem as Long, lDefault as Long) as Long
'===============================================
'Calls GetSystemMetrics if multi-monitor capable
'Otherwise return the default value passed in
'===============================================
If GetSystemMetrics(SM_CMONITORS) = 0 then
'No multi monitor, return default
GetSystemMetrics2 = lDefault
else
'get the desired metric
GetSystemMetrics2 = GetSystemMetrics(lItem)
End If
End Function

private Function GetMonitorInformation(hMonitor as Long, cMon as clsMonitor) as Long
'======================================================
'Fills in the cMon class passed in with the information
'======================================================
Dim MonitorInfo as tagMONITORINFO
Dim lReturn as Long
Dim lMonitor as Long

on error GoTo GetMonitorInformation_Err
MonitorInfo.cbSize = len(MonitorInfo)
lReturn = GetMonitorInfo(hMonitor, MonitorInfo)
With cMon
.Handle = hMonitor
.Left = MonitorInfo.rcMonitor.Left
.Right = MonitorInfo.rcMonitor.Right
.Top = MonitorInfo.rcMonitor.Top
.Bottom = MonitorInfo.rcMonitor.Bottom

.WorkLeft = MonitorInfo.rcWork.Left
.WorkRight = MonitorInfo.rcWork.Right
.WorkTop = MonitorInfo.rcWork.Top
.WorkBottom = MonitorInfo.rcWork.Bottom

.Height = MonitorInfo.rcMonitor.Bottom - MonitorInfo.rcMonitor.Top
.Width = MonitorInfo.rcMonitor.Right - MonitorInfo.rcMonitor.Left
End With
GetMonitorInformation = lReturn
Exit Function
GetMonitorInformation_Err:
If Err.Number = 453 then
'Non-Multimonitor OS, return -1
GetMonitorInformation = -1
End If
End Function

private Sub ClearMonitorsCollection()
'==============================
'Clears the monitors collection
'==============================
Dim cMonitors as clsMonitor
Dim lCount as Long
Dim lLoop as Long

lCount = monitors.Count
on error resume next
for lLoop = 0 to lCount step -1
monitors.Remove lLoop
next
End Sub



The above 2 files are compliments of Microsoft. You can find them on their website. I forget the link so I just pasted the entire files here. Using these 2 class files you can easily get the information needed to switch your app between monitors. Here is some sample code that I wrote to start my app on a secondary monitor.

private Sub GetMonitorInfo()
Dim cMonitors as clsMonitors
Dim cMonitor as clsMonitor

set cMonitors = new clsMonitors

cMonitors.Refresh

for Each cMonitor In cMonitors.monitors
If cMonitor.Left <> 0 Or cMonitor.Top <> 0 then
lLeft = cMonitor.Left
lTop = cMonitor.Top
Exit for
End If
next
End Sub



This code just iterates over all the configured monitors and finds the 1st one that does not have a top,left vertice of 0,0 (which is always the primary monitor).

You could store all the top,left coordinates in an array if you wanted to move between more than just 2 monitors.

-K