请教如何取得屏幕缩放比例（32位DLL拟在64位使用）

thtfzhaobo

32位的DLL在用activex.exe调用时，屏幕所取信息不正确，目前判断是因为屏幕缩放比例，不知如何取得？
请教高手！！

thtfzhaobo

其实主要问题是用vb被取得的坐标1280×720。实际上我的屏幕是1920的，大家也能看出来。常规用GetDeviceCaps 等取的都是1280。定应第1个坐标点的left和top属性都有所漂移。

thtfzhaobo

thtfzhaobo 发表于 2023-4-25 18:04
其实主要问题是用vb被取得的坐标1280×720。实际上我的屏幕是1920的，大家也能看出来。常规用GetDeviceCaps ...

做了个系数修正一下，关贴，谢谢关注。

leolee82

1. Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
   
2. Private Declare PtrSafe Function MonitorFromWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal dwFlags As Long) As LongPtr
   
3. Private Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef lpmi As Any) As Long
   
4. Private Declare PtrSafe Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As Any) As Boolean
   
5. Private Declare Function GetActiveWindow Lib "user32" () As LongPtr
   
6. 
   
7. Private Type RECT
   
8.     Left As Long
   
9.     Top As Long
   
10.     Right As Long
    
11.     Bottom As Long
    
12. End Type
    
13. 
    
14. Private Type MONITORINFOEX
    
15.     cbSize As Long
    
16.     rcMonitor As RECT
    
17.     rcWork As RECT
    
18.     dwFlags As Long
    
19.     szDevice As String * 32
    
20. End Type
    
21. 
    
22. Type DevMode
    
23.     dmDeviceName(0 To 31) As Byte
    
24.     dmSpecVersion As Integer
    
25.     dmDriverVersion As Integer
    
26.     dmSize As Integer
    
27.     dmDriverExtra As Integer
    
28.     dmFields As Long
    
29.     dmOrientation As Integer
    
30.     dmPaperSize As Integer
    
31.     dmPaperLength As Integer
    
32.     dmPaperWidth As Integer
    
33.     dmScale As Integer
    
34.     dmCopies As Integer
    
35.     dmDefaultSource As Integer
    
36.     dmPrintQuality As Integer
    
37.     dmColor As Integer
    
38.     dmDuplex As Integer
    
39.     dmYResolution As Integer
    
40.     dmTTOption As Integer
    
41.     dmCollate As Integer
    
42.     dmFormName(0 To 31) As Byte
    
43.     dmLogPixels As Integer
    
44.     dmBitsPerPel As Long
    
45.     dmPelsWidth As Long
    
46.     dmPelsHeight As Long
    
47.     dmDisplayFlagsUnion As Long ' Union member: 'dmNup' or 'dmDisplayFlags'
    
48.     dmNup As Long ' Union member: 'dmNup' or 'dmDisplayFlags'
    
49. End Type
    
50. Public Function GetScreenScale() As Double
    
51. 
    
52.     Dim hMonitor As LongPtr
    
53.     hMonitor = MonitorFromWindow(GetActiveWindow, 0&)
    
54.    
    
55.     Dim miex As MONITORINFOEX: miex.cbSize = Len(miex)
    
56.     Call GetMonitorInfo(hMonitor, miex)
    
57.    
    
58.     Dim dm As DevMode: dm.dmSize = Len(dm)
    
59.     Call EnumDisplaySettings(miex.szDevice, -1&, dm)
    
60.    
    
61.     Dim cxLogical As Long: cxLogical = (miex.rcMonitor.Right - miex.rcMonitor.Left)
    
62.     Dim cyLogical As Long: cyLogical = (miex.rcMonitor.Bottom - miex.rcMonitor.Top)
    
63.    
    
64.     Dim cxPhysical As Long: cxPhysical = dm.dmPelsWidth
    
65.     Dim cyPhysical As Long: cyPhysical = dm.dmPelsHeight
    
66.    
    
67.     GetScreenScale = ((cxPhysical / cxLogical) + (cyPhysical / cyLogical)) / 2#
    
68. End Function
    

复制代码

thtfzhaobo

感谢，这个结果一样，都是与ActiveWindow.ActivePane.PointsToScreenPixelsX取得不符