Binairy
May 23rd, 2001, 07:49 AM
Is there someone who can tell me how to switch a form between 2 ore more monitors .....
Click to See Complete Forum and Search --> : Multimonitor
Kdev
May 23rd, 2001, 09:14 AM
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 (mikedix@microsoft.com) '
' --------------------------------------------------------------------------
'===================================================
'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 (mikedix@microsoft.com) '
' --------------------------------------------------------------------------
'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
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 (mikedix@microsoft.com) '
' --------------------------------------------------------------------------
'===================================================
'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 (mikedix@microsoft.com) '
' --------------------------------------------------------------------------
'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
codeguru.com
Copyright Internet.com Inc., All Rights Reserved.
Copyright Internet.com Inc., All Rights Reserved.