在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获取的分辨率也不准确
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
end sub