在Windows7中的DPI与主题的问题

测试环境Windows7x64,vb6.0

测试在XP系统下,DPI计算似乎没问题

Screen.TwipsPerPixelX=1440/DPI=1440/96=15
Screen.TwipsPerPixelX=1440/DPI=1440/120=12
Screen.TwipsPerPixelX=1440/DPI=1440/144=10

测试在Windows7下(x64,SP1),DPI为96或120时,各种主题下获取似乎都正确.
当DPI为100%(96),三种主题下,获取的值为15
当DPI为125%(120),三种主题下,获取的值为12
当DPI为150%(144),主题为Windows7(Aero)时,获取的值为15(不正确)
当DPI为150%(144),主题为经典或Basic时,获取的值为10

简单来说如果主题为Windows7默认,DPI为150%时,获取的Screen.TwipsPerPixelX和Screen.TwipsPerPixelY将不准确.
用Screen.Width / Screen.TwipsPerPixelX计算分辨率也就不正确了

上图是在Basic主题下截图

 

上图是在经典主题下截图

 

上图是在Windows7下截图

 

从Windows7主题切换到其他主题时,可以看到最后一个窗口的实际显示比例和另外两个不同

图片未做任何处理,使用的Print截屏(PS.水印请忽略,先注册的CSDN然后发现广告太多,重注册了博客园)
发现Screen.Width和Screen.Height两个值在Windows7主题下也有5点误差,不知道是否显示器的问题,不知道是否与显示器有关.

因为在Windows7主题下打开的窗体切换之后和其他窗体不一样大,但在125%DPI时没有这个问题,推测很可能是Windows7本身的问题.

Private Sub Command1_Click()
    屏幕宽度 = Screen.Width / Screen.TwipsPerPixelX
    屏幕高度 = Screen.Height / Screen.TwipsPerPixelY
    
    窗体宽度 = Me.Width / Screen.TwipsPerPixelX
    窗体高度 = Me.Height / Screen.TwipsPerPixelY
    
    窗体工作区宽度 = Me.ScaleWidth / Screen.TwipsPerPixelX
    窗体工作区高度 = Me.ScaleHeight / Screen.TwipsPerPixelY
    
    屏幕宽度比 = Screen.TwipsPerPixelX
    屏幕高度比 = Screen.TwipsPerPixelY
    
    窗体两侧边框 = 窗体宽度 - 窗体工作区宽度
    框体上下边框 = 窗体高度 - 窗体工作区高度
    
    Text1 = ""
    Text1 = Text1 & "屏幕宽度" & 屏幕宽度 & vbCrLf
    Text1 = Text1 & "屏幕高度" & 屏幕高度 & vbCrLf
    Text1 = Text1 & "窗体宽度" & 窗体宽度 & vbCrLf
    Text1 = Text1 & "窗体高度" & 窗体高度 & vbCrLf
    Text1 = Text1 & "窗体工作区宽度" & 窗体工作区宽度 & vbCrLf
    Text1 = Text1 & "窗体工作区高度" & 窗体工作区高度 & vbCrLf
    Text1 = Text1 & "屏幕宽度比" & 屏幕宽度比 & vbCrLf
    Text1 = Text1 & "屏幕高度比" & 屏幕高度比 & vbCrLf
    Text1 = Text1 & "窗体两侧边框" & 窗体两侧边框 & vbCrLf
    Text1 = Text1 & "框体上下边框" & 框体上下边框 & vbCrLf
    
    Text1 = Text1 & "Screen.Width" & Screen.Width & vbCrLf
    Text1 = Text1 & "Screen.Height" & Screen.Height & vbCrLf
    
    Text1 = Text1 & "Me.Width" & Me.Width & vbCrLf
    Text1 = Text1 & "Me.Height" & Me.Height & vbCrLf
    
    Text1 = Text1 & "Me.ScaleWidth" & Me.ScaleWidth & vbCrLf
    Text1 = Text1 & "Me.ScaleHeight" & Me.ScaleHeight & vbCrLf
    
    Text1 = Text1 & "Me.Left" & Me.Left & vbCrLf
    Text1 = Text1 & "Me.Top" & Me.Top & vbCrLf
End Sub

 

补充测试:
ScaleX方法测试结果也不准确
API函数GetSystemMetrics获取的分辨率也不准确
API函数GetDeviceCaps获取的分辨率也不准确

Me.ScaleX(1, 3, 1)等同于Screen.TwipsPerPixelX
GetSystemMetrics(0)等同于Screen.Width / Screen.TwipsPerPixelX
GetSystemMetrics(1)等同于Screen.Height / Screen.TwipsPerPixelY

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Sub Command2_Click()
Dim dpi_x As Single, dpi_y As Single, px_twip As Single
dpi_x = Me.ScaleX(Screen.Width, 1, 3) / Me.ScaleX(Screen.Width, 1, 5)
dpi_y = Me.ScaleY(Screen.Height, 1, 3) / Me.ScaleY(Screen.Height, 1, 5)
px_twip = Me.ScaleX(1, 3, 1)

Text1 = Text1 & "1像素 = " & Me.ScaleX(1, 3, 1) & " 缇" & vbCrLf
Text1 = Text1 & "1像素 = " & Me.ScaleY(1, 3, 1) & " 缇" & vbCrLf
Text1 = Text1 & "DPI_X = " & dpi_x & " " & vbCrLf
Text1 = Text1 & "DPI_Y = " & dpi_y & " " & vbCrLf
Text1 = Text1 & "API获取分辨率:" & GetSystemMetrics(0) & "x" & GetSystemMetrics(1) & vbCrLf

    hdc = CreateDC("display", 0, 0, 0)
    Text1 = Text1 & "API获取Pixel:" & GetDeviceCaps(hdc, 8) & "x" & GetDeviceCaps(hdc, 10)
    Text1 = Text1 & "API获取DPI:" & GetDeviceCaps(hdc, 88) & "x" & GetDeviceCaps(hdc, 90)

End Sub

 

转载于:https://www.cnblogs.com/XYun99/p/10068808.html