我正在调整来自 https://stackoverflow.com/a/7241038/6527755 的代码，发现它在“GetMonitorId”函数上出错。我猜它与 64 位机器不兼容，所以我试图让它在 32 位和 64 位机器上工作。
在网上搜索后，我尝试重写代码如下，但我不确定与API调用相关的声明和数据类型（这个主题目前对我来说太深了）。我做对了吗？ 有人也可以为初学者建议有关 VBA-windows API 调用的网页吗？
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDc As LongPtr, ByVal nIndex As Long) As Long
Public Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long
Public Declare PtrSafe Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As LongPtr, ByVal dwFlags As Long) As Long
Public Declare PtrSafe Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As LongPtr, ByVal lpProcName As String) As Long
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare PtrSafe Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
Public Declare PtrSafe Function EnumDisplayMonitors Lib "user32.dll" (ByVal hDc As LongPtr, ByRef lprcClip As Any, ByVal lpfnEnum As LongPtr, ByVal dwData As Long) As Boolean
Public Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef lpmi As MONITORINFOEX) As Boolean
#Else
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDc As Long, ByVal nIndex As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long
Public Declare Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
Public Declare Function EnumDisplayMonitors Lib "user32.dll" (ByVal hDc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, ByVal dwData As Long) As Boolean
Public Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFOEX) As Boolean
#End If
Public Const LOGPIXELSX = 88 'Pixels/inch in X
Public Const POINTS_PER_INCH As Long = 72 'A point is defined as 1/72 inches
Public Const CCHDEVICENAME = 32
Public Const MONITORINFOF_PRIMARY = &H1
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type MONITORINFOEX
cbSize As Long
rcMonitor As RECT
rcWork As RECT
dwFlags As Long
szDevice As String * CCHDEVICENAME
End Type
Public MonitorId() As String
Public Sub Test()
Dim i As Integer
Debug.Print "Number of monitors in this system : " & GetMonitorId
Debug.Print
For i = 1 To UBound(MonitorId)
PrintMonitorInfo (MonitorId(i))
Next i
End Sub
Public Function GetMonitorId()
ReDim MonitorId(0)
' Of course dual screen systems are not available on all Win versions.
If FunctionExist("user32.dll", "EnumDisplayMonitors") = True Then
If EnumDisplayMonitors(&H0, ByVal &H0, AddressOf Monitorenumproc, &H0) = False Then
Failed "EnumDisplayMonitors"
End If
End If
GetMonitorId = UBound(MonitorId)
End Function
Private Sub PrintMonitorInfo(ForMonitorID As String)
Dim MONITORINFOEX As MONITORINFOEX
MONITORINFOEX.cbSize = Len(MONITORINFOEX)
If GetMonitorInfo(CLng(ForMonitorID), MONITORINFOEX) = False Then Failed "GetMonitorInfo"
With MONITORINFOEX
Debug.Print "Monitor info for device number : " & ForMonitorID
Debug.Print "---------------------------------------------------"
Debug.Print "Device Name : " & .szDevice
If .dwFlags And MONITORINFOF_PRIMARY Then Debug.Print "Primary Display = True" Else Debug.Print "Primary Display = False"
With .rcMonitor
Debug.Print "Monitor Left : " & .Left
Debug.Print "Monitor Top : " & .Top
Debug.Print "Monitor Right : " & .Right
Debug.Print "Monitor Bottom : " & .Bottom
End With
With .rcWork
Debug.Print "Work area Left : " & .Left
Debug.Print "Work area Top : " & .Top
Debug.Print "Work area Right : " & .Right
Debug.Print "Work area Bottom : " & .Bottom
End With
End With
Debug.Print
Debug.Print
End Sub
Public Function FunctionExist(ByVal strModule As String, ByVal strFunction As String) As Boolean
Dim hHandle As Long
hHandle = GetModuleHandle(strModule)
If hHandle = &H0 Then
Failed "GetModuleHandle"
hHandle = LoadLibraryEx(strModule, &H0, &H0): If hHandle = &H0 Then Failed "LoadLibrary"
If GetProcAddress(hHandle, strFunction) = &H0 Then
Failed "GetProcAddress"
Else
FunctionExist = True
End If
If FreeLibrary(hHandle) = False Then Failed "FreeLibrary"
Else
If GetProcAddress(hHandle, strFunction) = &H0 Then
Failed "GetProcAddress"
Else
FunctionExist = True
End If
End If
End Function
Public Sub Failed(ByVal strFunction As String)
Debug.Print strFunction & "Failed"
End Sub
#If Win64 Then
Public Function Monitorenumproc(ByVal hMonitor As LongLong, ByVal hdcMonitor As LongLong, ByRef lprcMonitor As RECT, ByVal dwData As Long) As Boolean
#Else
Public Function Monitorenumproc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, ByRef lprcMonitor As RECT, ByVal dwData As Long) As Boolean
#End If
Dim ub As Integer
ub = 0
On Error Resume Next
ub = UBound(MonitorId)
On Error GoTo 0
ReDim Preserve MonitorId(ub + 1)
MonitorId(UBound(MonitorId)) = CStr(hMonitor)
Monitorenumproc = 1
End Function
Public Function PointsPerPixel() As Double
#If VBA7 Then
Dim hDc As LongPtr
#Else
Dim hDc As Long
#End If
Dim lDotsPerInch As Long
hDc = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDc, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDc
End Function